diff --git a/BACKLOG.md b/BACKLOG.md index ef3652d..07a84cf 100644 --- a/BACKLOG.md +++ b/BACKLOG.md @@ -76,8 +76,57 @@ ffmpeg проблемой не является: он запускается о MP4/H.264 нельзя — контейнер и кодек альфу не хранят. Для этого нужен отдельный вывод в VP9 или ProRes 4444. +## Предпросмотр не показывает кадрирование обычного клипа + +Кадрирование и поворот видны в окне только у клипов с ключом или +прозрачностью: их плеер кладёт поверх основы сам и применяет к ним +цепочку фильтров. Обычный клип идёт списком кусков, а список фильтровать +нечем — он играется как есть, во весь кадр. В готовом ролике при этом всё +верно: такой кусок помечен на пересборку и обкладывается полями. + +Проверено опытом: у клипа выключен только ключ, кадрирование оставлено — +окно показывает его во весь кадр. + +Как это делается тем же механизмом, что и наложение: провести такой клип +через ту же дорожку наложения, а под ним заставить основу быть чёрной — +непрозрачный клип с полями в готовом ролике именно так и закрывает всё, +что ниже. Значит, уплощению нужно понятие «здесь дыра, даже если ниже +что-то есть». + +Чего это стоит: ветка масштабирования в цепочке работает на каждом кадре, +а не только там, где клип виден. Для накладки в 512 точек это пустяк, для +куска 2688x1512 — уже нет. Поэтому сначала замер, потом решение. + +## Окно настроек программы + +Переключателей, которые стоят машинного времени, становится больше, а +живут они кто где: прилипание и схлопывание — кнопками внизу, ключ в +предпросмотре — в меню «Вид», выбор кодировщика вообще нигде (берётся +NVENC, если он есть). Это разрозненно и не даёт увидеть общую цену. + +Нужно одно окно, где собрано всё, что можно выключить ради скорости: + +- ключ и прозрачность в предпросмотре (сейчас в меню «Вид»); +- наложение в предпросмотре вообще — на слабой машине может не хватать и + его, тогда честнее показывать одну основу; +- кодировщик для пересборки: аппаратный или процессорный, и какой + именно; +- где держать кэш и когда его убирать; +- прилипание клипов и курсора (сейчас кнопками, но им место и здесь). + +Почему это важно: разработка идёт на машине с быстрой видеокартой, и +всё, что здесь считается «недорогим», на другой может оказаться +неподъёмным. Пока цифры замеряны только на одной машине, у человека +должна быть возможность выключить любую из этих трат. + ## Мелочи, до которых не дошли руки +**Вид дорожки не виден в её заголовке.** Дорожки картинки, звука и текста +подписаны V1, A1, Т1, и по букве вид угадывается, но не более того. +Клип, попавший на дорожку чужого вида, теперь не принимается и не +теряется, но само различие стоило бы показать явно — значком или цветом +полосы заголовка. + **Значок файла программы под Windows.** Значок окна задаётся из `uIconData`, а значок самого `.exe` в проводнике берётся из ресурса при сборке — там он до сих пор стандартный. diff --git a/README.md b/README.md index 3a66955..ea009dc 100644 --- a/README.md +++ b/README.md @@ -141,6 +141,46 @@ xdg-mime query default application/x-nlve-project липнут при перетаскивании, курсор — при щелчке, и одно бывает нужно без другого. +**Ключ и прозрачность в предпросмотре** (меню «Вид»). Включено — окно +показывает то же, что даст сборка: выбитый цвет и приглушение считаются +на лету. Выключено — оверлей виден целиком, со своим фоном: так понятно, +куда он встал и где его края. + +Считается это по площади самого оверлея, а не всего кадра. Замер на +2688x1512 (600 кадров, десять секунд материала): основа 2.07 с, с +наложением 2.43 с, с ключом и прозрачностью 2.66 с. То есть наложение +стоит 0.36 с, ключ добавляет ещё 0.23 с — вчетверо быстрее реального +времени. На слабой машине это может быть заметнее, потому выключатель и +есть. + +**Отмеченный участок.** У линейки два этажа. Верхний, в двенадцать точек, +— про отметки: протяжка по нему отмечает участок, даже если отметок не +было, а щелчок без движения их снимает. По краям участка стоят жёлтые +уголки, за них тянут. Нижний этаж — про курсор, как и раньше. + +Клавиши тоже остались: `I` ставит начало по курсору, `O` — конец; оба +пункта есть в меню «Правка», там же снятие отметок. Пока он отмечен, сборка +собирает только его — это единственный способ проверить правку на длинном +монтаже, не тратя на каждую проверку столько же времени, сколько идёт сам +ролик. Отметки живут в файле проекта: участок относится к монтажу, а не к +привычкам человека. + +**Дорожки.** Слева в заголовке две стрелки: поднять и опустить. У верхней +дорожки некуда вверх, у нижней вниз — такая стрелка нарисована тускло и +не нажимается. Заголовок можно и просто потащить мышью. Двойной щелчок по +названию переименовывает дорожку: на монтаже из десятка дорожек «карта», +«звук мотора» и «титры» читаются несравнимо лучше, чем V1, A2 и Т1. + +Правый щелчок по заголовку открывает меню: поднять, опустить, +переименовать, удалить. Удаление дорожки с клипами спрашивает +подтверждение и называет число клипов. + +**Копирование свойств клипа.** Ctrl+Shift+C берёт с выделенного клипа всё +оформление — кадрирование, поворот, увеличение, смещение, прозрачность, +цветовой ключ, затухания, громкость, — Ctrl+Shift+V применяет их ко всем +выделенным. Вид клипа и его текст при этом не переносятся: свойства +копируют между разными клипами, и превращать картинку в надпись незачем. + **Схлопывание.** Кнопка внизу показывает и режим, и состояние: утоплена — автосхлопывание включено, и тогда при перетаскивании клипа всё, что начинается не раньше него, едет следом. Стрелка рядом открывает выбор @@ -358,6 +398,60 @@ Linux потом искала по нему `.dll`. каждого слоя считается на каждый отсчёт, и длина результата получается ровно такой, какая нужна. +## Качество пересобираемых кусков + +Куски, которые нельзя скопировать, целятся в наибольший битрейт среди +файлов проекта. Без этого кодировщик берёт своё значение по умолчанию, и +оно скромное: на съёмке 2688x1512 с 56 Мбит/с NVENC выдавал 5.9 Мбит/с — +пересобранный кусок бросался в глаза среди скопированных соседей. + +Кроме среднего задаётся потолок в полтора раза выше и буфер вдвое: без +них кодировщик разгоняется на сложных кадрах ровно настолько, насколько +позволит средний, и мелкие детали всё равно теряются. + +Берётся именно наибольший, а не средний: пересобранный кусок стоит рядом +со скопированными, и если он окажется хуже их, разница видна именно на +нём. Лишнее место дешевле. + +## Место на диске + +Куски весят примерно столько же, сколько готовый ролик, а на длинном +материале и больше: на часовой съёмке набралось 110 ГБ. Поэтому: + +- **картинка не собирается в промежуточный файл.** Звук собирается + раньше, и склейка сразу кладёт всё вместе в конечный файл. Раньше + получалось два полных ролика на диске одновременно — 91 ГБ в кэше и 91 + ГБ рядом — и лишний проход копирования ради одной звуковой дорожки; +- **после удачной сборки куски удаляются,** и в журнале сказано, сколько + места освободилось. После неудачной — остаются: с них продолжают. + +Оставить их можно настройкой `keep_parts` в файле настроек: пригодится, +когда разбираешься, из чего собрался ролик. + +## Прерванная сборка + +Каждый доведённый до конца кусок помечается в списке рядом с самими +кусками (`готово.txt` в кэше). Если сборка не дошла до конца — упала, +была отменена или программу закрыли, — при следующей сборке в тот же файл +программа предложит продолжить с готовых кусков. + +Проверяется не только наличие файла: сборку могли прервать посреди +записи, и файл оказался бы обрезанным. Поэтому куском считается только +тот, который успел попасть в список. + +Первая строка списка — отпечаток плана: пути, места и длины всех кусков. +Не совпал — значит монтаж с тех пор менялся, и готовые куски не подойдут; +программа скажет об этом и соберёт заново. + +## Сколько осталось + +Окно сборки показывает, сколько прошло и сколько примерно осталось. +Оценка простая: если четверть пути заняла минуту, весь путь займёт +четыре. На деле скорость меняется — копируемые куски идут мгновенно, +пересобираемые медленно, — поэтому число называется «примерно» и +пересчитывается на каждом шаге. Даже такая оценка отвечает на главный +вопрос: успею ли я сходить за чаем. + ## Как собирается ролик 1. Монтаж уплощается в последовательность непересекающихся кусков. diff --git a/docs/session-logs/2026-08-31_наложение-в-предпросмотре.md b/docs/session-logs/2026-08-31_наложение-в-предпросмотре.md index 2d72c77..1f9221f 100644 --- a/docs/session-logs/2026-08-31_наложение-в-предпросмотре.md +++ b/docs/session-logs/2026-08-31_наложение-в-предпросмотре.md @@ -61,8 +61,72 @@ mpv 0.37, видео 2688x1512 HEVC 87 Мбит/с, 600 кадров (10 с ма и картинку, и звук. - `./build.sh tests` — все проверки пройдены. -## Что осталось +## Продолжение: ключ прямо в предпросмотре -Ключ в предпросмотре не применяется — так решено сознательно. Стоит он -недорого (фильтр работает по небольшой площади), и при желании это -делается переключателем. +По просьбе сделано и это. Ключ и прозрачность считаются в той же цепочке +плеера, отдельным механизмом не обзаводились: строки фильтров теперь +общие со сборкой (`ColorKeyFilter`, `OpacityFilter` в `uTransform`), так +что окно и готовый ролик не могут разойтись по формату записи. + +Переключатель — в меню «Вид», состояние переживает перезапуск. Замер на +тяжёлом материале 2688x1512, 600 кадров: + +| Что | Время | +|---|---| +| только основа | 2.07 с | +| плюс наложение | 2.43 с | +| плюс ключ и прозрачность | 2.66 с | + +Проверено снимками окна: с ключом сквозь пурпур видно нижнее видео, +без ключа оверлей виден плашкой целиком. + +В бэклог записано окно настроек программы: переключателей, которые стоят +машинного времени, становится много, и живут они кто где. + +## Западня с настройками + +Тестовые запуски шли с подменённым HOME, и это не изолировало настройки: +в сессии задан `XDG_CONFIG_HOME`, и программа читала настоящий файл +пользователя (оттуда и бралась высота панели предпросмотра в 883 точки, +из-за которой монтаж не помещался в окно). Файл не пострадал — проверено +по содержимому, — но теперь тестовые скрипты задают `XDG_CONFIG_HOME`, +`XDG_CACHE_HOME` и `XDG_DATA_HOME` своими. + +## Рез терял цветовой ключ + +Показано пользователем на снимках: до реза оверлей лежал компасом в углу, +после реза (S) в окне остался только он сам, во весь кадр и с пурпуром. + +Причина: разрез создаёт хвост и переносит на него настройки по одной — +громкость, прозрачность, кадрирование, затухания. Цветового ключа в этом +списке не было, потому что он появился позже. Хвост без ключа перестаёт +быть наложением, становится обычным победителем и закрывает собой всё, +что ниже. + +Чинить перечислением ещё одного поля значило бы оставить ту же ловушку +следующему свойству. Поэтому у клипа появился `CopySettingsFrom`: одно +место, где сказано, что переносится при копировании, а что делает клип +этим клипом (имя, место, кусок исходника, связка, выделение). + +Проверка добавлена в `lfmcheck`: рез клипа с ключом, прозрачностью, +громкостью и кадрированием — всё это должно оказаться у обеих половин, а +связки у них должны быть разные и непустые. + +Важное для уже сделанных монтажей: правка не чинит проекты задним +числом. Если оверлей был разрезан старой сборкой, у хвоста ключ надо +включить заново. + +## Почему казалось, что рез потерял и кадрирование + +Не потерял: `Tail.Transform := Clip.Transform` было в разрезе и раньше. +Дело в другом — кадрирование видно в окне только у клипов, которые плеер +кладёт поверх основы сам. Обычный клип идёт списком кусков, а список +фильтровать нечем. + +Проверено опытом на том же проекте: у клипа выключен только ключ, +кадрирование оставлено нетронутым — окно показало клип во весь кадр. +То есть оба признака (пурпур и потерянный уголок) шли от одной причины, +и с возвратом ключа возвращается и уголок. + +Сам разрыв записан в `BACKLOG.md`: предпросмотр не показывает +кадрирование обычного клипа, и как это чинить тем же механизмом. diff --git a/docs/session-logs/2026-08-31_участок-качество-пропажи.md b/docs/session-logs/2026-08-31_участок-качество-пропажи.md new file mode 100644 index 0000000..d3fad46 --- /dev/null +++ b/docs/session-logs/2026-08-31_участок-качество-пропажи.md @@ -0,0 +1,118 @@ +# 31.08.2026 — отмеченный участок, качество пересборки, пропавшие куски + +## Что сообщил пользователь + +1. В собранном ролике на одном месте нет ни надписи, ни фотографии, хотя + на монтаже они есть. +2. Качество пересобранных кусков отвратительное: битрейт 5931 кбит/с при + исходных 56655. Предложено: если битрейт не задан, брать наибольший + среди использованных файлов. +3. Чтобы проверять такое, нужен отмеченный участок сборки — как в Vegas. + +Порядок работ по его просьбе: сначала участок, потом пропажи, потом +качество. Плана не было, задачи пришли списком. + +## Участок + +Отметки живут в проекте (`region_start`, `region_end`), ставятся клавишами +`I` и `O` по курсору, показаны полосой под линейкой и стойками по краям. +При сборке список кусков подрезается по участку — картинка и звук по +одному и тому же времени, — а разметка текста берётся с его начала: +иначе надписи легли бы со сдвигом. + +Проверка 9 в `nlvetool flattest`: обрезка по участку, попадающему на +середины крайних кусков, участок внутри одного куска и участок за концом +монтажа. Снимок окна: полоса ровно между отметками. + +## Пропажи: причин оказалось две + +**Фотография.** Кусок с наложением собирается отдельной веткой, и в неё +слои подаются как есть: `-ss ... -t ... -i фото.png`. Одиночная картинка +даёт ffmpeg ровно один кадр — `-t` тут не помогает. Кусок длиной три +секунды получался длиной 0.016667 с, то есть фотография из ролика просто +исчезала. Теперь у слоя есть признак «это картинка», и она повторяется +ключом `-loop 1` с частотой кадров проекта. + +Воспроизведено на своём материале до правки (кусок 0.016667 с) и проверено +после (3.000000 с, в кадре снова фотография). + +**Текст.** Вжигание помечает кусок разметкой, но ветка наложения про +разметку не знала и молча её теряла. Пока оверлей лежит на всём ролике — +а это обычный случай, карта или компас поверх съёмки, — этой веткой идут +все куски, и текст не появлялся нигде. + +Теперь разметка вжигается последним звеном цепочки, поверх сведённой +картинки. Проверено сборкой: в нижней полосе кадра 1833 белых точки там, +где надпись есть, и ноль там, где её нет. + +## Качество + +Битрейт не задавался вовсе — кодировщик брал своё значение по умолчанию. +Теперь пересборка целится в наибольший битрейт среди файлов проекта +(`TProject.MaxVideoBitrate`), с потолком в полтора раза выше и буфером +вдвое. Тем же битрейтом делаются вставки-картинки: фотография попадает в +ролик наравне со съёмкой. + +Наибольший, а не средний: пересобранный кусок стоит рядом со +скопированными, и если он окажется хуже, разница видна именно на нём. + +## Ловушка в проверочном инструменте + +`nlvetool render` уплощает монтаж заново после создания вставок, и первая +попытка вжечь текст до этого места ничего не дала: повторное уплощение +стёрло отметки о разметке. Вжигание перенесено на окончательный список — +так же, как в окне сборки. + +## Третий заход: текст не вжигался в фотографию + +Пользователь согласился перенести клипы на правильные дорожки, поставил +галку вжигания — и текста в ролике снова не оказалось. Журнал сборки, +заведённый как раз для таких случаев, показал причину за минуту: + + кусок 2: img_4ec7c38d3285_15000.mkv, из 0.000000, длина 5.000000, + с текстом, пересобирается + > ffmpeg ... -i img_4ec7c38d3285_15000.mkv -map 0:v:0 -c copy ... + +Кусок помечен «с текстом» и «пересобирается», а команда — копирование. +Причина: сгенерированные вставки (картинки, чёрное) отбирались первой же +веткой сборки, до проверки на пересборку, и копировались целиком. Текст +до них просто не доходил. + +Теперь вставка с разметкой идёт общей веткой пересборки, и время у неё +берётся своё — она начинается с нуля, а не с середины монтажа. Проверено +сборкой: на кадре с фотографией 3748 белых точек в нижней полосе, сама +фотография на месте. + +## Что ещё сделано в этом заходе + +- Верхний этаж линейки: протяжка отмечает участок, даже если отметок не + было; щелчок без движения их снимает. +- Заголовок дорожки: правый щелчок открывает меню (поднять, опустить, + удалить), перетаскивание меняет порядок дорожек. + +## Четвёртый заход: оверлей, текст в окне и одинаковые имена + +**Миникарта была в окне, но не в ролике.** Предпросмотр рисовал оверлей +поверх всего, не глядя на порядок дорожек, а сборка живёт по правилу +«верхний клип побеждает целиком». Фотография лежала выше оверлея — в +ролике она его закрывала, в окне нет. + +Теперь окно считает так же, как сборка: оверлей показывается только там, +где его не закрывает сплошной клип с дорожки выше. Закрытый посередине +оверлей разбивается на несколько окон показа. Проверка 11 в +`nlvetool flattest`. + +**Текст не появлялся в окне.** Разметка лежит в файле с одним и тем же +именем на весь проект, а плеер сравнивал имена: имя прежнее — значит +перечитывать нечего. Правка текста доходила до окна только вместе с +перезагрузкой всего списка кусков. + +Заодно проверено, что цепочка `lavfi-complex` субтитрам не мешает: та же +цепочка, прогнанная через mpv в файл, даёт текст на кадре (28828 белых +точек против 28758 без цепочки). Сравнивается теперь сама разметка, а не +имя файла, и при изменении она перечитывается принудительно. + +**Две дорожки Т2.** Имя новой дорожке давалось по счёту дорожек своего +вида плюс единица. После удаления средней счёт совпадал с уже занятым +именем. Теперь имя подбирается свободное, а одинаковые имена из старых +проектов разводятся при чтении. Проверка 12. diff --git a/src/uAppTypes.pas b/src/uAppTypes.pas index f1cbd9f..c7b9144 100644 --- a/src/uAppTypes.pas +++ b/src/uAppTypes.pas @@ -58,6 +58,12 @@ type Y: Integer; { Постоянная непрозрачность слоя. } Opacity: Double; + { Слой — неподвижная картинка, а не видео. + + Её надо повторять: одиночный файл даёт ffmpeg ровно один кадр, и + кусок с наложением схлопывался в одну шестидесятую секунды — + фотография из ролика просто пропадала. } + IsImage: Boolean; { Цветовой ключ слоя: этот цвет становится прозрачным. Ключ выключен, если KeyEnabled равно False. } KeyEnabled: Boolean; diff --git a/src/uExport.pas b/src/uExport.pas index 88ac49f..d7f4beb 100644 --- a/src/uExport.pas +++ b/src/uExport.pas @@ -115,6 +115,13 @@ type FStageText: string; FFraction: Double; FPendingLog: string; + FLogPath: string; + FResume: Boolean; + FReusedParts: Integer; + { Имена кусков, доведённых до конца в этой или прошлой сборке. } + FDone: TStringList; + { Признак того, что готовые куски относятся к этому же монтажу. } + FPlanKey: string; FReport: TExportReport; FOnProgress: TNotifyEvent; @@ -142,6 +149,16 @@ type procedure SyncProgress; procedure SyncLog; procedure Log(const AText: string); + procedure WriteLogLine(const AText: string); + { Отпечаток плана сборки: пути, места и длины кусков. По нему видно, + что готовые куски сделаны из того же монтажа, а не от прошлой + правки. } + function PlanKey: string; + 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; @@ -169,6 +186,7 @@ type { AMaster нужен, чтобы понять, влезут ли кодеки проекта в MPEG-TS. Можно передать пустую запись — тогда способ склейки выберется по одному лишь числу источников. } + destructor Destroy; override; constructor Create(const ASegments, AAudio: TFlatSegmentArray; const AOutputPath: string; AKeepIntermediate: Boolean; const AMaster: TMediaInfo; const AProfile: TEncodeProfile); @@ -187,6 +205,23 @@ type дорожкой. Пусто — либо текста нет, либо он вжигается в картинку. Годится только для Matroska: MP4 хранит субтитры без оформления. } property SubtitlePath: string read FSubtitlePath write FSubtitlePath; + { Куда писать журнал сборки. Пусто — никуда. + + Журнал кладётся рядом с готовым файлом и под тем же именем: когда + через неделю выяснится, что в ролике не то, разбираться придётся + именно по нему, а общий журнал программы к тому времени перезапишется + следующим запуском. Строка пишется сразу, а не копится в памяти: + если сборка упадёт, важна как раз последняя строка. } + property LogPath: string read FLogPath write FLogPath; + { Продолжать прерванную сборку: готовые куски берутся с диска, а не + считаются заново. + + Что считается готовым, помечено в списке рядом с самими кусками. + Проверять по одному только наличию файла нельзя: сборку могли + прервать посреди записи, и файл окажется обрезанным. } + property Resume: Boolean read FResume write FResume; + { Сколько кусков взято готовыми. Для отчёта. } + property ReusedParts: Integer read FReusedParts; end; { Каталог для временных кусков рядом с готовым файлом. } @@ -195,7 +230,33 @@ function CacheDirFor(const AOutputPath: string): string; implementation uses - Math, FileUtil, uFfmpegCmd, uProcRunner; + Math, md5, FileUtil, uFfmpegCmd, uProcRunner; + +{ Размер файла или ноль, если его нет. } +function FileSizeOf(const APath: string): Int64; +var + F: TSearchRec; +begin + Result := 0; + if APath = '' then + Exit; + if FindFirst(APath, faAnyFile, F) = 0 then + begin + Result := F.Size; + FindClose(F); + end; +end; + +{ Размер по-человечески: гигабайты, если их много. } +function SizeText(ABytes: Int64): string; +begin + if ABytes >= Int64(1024) * 1024 * 1024 then + Result := Format('%.1f ГБ', [ABytes / (1024 * 1024 * 1024)]) + else if ABytes >= 1024 * 1024 then + Result := Format('%.0f МБ', [ABytes / (1024 * 1024)]) + else + Result := Format('%d КБ', [ABytes div 1024]); +end; function CacheDirFor(const AOutputPath: string): string; begin @@ -204,6 +265,12 @@ begin PathDelim; end; +destructor TExportThread.Destroy; +begin + FDone.Free; + inherited Destroy; +end; + constructor TExportThread.Create(const ASegments, AAudio: TFlatSegmentArray; const AOutputPath: string; AKeepIntermediate: Boolean; const AMaster: TMediaInfo; const AProfile: TEncodeProfile); @@ -272,8 +339,148 @@ begin FOnLog(Self); end; +{ Строка в журнал сборки рядом с готовым файлом. + + Файл открывается и закрывается на каждой строке. Это медленно, но строк + за сборку десятки, а взамен журнал остаётся целым даже если программа + упадёт на следующем шаге — ради этого он и заводится. } +procedure TExportThread.WriteLogLine(const AText: string); +var + F: TextFile; +begin + if FLogPath = '' then + Exit; + try + AssignFile(F, FLogPath); + if FileExists(FLogPath) then + Append(F) + else + Rewrite(F); + try + WriteLn(F, AText); + finally + CloseFile(F); + end; + except + { Журнал не должен ронять сборку: не записалось — и ладно. } + on E: Exception do + FLogPath := ''; + end; +end; + +function TExportThread.PlanKey: string; +var + I: Integer; +begin + Result := Format('%dx%d %d/%d %s %s|', [FMaster.Width, FMaster.Height, + FMaster.FpsNum, FMaster.FpsDen, FMaster.VideoCodec, FMaster.PixFmt]); + for I := 0 to High(FSegments) do + Result := Result + Format('%s@%s+%s#%d%s;', + [ExtractFileName(FSegments[I].FilePath), + SecondsToStr(FSegments[I].SrcStart), + SecondsToStr(FSegments[I].Duration), + Length(FSegments[I].Layers), + FSegments[I].SubFile]); + Result := MD5Print(MD5String(Result)); +end; + +{ Список готовых кусков рядом с ними самими. Первая строка — отпечаток + плана: не совпал, значит куски от другого монтажа и брать их нельзя. } +procedure TExportThread.LoadDoneList; +var + Path: string; +begin + FDone := TStringList.Create; + FPlanKey := PlanKey; + Path := FCacheDir + 'готово.txt'; + + if not FResume then + begin + if FileExists(Path) then + SysUtils.DeleteFile(Path); + Exit; + end; + + if not FileExists(Path) then + Exit; + try + FDone.LoadFromFile(Path); + except + FDone.Clear; + end; + + if (FDone.Count = 0) or (FDone[0] <> FPlanKey) then + begin + Log('Готовые куски от другой расстановки — собираю заново.'); + FDone.Clear; + end; +end; + +function TExportThread.IsDone(const AName: string): Boolean; +begin + Result := (FDone <> nil) and (FDone.IndexOf(AName) > 0) and + (FileExists(FCacheDir + AName)) and (FileSize(FCacheDir + AName) > 0); +end; + +procedure TExportThread.MarkDone(const AName: string); +var + Path: string; +begin + if FDone = nil then + Exit; + if FDone.Count = 0 then + FDone.Add(FPlanKey); + if FDone.IndexOf(AName) < 0 then + FDone.Add(AName); + Path := FCacheDir + 'готово.txt'; + try + { Записываем сразу: список нужен именно на случай, когда сборка не + доживёт до конца. } + FDone.SaveToFile(Path); + except + { Не записалось — просто соберём заново в следующий раз. } + 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); FPendingLog := AText; Synchronize(@SyncLog); end; @@ -487,13 +694,23 @@ 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)])); { Сгенерированные вставки берутся из файла, который заведомо длиннее нужного: так одна и та же чёрная вставка годится для дыр любой длины. Значит вырезать надо и из них, но притягивать к опорному кадру нечего — они начинаются с нуля, а ноль всегда опорный. } - if FSegments[I].Kind <> skVideo then + if (FSegments[I].Kind <> skVideo) and (FSegments[I].SubFile = '') then begin Dst := FCacheDir + Format('part_%.3d_a%s', [I, FIntermediateExt]); Rep.Index := I; @@ -512,6 +729,8 @@ begin Exit; Rep.TempPath := Dst; + + MarkDone(ExtractFileName(Dst)); AddPart(Rep); Continue; end; @@ -537,19 +756,29 @@ begin FSegments[I].Duration, FMaster.Width, FMaster.Height, FMaster.FpsNum, FMaster.FpsDen, FMaster.PixFmt, PreferredEncoder(FMaster.VideoCodec), - FIntermediateFormat = 'mpegts'), + FIntermediateFormat = 'mpegts', FMaster.VideoBitrate, + FSegments[I].SubFile), 'Наложение в куске ' + IntToStr(I + 1)) then Exit; Rep.TempPath := Dst; + + MarkDone(ExtractFileName(Dst)); AddPart(Rep); Continue; end; - { Кусок от файла, не совпадающего с параметрами проекта. Скопировать - его нельзя — пересобираем. Но только его: соседние куски, снятые тем - же оборудованием, что и весь проект, по-прежнему копируются. } - if FSegments[I].Transcode then + { Кусок от файла, не совпадающего с параметрами проекта, или с + вжигаемым текстом. Скопировать его нельзя — пересобираем. Но только + его: соседние куски, снятые тем же оборудованием, что и весь + проект, по-прежнему копируются. + + Сгенерированные вставки — картинки и чёрное — сюда попадают только + с текстом: без него их незачем перекодировать, они и так в + параметрах проекта. Раньше они уходили в ветку выше и копировались + вместе с текстом мимо: галка вжигания стояла, а надписи на + фотографии не появлялось. } + if FSegments[I].Transcode or (FSegments[I].SubFile <> '') then begin SetStage(Format('Пересобираю кусок %d из %d (файл не совпадает с проектом)', [I + 1, Length(FSegments)])); @@ -563,16 +792,27 @@ begin Rep.Encoded := True; FStepWork := FSegments[I].Duration; + { У сгенерированной вставки время своё: она начинается с нуля, и + просить у неё кусок с середины монтажа бессмысленно. } + if FSegments[I].Kind <> skVideo then + Rep.RequestedStart := 0 + else + Rep.RequestedStart := FSegments[I].SrcStart; + Rep.ActualStart := Rep.RequestedStart; + if not RunFfmpeg(ArgsTranscodeSegment(FSegments[I].FilePath, Dst, - FSegments[I].SrcStart, FSegments[I].SrcStart + FSegments[I].Duration, + 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), + FIntermediateFormat, FSegments[I].Filter, FSegments[I].SubFile, + FMaster.VideoBitrate), 'Пересборка куска ' + IntToStr(I + 1)) then Exit; Rep.TempPath := Dst; + + MarkDone(ExtractFileName(Dst)); AddPart(Rep); Continue; end; @@ -620,6 +860,7 @@ begin Rep.Duration := EncodeUntil - FSegments[I].SrcStart; Rep.TempPath := Dst; Rep.Encoded := True; + MarkDone(ExtractFileName(Dst)); AddPart(Rep); if EncodeUntil < SegEnd - 0.0005 then @@ -636,6 +877,7 @@ begin Rep.Duration := SegEnd - EncodeUntil; Rep.TempPath := Dst; Rep.Encoded := False; + MarkDone(ExtractFileName(Dst)); AddPart(Rep); end; @@ -667,6 +909,7 @@ begin Rep.Duration := FSegments[I].Duration; Rep.TempPath := Dst; Rep.Encoded := False; + MarkDone(ExtractFileName(Dst)); AddPart(Rep); end; @@ -713,9 +956,9 @@ begin куски по отдельности здесь нельзя, на стыках была бы видна смена качества. } SetStage('Склеиваю и перекодирую'); - if RunFfmpeg(ArgsConcatEncode(AListPath, FVideoPath, + if RunFfmpeg(ArgsConcatEncode(AListPath, FOutputPath, FProfile.Width, FProfile.Height, FMaster.FpsNum, FMaster.FpsDen, - FProfile.BitrateKbps, FProfile.Codec, FMaster.PixFmt, True), + FProfile.BitrateKbps, FProfile.Codec, FMaster.PixFmt, True, FAudioPath), 'Склейка с перекодированием') then Exit(True); @@ -728,14 +971,15 @@ begin видеокарте кодек исходника. Отказываться из-за неё от сборки нельзя: медленно лучше, чем никак. } Log('Аппаратная распаковка не пошла, повторяю на процессоре.'); - Exit(RunFfmpeg(ArgsConcatEncode(AListPath, FVideoPath, + Exit(RunFfmpeg(ArgsConcatEncode(AListPath, FOutputPath, FProfile.Width, FProfile.Height, FMaster.FpsNum, FMaster.FpsDen, - FProfile.BitrateKbps, FProfile.Codec, FMaster.PixFmt, False), + FProfile.BitrateKbps, FProfile.Codec, FMaster.PixFmt, False, FAudioPath), 'Склейка с перекодированием без аппаратной распаковки')); end; SetStage('Склеиваю'); - Result := RunFfmpeg(ArgsConcat(AListPath, FVideoPath), 'Склейка'); + Result := RunFfmpeg(ArgsConcatMux(AListPath, FAudioPath, FSubtitlePath, + FOutputPath), 'Склейка'); end; procedure TExportThread.Verify; @@ -987,6 +1231,7 @@ procedure TExportThread.Execute; var ListPath: string; I: Integer; + Freed: Int64; ToolError: string; begin try @@ -1013,6 +1258,12 @@ begin Log('Временные куски: ' + FCacheDir); ChooseIntermediateFormat; + { Список готовых кусков — после выбора промежуточного формата: от него + зависят их имена. } + LoadDoneList; + if FResume and (FDone.Count > 1) then + Log(Format('Продолжаю прерванную сборку: готовых кусков %d.', + [FDone.Count - 1])); { Единица учёта работы — секунда материала. Каждая секунда проходит через вырезание, склейку и сборку звука, отсюда тройной вес. } @@ -1024,23 +1275,24 @@ begin if not WriteConcatList(ListPath) then Exit; - { Картинка собирается в отдельный файл, а не сразу в конечный: звук у - неё свой, из исходников, и он почти наверняка не тот, что нужен. - Настоящий звук собирается отдельно и подставляется при сшивании. } - FVideoPath := FCacheDir + 'video' + ExtractFileExt(FOutputPath); - if not ConcatAll(ListPath) then - Exit; + { Звук собирается раньше картинки, и склейка сразу кладёт всё вместе в + конечный файл. + Так было не всегда: сперва картинка собиралась в отдельный файл, а + потом сшивалась со звуком. На часовом ролике это 91 ГБ + промежуточного файла и лишний полный проход копирования — места + требовалось вдвое больше готового ролика. } + FVideoPath := ''; if not BuildAudio then begin if FReport.Cancelled then Exit; - { Без звука ролик всё равно лучше, чем ничего: картинка уже собрана. } - Log('Звук собрать не удалось, оставляю картинку как есть.'); - if not RenameFile(FVideoPath, FOutputPath) then - FileUtil.CopyFile(FVideoPath, FOutputPath); - end - else if not MuxFinal then + { Без звука ролик всё равно лучше, чем ничего. } + Log('Звук собрать не удалось, собираю картинку без него.'); + FAudioPath := ''; + end; + + if not ConcatAll(ListPath) then Exit; Verify; @@ -1054,18 +1306,38 @@ begin FReport.Succeeded := True; FReport.Message := 'Готово.'; + { Уборка после удачной сборки. + + Куски весят столько же, сколько готовый ролик, а на длинном + материале и больше: на часовой съёмке набралось 110 ГБ. Держать их + после того, как ролик собран, незачем — продолжать больше нечего. + После неудачи, наоборот, не трогаем: с них и продолжим. + + Считаем освобождённое: цифра говорит человеку, сколько места было + занято, лучше любого объяснения. } if not FKeepIntermediate then begin + Freed := 0; for I := 0 to High(FReport.Segments) do { Удаляем только то, что сами создали в своём каталоге. Части, указывающие на общий кэш сгенерированных вставок, трогать нельзя: они нужны и предпросмотру, и следующей сборке. } if Copy(FReport.Segments[I].TempPath, 1, Length(FCacheDir)) = FCacheDir then + begin + Inc(Freed, FileSizeOf(FReport.Segments[I].TempPath)); DeleteFile(FReport.Segments[I].TempPath); + end; + + Inc(Freed, FileSizeOf(FAudioPath)); + DeleteFile(FAudioPath); DeleteFile(ListPath); + DeleteFile(FCacheDir + 'готово.txt'); RemoveDir(FCacheDir); - Log('Временные куски удалены.'); - end; + Log(Format('Временные куски удалены, освободилось %s.', + [SizeText(Freed)])); + end + else + Log('Временные куски оставлены: ' + FCacheDir); except on E: Exception do begin diff --git a/src/uExportForm.pas b/src/uExportForm.pas index 01cf3bb..72c5c97 100644 --- a/src/uExportForm.pas +++ b/src/uExportForm.pas @@ -31,15 +31,23 @@ type Path: string; { Вжигать ли текст в картинку. При MP4 всегда True. } BurnText: Boolean; + { Собирать только отмеченный участок. Имеет смысл, только когда + участок отмечен. } + RegionOnly: Boolean; end; { Показывает окно. AHasText — есть ли в проекте надписи: без них про текст и спрашивать незачем. APreferMkv — в монтаже есть точные резы, и MKV надёжнее. - ABurnDefault — ответ, данный в прошлый раз. } + ABurnDefault — ответ, данный в прошлый раз. + + ARegion — описание отмеченного участка. Не пусто — в окне появляется + галка «только отмеченный участок». Галка, а не надпись: надпись легко + проглядеть, а тут вопрос из тех, где ошибка стоит часа работы — соберёшь + кусок вместо ролика или наоборот. } function AskExport(var AChoice: TExportChoice; AHasText, APreferMkv: Boolean; - const ADefaultDir: string): Boolean; + const ADefaultDir: string; const ARegion: string = ''): Boolean; implementation @@ -51,6 +59,7 @@ type BtnMp4: TThemedButton; BtnMkv: TThemedButton; cbBurn: TCheckBox; + cbRegion: TCheckBox; lblNote: TLabel; HasText: Boolean; { Ответ человека про вжигание, сохранённый до того, как MP4 навязал @@ -65,6 +74,7 @@ type procedure FormatClick(Sender: TObject); procedure BrowseClick(Sender: TObject); procedure BurnClick(Sender: TObject); + procedure RegionClick(Sender: TObject); function IsMp4: Boolean; procedure ApplyFormat; end; @@ -139,6 +149,12 @@ begin ApplyFormat; end; +{ Галка участка ничего не пересчитывает: она только запоминает ответ. + Всё, что от неё зависит, решается уже после закрытия окна. } +procedure TExportDialog.RegionClick(Sender: TObject); +begin +end; + procedure TExportDialog.BrowseClick(Sender: TObject); var Dlg: TSaveDialog; @@ -166,7 +182,7 @@ begin end; function AskExport(var AChoice: TExportChoice; AHasText, APreferMkv: Boolean; - const ADefaultDir: string): Boolean; + const ADefaultDir: string; const ARegion: string): Boolean; var Dlg: TExportDialog; Lbl: TLabel; @@ -183,7 +199,7 @@ begin Dlg.Form.Caption := 'Сборка ролика'; Dlg.Form.Position := poScreenCenter; Dlg.Form.ClientWidth := 620; - Dlg.Form.ClientHeight := 250; + Dlg.Form.ClientHeight := 272; Lbl := TLabel.Create(Dlg.Form); Lbl.Parent := Dlg.Form; @@ -221,23 +237,42 @@ begin Dlg.BtnMkv.TabStop := False; Dlg.BtnMkv.OnClick := @Dlg.FormatClick; + if ARegion <> '' then + begin + Lbl := TLabel.Create(Dlg.Form); + Lbl.Parent := Dlg.Form; + Lbl.SetBounds(310, 76, 300, 20); + Lbl.Anchors := [akTop, akLeft, akRight]; + Lbl.Caption := 'Только участок: ' + ARegion; + Lbl.Font.Color := TColor($30A0D0); + end; + + Dlg.cbRegion := TCheckBox.Create(Dlg.Form); + Dlg.cbRegion.Parent := Dlg.Form; + Dlg.cbRegion.SetBounds(12, 112, 596, 22); + Dlg.cbRegion.Anchors := [akTop, akLeft, akRight]; + Dlg.cbRegion.Caption := 'Только отмеченный участок: ' + ARegion; + Dlg.cbRegion.Visible := ARegion <> ''; + Dlg.cbRegion.Checked := ARegion <> ''; + Dlg.cbRegion.OnClick := @Dlg.RegionClick; + Dlg.cbBurn := TCheckBox.Create(Dlg.Form); Dlg.cbBurn.Parent := Dlg.Form; - Dlg.cbBurn.SetBounds(12, 116, 300, 22); + Dlg.cbBurn.SetBounds(12, 138, 300, 22); Dlg.cbBurn.Caption := 'Вжечь текст в картинку'; Dlg.cbBurn.Visible := AHasText; Dlg.cbBurn.OnClick := @Dlg.BurnClick; Dlg.lblNote := TLabel.Create(Dlg.Form); Dlg.lblNote.Parent := Dlg.Form; - Dlg.lblNote.SetBounds(12, 144, 596, 52); + Dlg.lblNote.SetBounds(12, 164, 596, 52); Dlg.lblNote.Anchors := [akTop, akLeft, akRight]; Dlg.lblNote.AutoSize := False; Dlg.lblNote.WordWrap := True; BtnOk := TThemedButton.Create(Dlg.Form); BtnOk.Parent := Dlg.Form; - BtnOk.SetBounds(400, 208, 100, 30); + BtnOk.SetBounds(400, 230, 100, 30); BtnOk.Anchors := [akRight, akBottom]; BtnOk.Caption := 'Собрать'; BtnOk.ModalResult := mrOk; @@ -245,7 +280,7 @@ begin BtnCancel := TThemedButton.Create(Dlg.Form); BtnCancel.Parent := Dlg.Form; - BtnCancel.SetBounds(508, 208, 100, 30); + BtnCancel.SetBounds(508, 230, 100, 30); BtnCancel.Anchors := [akRight, akBottom]; BtnCancel.Caption := 'Отмена'; BtnCancel.ModalResult := mrCancel; @@ -276,6 +311,7 @@ begin if AChoice.Path = '' then Exit; AChoice.BurnText := AHasText and Dlg.cbBurn.Checked; + AChoice.RegionOnly := (ARegion <> '') and Dlg.cbRegion.Checked; Result := True; finally Dlg.Form.Free; diff --git a/src/uFfmpegCmd.pas b/src/uFfmpegCmd.pas index c902428..c01e39f 100644 --- a/src/uFfmpegCmd.pas +++ b/src/uFfmpegCmd.pas @@ -87,7 +87,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 = ''): TArgs; + const ASubFile: string = ''; ABitrate: Int64 = 0): TArgs; { Путь внутри строки фильтра. Двоеточие там разделяет настройки, обратная косая и кавычка имеют своё значение — всё это надо обезвредить, иначе @@ -115,6 +115,18 @@ function TsSupportsCodecs(const AVideoCodec, AAudioCodec: string): Boolean; { Склеить куски по списку. Формат вывода ffmpeg определит по расширению. } function ArgsConcat(const AListFile, ADst: string): TArgs; +{ Склейка сразу с готовым звуком и разметкой — прямо в конечный файл. + + Зачем. Раньше картинка сначала собиралась в отдельный файл, а потом + сшивалась со звуком в конечный. На часовом ролике это означало 91 ГБ + промежуточного файла и лишний полный проход копирования: места нужно + вдвое больше готового ролика, и всё это ради того, чтобы приписать + звуковую дорожку. + + Звук собирается раньше картинки, и склейка сразу кладёт всё вместе куда + надо. Пусто в AAudio — значит звука нет, тогда это обычная склейка. } +function ArgsConcatMux(const AListFile, AAudio, ASubFile, ADst: string): TArgs; + { Склеить куски и сразу перекодировать картинку в заданный размер и поток. Нужно для сборки «под площадку»: когда ролик надо отдать в 1080p с @@ -127,7 +139,8 @@ function ArgsConcat(const AListFile, ADst: string): TArgs; процессоре идёт медленнее реального времени, и смысл теряется. } function ArgsConcatEncode(const AListFile, ADst: string; AWidth, AHeight, AFpsNum, AFpsDen, ABitrateKbps: Integer; - const AVideoCodec, APixFmt: string; AHwDecode: Boolean = True): TArgs; + const AVideoCodec, APixFmt: string; AHwDecode: Boolean = True; + const AAudio: string = ''): TArgs; { Перепаковать файл в другой контейнер без перекодирования. } { Звук куска в сыром виде: 16 бит со знаком, частота и число каналов @@ -146,11 +159,16 @@ function ArgsEncodeAudio(const ASource, ATarget: string; Постоянная непрозрачность делается наложением с приглушённым альфа- каналом, переход — фильтром xfade. Их нельзя перепутать: xfade умеет - плавно менять долю во времени, а простое наложение — нет. } + плавно менять долю во времени, а простое наложение — нет. + + ASubFile — разметка текста, которую надо вжечь в этот кусок. Пусто — не + вжигать. Без этого текст пропадал везде, где есть наложение: кусок шёл + этой веткой, а она про субтитры не знала. } function ArgsRenderLayers(const ALayers: array of TSegmentLayer; const ATarget: string; const ADuration: Double; AWidth, AHeight, AFpsNum, AFpsDen: Integer; - const APixFmt, ACodec: string; AIsTs: Boolean): TArgs; + const APixFmt, ACodec: string; AIsTs: Boolean; + ABitrate: Int64 = 0; const ASubFile: string = ''): TArgs; { Сшивание готовой картинки с готовым звуком. Оба потока копируются. @@ -197,7 +215,7 @@ function ArgsNormalize(const ASrc, ADst: string; function ArgsImageClip(const ASrc, ADst: string; ADuration: Double; AWidth, AHeight, AFpsNum, AFpsDen: Integer; const AVideoCodec, APixFmt, AAudioCodec: string; - ASampleRate, AChannels: Integer): TArgs; + ASampleRate, AChannels: Integer; ABitrate: Int64 = 0): TArgs; { Сделать чёрный клип с тишиной заданной длины. @@ -235,7 +253,11 @@ function ParseProgressLine(const ALine: string; var ASeconds: Double; implementation uses - StrUtils; + StrUtils, uTransform; + +{ Ключи качества. Объявлено в самом начале: ими пользуется отрисовка + слоёв, а она по тексту раньше самой функции. } +function BitrateArgs(ABitrate: Int64): TArgs; forward; { Общие параметры вывода в формате проекта. Объявлено заранее, потому что используется выше по тексту, чем определено. } @@ -279,20 +301,33 @@ 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): TArgs; + const APixFmt, ACodec: string; AIsTs: Boolean; + ABitrate: Int64; const ASubFile: string): TArgs; var I: Integer; - Graph, Fit, Src: string; + Graph, Fit, Src, OutLabel: string; Crossfade: Boolean; begin Result := ['-hide_banner', '-nostdin', '-loglevel', 'warning', '-y']; - { Каждый слой — отдельный вход, вырезанный ровно по длине участка. } + { Каждый слой — отдельный вход, вырезанный ровно по длине участка. + + Неподвижная картинка — случай особый: её надо повторять ключом -loop, + иначе ffmpeg отдаёт один-единственный кадр, и весь кусок с наложением + схлопывается в одну шестидесятую секунды. Перематывать её тоже + незачем: у картинки нет времени. } for I := 0 to High(ALayers) do - Result := Concat(Result, - ['-ss', SecondsToStr(ALayers[I].SrcStart), - '-t', SecondsToStr(ADuration), - '-i', ALayers[I].FilePath]); + if ALayers[I].IsImage then + Result := Concat(Result, + ['-loop', '1', + '-framerate', Format('%d/%d', [AFpsNum, AFpsDen]), + '-t', SecondsToStr(ADuration), + '-i', ALayers[I].FilePath]) + else + Result := Concat(Result, + ['-ss', SecondsToStr(ALayers[I].SrcStart), + '-t', SecondsToStr(ADuration), + '-i', ALayers[I].FilePath]); { Переход отличается от наложения тем, что доля меняется во времени. } Crossfade := (Length(ALayers) = 2) and @@ -318,12 +353,8 @@ begin масштабом. Цвет записывается как 0xRRGGBB — порядок обратный тому, в каком он хранится у нас. } if ALayers[I].KeyEnabled then - Fit := Fit + Format(',colorkey=0x%.2x%.2x%.2x:%s:%s', - [ALayers[I].KeyColor and $FF, - (ALayers[I].KeyColor shr 8) and $FF, - (ALayers[I].KeyColor shr 16) and $FF, - SecondsToStr(ALayers[I].KeySimilarity / 100), - SecondsToStr(ALayers[I].KeyBlend / 100)]); + Fit := Fit + ',' + ColorKeyFilter(ALayers[I].KeyColor, + ALayers[I].KeySimilarity, ALayers[I].KeyBlend); Graph := Graph + Format('[%d:v]%s,format=yuva420p[v%d];', [I, Fit, I]); end; @@ -364,15 +395,27 @@ begin ALayers[High(ALayers)].X, ALayers[High(ALayers)].Y]); end; + { Текст вжигается последним: он ложится поверх уже сведённой картинки, + как и в куске без наложения. Разметка приходит со сдвигом под этот + кусок, поэтому время в ней считается от его начала. } + if ASubFile <> '' then + Graph := Graph + Format(';[out]subtitles=filename=''%s''[outs]', + [EscapeFilterPath(ASubFile)]); + { Кодировщик выбирается предпочтительный, а не тот, что ffmpeg возьмёт по имени кодека. Имя «hevc» уводит его на процессорный x265, и участок наложения считался медленнее реального времени: замерено 9.6 с материала за 11.2 с работы. } + if ASubFile <> '' then + OutLabel := '[outs]' + else + OutLabel := '[out]'; Result := Concat(Result, - ['-filter_complex', Graph, '-map', '[out]', + ['-filter_complex', Graph, '-map', OutLabel, '-t', SecondsToStr(ADuration), '-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']); @@ -407,7 +450,7 @@ end; function MasterOutputArgs(AWidth, AHeight, AFpsNum, AFpsDen: Integer; const AVideoCodec, APixFmt, AAudioCodec: string; - ASampleRate, AChannels: Integer): TArgs; forward; + ASampleRate, AChannels: Integer; ABitrate: Int64 = 0): TArgs; forward; { Запрет двунаправленных кадров. Объявлено заранее по той же причине. } function NoBFramesArgs: TArgs; forward; @@ -621,7 +664,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): TArgs; + const ASubFile: string; ABitrate: Int64): TArgs; var Chain: string; begin @@ -655,7 +698,7 @@ begin Result := Concat(Result, ['-af', 'volume=' + SecondsToStr(AVolume)]); Result := Concat(Result, MasterOutputArgs(0, 0, AFpsNum, AFpsDen, - 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); @@ -679,7 +722,8 @@ end; function ArgsConcatEncode(const AListFile, ADst: string; AWidth, AHeight, AFpsNum, AFpsDen, ABitrateKbps: Integer; - const AVideoCodec, APixFmt: string; AHwDecode: Boolean): TArgs; + const AVideoCodec, APixFmt: string; AHwDecode: Boolean; + const AAudio: string): TArgs; var Fps, Enc: string; begin @@ -700,13 +744,13 @@ begin if AHwDecode and (Pos('nvenc', Enc) > 0) then Result := Concat(Result, ['-hwaccel', 'cuda']); - Result := Concat(Result, [ - '-f', 'concat', - '-safe', '0', - '-i', AListFile, - '-map', '0:v:0', - '-map', '0:a:0?' - ]); + Result := Concat(Result, ['-f', 'concat', '-safe', '0', '-i', AListFile]); + { Готовый звук подмешивается прямо здесь, чтобы не собирать картинку в + промежуточный файл ради одной звуковой дорожки. } + if AAudio <> '' then + Result := Concat(Result, ['-i', AAudio, '-map', '0:v:0', '-map', '1:a:0']) + else + Result := Concat(Result, ['-map', '0:v:0', '-map', '0:a:0?']); { Вписываем целиком и добиваем полями: соотношение сторон менять нельзя, иначе кадр растянется. } @@ -759,6 +803,46 @@ begin Result := Concat(Result, [ADst]); end; +function ArgsConcatMux(const AListFile, AAudio, ASubFile, ADst: string): TArgs; +var + Next: Integer; +begin + Result := Concat(CommonFfmpegPrefix, [ + '-f', 'concat', + { Без -safe 0 демультиплексор откажется брать абсолютные пути. } + '-safe', '0', + '-i', AListFile + ]); + + 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']); + Result := Concat(Result, ProgressArgs); + if WantsFaststart(ADst) then + Result := Concat(Result, ['-movflags', '+faststart']); + Result := Concat(Result, [ADst]); +end; + function ArgsRemux(const ASrc, ADst: string): TArgs; begin Result := Concat(CommonFfmpegPrefix, [ @@ -929,9 +1013,31 @@ begin end; { Реализация объявленной выше функции. } +{ Ключи качества для пересобираемых кусков. + + Без них кодировщик берёт своё значение по умолчанию, а оно скромное: на + съёмке 2688x1512 с 56 Мбит/с NVENC выдавал 5.9 Мбит/с, и пересобранный + кусок бросался в глаза среди скопированных. Поэтому целимся в тот же + битрейт, что у исходного материала. + + Кроме среднего задаётся потолок и размер буфера: без них кодировщик + разгоняется на сложных кадрах ровно настолько, насколько ему позволит + средний, и мелкие детали всё равно пропадают. } +function BitrateArgs(ABitrate: Int64): TArgs; +begin + Result := []; + { Ниже ста килобит в секунду — это не битрейт, а неизвестность: ffprobe + не всегда его сообщает. Тогда оставляем решение кодировщику. } + if ABitrate < 100000 then + Exit; + Result := ['-b:v', IntToStr(ABitrate div 1000) + 'k', + '-maxrate', IntToStr(ABitrate * 3 div 2000) + 'k', + '-bufsize', IntToStr(ABitrate div 500) + 'k']; +end; + function MasterOutputArgs(AWidth, AHeight, AFpsNum, AFpsDen: Integer; const AVideoCodec, APixFmt, AAudioCodec: string; - ASampleRate, AChannels: Integer): TArgs; + ASampleRate, AChannels: Integer; ABitrate: Int64): TArgs; var Fps: string; begin @@ -947,6 +1053,7 @@ begin Result := Concat(Result, ['-r', Fps]); if APixFmt <> '' then Result := Concat(Result, ['-pix_fmt', APixFmt]); + Result := Concat(Result, BitrateArgs(ABitrate)); if AAudioCodec <> '' then begin @@ -979,7 +1086,7 @@ end; function ArgsImageClip(const ASrc, ADst: string; ADuration: Double; AWidth, AHeight, AFpsNum, AFpsDen: Integer; const AVideoCodec, APixFmt, AAudioCodec: string; - ASampleRate, AChannels: Integer): TArgs; + ASampleRate, AChannels: Integer; ABitrate: Int64): TArgs; begin { -loop 1 повторяет единственный кадр, -t задаёт длину. Картинка вписывается в кадр целиком с чёрными полями по краям: @@ -1002,7 +1109,7 @@ begin [AWidth, AHeight, AWidth, AHeight])]); Result := Concat(Result, MasterOutputArgs(0, 0, AFpsNum, AFpsDen, - AVideoCodec, APixFmt, AAudioCodec, ASampleRate, AChannels)); + AVideoCodec, APixFmt, AAudioCodec, ASampleRate, AChannels, ABitrate)); Result := Concat(Result, NoBFramesArgs); Result := Concat(Result, ['-shortest']); Result := Concat(Result, ProgressArgs); diff --git a/src/uFlatten.pas b/src/uFlatten.pas index 8386ef6..e97a318 100644 --- a/src/uFlatten.pas +++ b/src/uFlatten.pas @@ -38,6 +38,9 @@ uses Classes, SysUtils, uAppTypes, uProject, uMediaProbe, uTransform; type + { Набор отрезков времени: им описывают, где оверлей виден. } + TDoubleArray = array of Double; + { Клип, который в предпросмотре кладётся поверх основы. Место в кадре — то же самое, по чему сборка обкладывает картинку @@ -140,11 +143,31 @@ function FlattenProject(AProject: TProject; под ними видно то, что лежит ниже, — а выдаются отдельным списком со временем и местом в кадре. + AWithKey — применять ли к оверлею цветовой ключ и прозрачность прямо в + плеере. Тогда окно показывает то же, что даст сборка. Стоит это + недорого: фильтр работает по площади самого оверлея, а не всего кадра, + но на слабой машине лишним не будет, поэтому решает вызывающий. + Для сборки ролика это не применяется: там всё сводится по-настоящему. } function FlattenPreview(AProject: TProject; out AVideo, AAudio: TFlatSegmentArray; out AOverlays: TPreviewOverlays; - out AMissing: TGenRequests): Boolean; + out AMissing: TGenRequests; + AWithKey: Boolean = False): Boolean; + +{ Оставляет от списка кусков только то, что попадает в участок. + + Куски, задетые краем, подрезаются: у начального сдвигается точка входа в + исходник, у конечного укорачивается длина. Слои внутри куска сдвигаются + вместе с ним — иначе наложение поехало бы относительно картинки. + + Зачем: собрать кусок монтажа, не собирая весь ролик. На длинном + материале это разница между минутой и часом, и без этого проверить + правку в готовом файле почти невозможно. + + Возвращает, сколько секунд осталось. } +function ClipSegmentsToRange(var ASegments: TFlatSegmentArray; + const AFrom, ATo: Double): Double; { Путь к сгенерированному клипу. Имя выводится из содержимого запроса, поэтому одинаковые запросы дают один и тот же файл, и он делается @@ -271,6 +294,48 @@ begin ALayers[I].KeySimilarity, ALayers[I].KeyBlend]); end; +function ClipSegmentsToRange(var ASegments: TFlatSegmentArray; + const AFrom, ATo: Double): Double; +var + I, J, N: Integer; + At, SegStart, SegEnd, NewStart, NewEnd, Shift: Double; + Kept: TFlatSegmentArray; + Seg: TFlatSegment; +begin + Result := 0; + if ATo <= AFrom then + Exit; + + N := 0; + At := 0; + SetLength(Kept, Length(ASegments)); + for I := 0 to High(ASegments) do + begin + SegStart := At; + SegEnd := At + ASegments[I].Duration; + At := SegEnd; + + NewStart := Max(SegStart, AFrom); + NewEnd := Min(SegEnd, ATo); + if NewEnd <= NewStart + 0.0005 then + Continue; + + Seg := ASegments[I]; + Shift := NewStart - SegStart; + Seg.SrcStart := Seg.SrcStart + Shift; + Seg.Duration := NewEnd - NewStart; + for J := 0 to High(Seg.Layers) do + Seg.Layers[J].SrcStart := Seg.Layers[J].SrcStart + Shift; + + Kept[N] := Seg; + Inc(N); + Result := Result + Seg.Duration; + end; + + SetLength(Kept, N); + ASegments := Kept; +end; + procedure ResolveLayers(AProject: TProject; var ASegments: TFlatSegmentArray; var AMissing: TGenRequests); var @@ -431,6 +496,7 @@ var if It = nil then Exit; Result.FilePath := It.EffectivePath; + Result.IsImage := (AClip.Kind = ckImage) or (It.Info.Kind = mkImage); Result.SrcStart := AClip.SrcIn + (AAt - AClip.TlStart); Result.KeyEnabled := AClip.ColorKey.Enabled; Result.KeyColor := AClip.ColorKey.Color; @@ -1023,6 +1089,52 @@ begin end; end; +{ Вырезает из набора отрезков указанный. Отрезок посередине делит тот, в + который попал, надвое: оверлей, закрытый в середине, показывается двумя + окнами. } +procedure CutRange(var AFrom, ATo: TDoubleArray; var ACount: Integer; + const ACutFrom, ACutTo: Double); +var + I, N: Integer; + NewFrom, NewTo: array of Double; + + procedure Push(const A, B: Double); + begin + if B <= A + 0.001 then + Exit; + NewFrom[N] := A; + NewTo[N] := B; + Inc(N); + end; + +begin + if ACutTo <= ACutFrom then + Exit; + SetLength(NewFrom, ACount * 2 + 2); + SetLength(NewTo, ACount * 2 + 2); + N := 0; + for I := 0 to ACount - 1 do + begin + { Не пересекаются — отрезок остаётся как был. } + if (ACutTo <= AFrom[I] + 0.001) or (ACutFrom >= ATo[I] - 0.001) then + Push(AFrom[I], ATo[I]) + else + begin + Push(AFrom[I], ACutFrom); + Push(ACutTo, ATo[I]); + end; + end; + + ACount := N; + SetLength(AFrom, N); + SetLength(ATo, N); + for I := 0 to N - 1 do + begin + AFrom[I] := NewFrom[I]; + ATo[I] := NewTo[I]; + end; +end; + { Клип кладётся поверх, а не побеждает целиком, если он не сплошной: с выбитым цветом или полупрозрачный. } function IsOverlayClip(AClip: TClip): Boolean; @@ -1034,15 +1146,18 @@ end; function FlattenPreview(AProject: TProject; out AVideo, AAudio: TFlatSegmentArray; out AOverlays: TPreviewOverlays; - out AMissing: TGenRequests): Boolean; + out AMissing: TGenRequests; + AWithKey: Boolean): Boolean; var Hidden: TFPList; MissA: TGenRequests; - T, C, I, N: Integer; - Track: TTrack; + T, C, I, J, K, N: Integer; + Track, Above: TTrack; Clip: TClip; Item: TMediaItem; Total: Double; + RangeA, RangeB: TDoubleArray; + RangeCount: Integer; Ov: TPreviewOverlay; { Занято ли это время другим оверлеем. } @@ -1099,18 +1214,66 @@ begin Hidden.Add(Clip); - Ov := Default(TPreviewOverlay); - Ov.TlStart := Clip.TlStart; - Ov.TlEnd := Clip.TlEnd; - Ov.FilePath := Item.EffectivePath; - Ov.SrcStart := Clip.SrcIn; - Ov.Filter := OverlayFilter(Clip.Transform, - Item.Info.Width, Item.Info.Height, - AProject.Master.Width, AProject.Master.Height, - Ov.X, Ov.Y, Ov.Width, Ov.Height); - SetLength(AOverlays, N + 1); - AOverlays[N] := Ov; - Inc(N); + { Оверлей виден не всюду, где лежит: сверху его может закрывать + сплошной клип, и в готовом ролике его там не будет — побеждает + верхняя дорожка целиком. Показывать в окне то, чего не будет в + ролике, нельзя: именно из-за такого расхождения человек собирает + ролик и не находит в нём миникарты. + + Закрывать могут и посередине — тогда от оверлея остаётся + несколько отрезков, и каждый становится своим окном показа. } + RangeCount := 1; + SetLength(RangeA, 1); + SetLength(RangeB, 1); + RangeA[0] := Clip.TlStart; + RangeB[0] := Clip.TlEnd; + + for K := 0 to T - 1 do + begin + Above := AProject.Tracks[K]; + if Above.Kind <> tkVideo then + Continue; + if not AProject.TrackAudible(Above) then + Continue; + for J := 0 to Above.Count - 1 do + { Клип с ключом или прозрачностью сам ничего не закрывает. } + if not IsOverlayClip(Above[J]) then + CutRange(RangeA, RangeB, RangeCount, + Above[J].TlStart, Above[J].TlEnd); + end; + + for J := 0 to RangeCount - 1 do + begin + if RangeB[J] <= RangeA[J] + 0.001 then + Continue; + if OverlapsTaken(RangeA[J], RangeB[J]) then + Continue; + + Ov := Default(TPreviewOverlay); + Ov.TlStart := RangeA[J]; + Ov.TlEnd := RangeB[J]; + Ov.FilePath := Item.EffectivePath; + Ov.SrcStart := Clip.SrcIn + (RangeA[J] - Clip.TlStart); + Ov.Filter := OverlayFilter(Clip.Transform, + Item.Info.Width, Item.Info.Height, + AProject.Master.Width, AProject.Master.Height, + Ov.X, Ov.Y, Ov.Width, Ov.Height); + { Порядок тот же, что при сборке: сперва вписали в кадр, потом + выбили цвет, потом приглушили. Иначе смягчение края разошлось + бы с тем, что даст готовый ролик. } + if AWithKey then + begin + if Clip.ColorKey.Enabled then + Ov.Filter := Ov.Filter + ',' + ColorKeyFilter(Clip.ColorKey.Color, + Clip.ColorKey.Similarity, Clip.ColorKey.Blend); + if OpacityFilter(Clip.Opacity) <> '' then + Ov.Filter := Ov.Filter + ',' + OpacityFilter(Clip.Opacity); + end; + + SetLength(AOverlays, N + 1); + AOverlays[N] := Ov; + Inc(N); + end; end; end; diff --git a/src/uGenerate.pas b/src/uGenerate.pas index 1f16904..75b3fdb 100644 --- a/src/uGenerate.pas +++ b/src/uGenerate.pas @@ -226,11 +226,13 @@ begin FMaster.VideoCodec, FMaster.PixFmt, AudioCodec, FMaster.SampleRate, FMaster.Channels); gkImage: + { Фотография попадает в ролик наравне со съёмкой, и жать её + сильнее, чем её соседей, незачем. } Args := ArgsImageClip(FRequests[I].SourcePath, FRequests[I].TargetPath, FRequests[I].Duration, FMaster.Width, FMaster.Height, FMaster.FpsNum, FMaster.FpsDen, FMaster.VideoCodec, FMaster.PixFmt, AudioCodec, - FMaster.SampleRate, FMaster.Channels); + FMaster.SampleRate, FMaster.Channels, FMaster.VideoBitrate); gkSilence: Args := ArgsSilenceClip(FRequests[I].TargetPath, FRequests[I].Duration, AudioCodec, @@ -243,7 +245,7 @@ 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.PixFmt, FMaster.VideoCodec, False, FMaster.VideoBitrate); else Continue; end; diff --git a/src/uIconData.pas b/src/uIconData.pas index 3d096f3..2487924 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, $1E, $15, $14, $31, $9E, - $20, $4F, $DD, $00, $00, $01, $3E, $49, $44, $41, $54, $38, $CB, $BD, $92, $31, + $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, $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, $1E, $15, $14, $31, $9E, - $20, $4F, $DD, $00, $00, $01, $2F, $49, $44, $41, $54, $38, $CB, $CD, $D2, $3D, + $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, $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, $1E, $15, $14, $31, $9E, - $20, $4F, $DD, $00, $00, $01, $0F, $49, $44, $41, $54, $38, $CB, $B5, $D3, $BF, + $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, $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, $1E, $15, $14, $31, $9E, - $20, $4F, $DD, $00, $00, $01, $67, $49, $44, $41, $54, $38, $CB, $B5, $D3, $3D, + $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, $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, @@ -158,6 +158,59 @@ const $60, $82 ); + { icons8-цель-30.png, 24 на 24 точек } + IconTargetData: array[0..779] 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, $08, $1F, $07, $2E, $1B, $C7, + $2C, $48, $09, $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, + $44, $86, $D9, $4D, $9B, $0E, $3C, $4D, $58, $87, $14, $75, $22, $C8, $DC, $9C, + $2B, $78, $4A, $D9, $84, $04, $6B, $93, $B5, $34, $15, $BB, $FE, $6B, $65, $5D, + $B5, $F1, $F0, $67, $AC, $DD, $40, $D8, $73, $FB, $E0, $7B, $78, $DF, $E7, $7D, + $DE, $E7, $E5, $1E, $11, $B9, $EB, $9D, $B0, $43, $46, $1C, $81, $69, $57, $2D, + $68, $AE, $FD, $B0, $01, $3C, $67, $97, $1F, $3C, $E1, $8C, $59, $AF, $3A, $20, + $23, $26, $22, $30, $E3, $8A, $AF, $9D, $31, $77, $9B, $70, $1F, $D8, $E7, $4D, + $3D, $0E, $DA, $62, $DC, $92, $55, $C3, $4E, $18, $71, $C1, $8A, $27, $E5, $ED, + $35, $A9, $BE, $9E, $70, $53, $8F, $9C, $16, $BB, $B4, $29, $B9, $EC, $2F, $AB, + $96, $D5, $7C, $67, $C4, $8A, $17, $F4, $FA, $5D, $65, $6D, $6B, $AF, $59, $D2, + $D4, $D4, $54, $13, $D7, $6F, $D2, $8A, $9B, $AA, $4E, $D9, $2F, $29, $AF, $6C, + $42, $4F, $A8, $37, $AC, $30, $23, $65, $B7, $28, $56, $7C, $26, $EA, $5F, $A3, + $CE, $F9, $D3, $D3, $06, $6D, $74, $DA, $55, $03, $1E, $F1, $AD, $BF, $43, $42, + $C4, $0D, $E3, $5A, $65, $FD, $E3, $41, $71, $A3, $C6, $FC, $EC, $8A, $F3, $C6, + $A4, $1C, $D2, $EA, $0B, $6D, $06, $5C, $F3, $4B, $D8, $50, $D2, $3B, $9E, $F1, + $80, $B8, $AC, $93, $16, $14, $6D, $B5, $DB, $59, $25, $DD, $D2, $4A, $1A, $06, + $75, $A8, $38, $2D, $11, $56, $E8, $F2, $B6, $55, $97, $3D, $25, $6A, $D4, $66, + $07, $6C, $31, $66, $D2, $CB, $FA, $9D, $F7, $A3, $7D, $36, $3A, $27, $E3, $31, + $17, $5C, $83, $82, $79, $07, $ED, $F4, $9B, $8F, $B4, $48, $F9, $D4, $BC, $A2, + $94, $01, $93, $86, $B5, $2B, $AA, $EA, $74, $C8, $BC, $42, $68, $5C, $4C, $4C, + $5D, $9B, $AC, $39, $4D, $DB, $BC, $2F, $E2, $25, $81, $0F, $8C, $7B, $D6, $B2, + $8A, $C3, $EE, $57, $17, $13, $BB, $E5, $74, $B8, $22, $4D, $4D, $31, $43, $4E, + $38, $22, $B0, $24, $22, $72, $F7, $F2, $6C, $C0, $A2, $45, $59, $B3, $EA, $B6, + $6B, $71, $DD, $C7, $8E, $18, $42, $C1, $5E, $DF, $6B, $B5, $5D, $CD, $0D, $3B, + $2D, $5A, $24, $8A, $69, $33, $72, $16, $5C, $D4, $2B, $A3, $88, $4F, $7C, $6E, + $D8, $90, $C0, $49, $DB, $F4, $BA, $E8, $BA, $9C, $E9, $50, $32, $09, $5F, $AA, + $78, $D8, $7E, $73, $4A, $D2, $BA, $95, $D4, $D4, $0C, $EB, $96, $36, $A2, $A1, + $A0, $43, $35, $1C, $6B, $88, $57, $34, $BC, $2B, $E9, $B8, $40, $49, $97, $B4, + $84, $A4, $B4, $2E, $25, $81, $63, $12, $8E, $9A, $75, $F8, $B6, $92, $AD, $BE, + $32, $25, $AF, $DD, $71, $0D, $55, $45, $AF, $7B, $43, $51, $55, $C3, $31, $ED, + $FA, $4C, $39, $2B, $B5, $36, $36, $3D, $26, $94, $F5, $49, $1A, $74, $4A, $C5, + $B2, $65, $15, $23, $0A, $12, $FA, $94, $95, $3D, $BE, $7E, $5E, $51, $79, $13, + $A6, $BC, $A7, $43, $46, $A7, $3D, $F6, $E8, $94, $D1, $E1, $A8, $9A, $B2, $17, + $45, $EF, $8C, $68, $44, $CE, $5B, $72, $02, $DF, $B8, $A4, $8E, $87, $E4, $3C, + $6F, $93, $9F, $7C, $E8, $D2, $AD, $34, $AC, $B7, $65, $B3, $7E, $79, $8F, $CA, + $88, $B1, $26, $A2, $7F, $FC, $DF, $11, $D8, $64, $87, $AC, $B8, $A6, $C0, $B4, + $5F, $EF, $3C, $02, $F7, $8C, $FF, $00, $D3, $AE, $CE, $9E, $6E, $47, $CD, $DC, + $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/uMainForm.lfm b/src/uMainForm.lfm index c079a73..f9902ae 100644 --- a/src/uMainForm.lfm +++ b/src/uMainForm.lfm @@ -67,8 +67,19 @@ object MainForm: TMainForm ShowHint = True TabStop = False end + object btnCenter: TThemedButton + Left = 350 + Height = 28 + Top = 6 + Width = 28 + Down = True + Icon = tiTarget + OnClick = btnCenterClick + ShowHint = True + TabStop = False + end object btnRipple: TThemedButton - Left = 356 + Left = 386 Height = 28 Top = 6 Width = 28 @@ -78,7 +89,7 @@ object MainForm: TMainForm TabStop = False end object btnRippleMenu: TThemedButton - Left = 386 + Left = 416 Height = 28 Top = 6 Width = 22 @@ -87,10 +98,10 @@ object MainForm: TMainForm TabStop = False end object lblStatus: TLabel - Left = 458 + Left = 488 Height = 20 Top = 10 - Width = 810 + Width = 780 Anchors = [akTop, akLeft, akRight] AutoSize = False Caption = 'Готов.' diff --git a/src/uMainForm.pas b/src/uMainForm.pas index 2a34a93..57b24b6 100644 --- a/src/uMainForm.pas +++ b/src/uMainForm.pas @@ -47,6 +47,7 @@ type btnSnap: TThemedButton; btnGlue: TThemedButton; + btnCenter: TThemedButton; btnRipple: TThemedButton; btnRippleMenu: TThemedButton; lblPoolInfo: TLabel; @@ -67,6 +68,7 @@ type splitVideo: TSplitter; procedure btnSnapClick(Sender: TObject); procedure btnGlueClick(Sender: TObject); + procedure btnCenterClick(Sender: TObject); procedure btnRippleClick(Sender: TObject); procedure btnRippleMenuClick(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); @@ -97,6 +99,16 @@ type FLastLoadedEdl: string; FLastLoadedAudioEdl: string; { Наложение для плеера: список кусков оверлея и окна показа. } + { Журнал текущей сборки: файл рядом с готовым роликом. } + FExportLogPath: string; + { Разметка текста, отданная плееру в прошлый раз. } + FLastAss: string; + { Клип, с которого скопированы свойства. Хранится копией, а не + ссылкой: исходный клип могут удалить, а свойства должны остаться. } + FLookClip: TClip; + { Проект открыт из командной строки: спросить про клипы на чужих + дорожках можно только когда окно уже показано. } + FCheckMisplacedOnShow: Boolean; FPreviewOverlayUrl: string; FPreviewOverlayWindows: TOverlayWindows; { Списки кусков звуковых дорожек для плеера. } @@ -129,6 +141,9 @@ type первую. } FErrorCount: Integer; FLogButton: TThemedButton; + { Пункт «Ключ и прозрачность в предпросмотре»: галку в нём приходится + держать за руку — она не следует за настройкой сама. } + FKeyPreviewItem: TMenuItem; { Показанная доля выполнения. Отдельно от настоящей, потому что растёт она по своим правилам — см. AdvanceJobBar. } FJobShown: Double; @@ -172,6 +187,10 @@ type FPoolMenu: TPopupMenu; FPoolAddMenu: TMenuItem; FRippleMenu: TPopupMenu; + { Меню дорожки по правому щелчку в её заголовке. } + FTrackMenu: TPopupMenu; + { Дорожка, для которой открыто меню. } + FTrackMenuIndex: Integer; { Пункт «Недавние проекты» в меню «Файл». Его содержимое собирается заново при каждом изменении списка. } FRecentMenu: TMenuItem; @@ -193,8 +212,20 @@ type { Переписывает файл субтитров и отдаёт его плееру. } procedure UpdateSubtitles; procedure UpdateRippleButton; + procedure CheckMisplacedClips; + procedure BuildTrackMenu; + procedure TimelineTrackMenu(Sender: TObject; ATrackIndex: Integer; + const AScreenPos: TPoint); + procedure TimelineRegionChange(Sender: TObject); + procedure TrackMenuDelete(Sender: TObject); + procedure TrackMenuRename(Sender: TObject); + procedure TimelineTrackRename(Sender: TObject; ATrackIndex: Integer); + procedure TrackMenuUp(Sender: TObject); + procedure TrackMenuDown(Sender: TObject); procedure UpdateSnapButton; procedure UpdateGlueButton; + procedure UpdateCenterButton; + procedure ToggleCenterPlayhead; procedure RippleModeChosen(Sender: TObject); procedure ToggleRipple; procedure BuildPoolMenu; @@ -238,6 +269,7 @@ type procedure AdvanceJobBar; procedure LogButtonClick(Sender: TObject); procedure MenuToggleLog(Sender: TObject); + procedure MenuTogglePreviewKey(Sender: TObject); procedure MenuAbout(Sender: TObject); procedure MenuAddText(Sender: TObject); { Открывает редактор текста для клипа. True — что-то изменилось. } @@ -299,6 +331,14 @@ type procedure MenuSplitPrecise(Sender: TObject); procedure MenuDelete(Sender: TObject); procedure MenuColorKey(Sender: TObject); + procedure MenuCopyLook(Sender: TObject); + procedure MenuPasteLook(Sender: TObject); + function FirstSelectedClip: TClip; + procedure MenuRegionIn(Sender: TObject); + procedure MenuRegionOut(Sender: TObject); + procedure MenuRegionClear(Sender: TObject); + { Что и откуда собирать: с учётом отмеченного участка. } + procedure DescribeRegion(out AFrom, ATo: Double); procedure MenuSelectAll(Sender: TObject); procedure MenuRipple(Sender: TObject); procedure MenuToggleRipple(Sender: TObject); @@ -321,6 +361,10 @@ type procedure ExportDone(Sender: TObject); procedure ExportCancel(Sender: TObject); procedure ShowExportReport(const AReport: TExportReport); + { Строка и в общий журнал программы, и в журнал этой сборки. } + procedure LogExport(const AText: string); + { Предлагает продолжить прерванную сборку с готовых кусков. } + function AskResume(const AOutputPath: string): Boolean; procedure NormalizeProgress(Sender: TObject); procedure NormalizeLog(Sender: TObject); procedure NormalizeDone(Sender: TObject); @@ -416,6 +460,7 @@ begin lstPool.DragMode := dmAutomatic; BuildPoolMenu; + BuildTrackMenu; RefreshRecentMenu; AllowDropFiles := True; OnDropFiles := @FormFilesDropped; @@ -424,6 +469,7 @@ begin UpdateRippleButton; UpdateSnapButton; UpdateGlueButton; + UpdateCenterButton; UpdateCaption; SetStatus('Готов. Добавьте файлы в проект.'); @@ -441,6 +487,7 @@ end; procedure TMainForm.FormDestroy(Sender: TObject); begin Log('Закрытие: останавливаю предпросмотр.'); + FreeAndNil(FLookClip); FPreviewTimer.Enabled := False; if Assigned(FThumbThread) then begin @@ -555,6 +602,9 @@ begin FTimeline.OnMediaDrop := @TimelineMediaDrop; FTimeline.OnClipTransform := @TimelineClipTransform; FTimeline.OnTrackAdded := @TimelineTrackAdded; + FTimeline.OnTrackMenu := @TimelineTrackMenu; + FTimeline.OnTrackRename := @TimelineTrackRename; + FTimeline.OnRegionChange := @TimelineRegionChange; FTimeline.OnActiveTrackChange := @TimelineActiveTrackChange; end; @@ -583,8 +633,10 @@ procedure TMainForm.BuildMenu; FMenu.Items.Add(Result); end; - procedure AddItem(AParent: TMenuItem; const ACaption: string; - AHandler: TNotifyEvent; AShortCut: TShortCut = 0); + { Возвращает созданный пункт: у пунктов с галкой её потом надо ставить + и снимать, а искать пункт по названию — способ ненадёжный. } + function AddItem(AParent: TMenuItem; const ACaption: string; + AHandler: TNotifyEvent; AShortCut: TShortCut = 0): TMenuItem; var Item: TMenuItem; begin @@ -593,6 +645,7 @@ procedure TMainForm.BuildMenu; Item.OnClick := AHandler; Item.ShortCut := AShortCut; AParent.Add(Item); + Result := Item; end; procedure AddSep(AParent: TMenuItem); @@ -658,6 +711,15 @@ begin AddItem(MEdit, 'Выделить всё', @MenuSelectAll, ShortCut(VK_A, [ssCtrl])); AddItem(MEdit, 'Цветовой ключ клипа...', @MenuColorKey); AddSep(MEdit); + AddItem(MEdit, 'Скопировать свойства клипа', @MenuCopyLook, + ShortCut(VK_C, [ssCtrl, ssShift])); + AddItem(MEdit, 'Применить свойства к выделенным', @MenuPasteLook, + ShortCut(VK_V, [ssCtrl, ssShift])); + AddSep(MEdit); + AddItem(MEdit, 'Отметить начало участка', @MenuRegionIn, ShortCut(VK_I, [])); + AddItem(MEdit, 'Отметить конец участка', @MenuRegionOut, ShortCut(VK_O, [])); + AddItem(MEdit, 'Снять отметки участка', @MenuRegionClear); + AddSep(MEdit); AddItem(MEdit, 'Схлопнуть дыру под курсором', @MenuRipple, ShortCut(VK_R, [ssCtrl, ssShift])); AddItem(MEdit, 'Автосхлопывание при перетаскивании', @MenuToggleRipple, @@ -675,6 +737,11 @@ begin AddItem(MView, 'Отдалить', @MenuZoomOut, ShortCut(VK_SUBTRACT, [ssCtrl])); AddSep(MView); AddItem(MView, 'Журнал сообщений', @MenuToggleLog, ShortCut(VK_L, [ssCtrl])); + AddSep(MView); + FKeyPreviewItem := AddItem(MView, 'Ключ и прозрачность в предпросмотре', + @MenuTogglePreviewKey); + FKeyPreviewItem.AutoCheck := False; + FKeyPreviewItem.Checked := FSettings.PreviewKey; MProject := AddTop('Проект'); AddItem(MProject, 'Сведения о проекте...', @MenuProjectInfo); @@ -769,7 +836,7 @@ procedure TMainForm.BuildJobIndicator; const JobWidth = 330; LogButtonWidth = 28; - LogButtonLeft = 418; + LogButtonLeft = 448; begin FJobLabel := TLabel.Create(Self); FJobLabel.Parent := pnlBottom; @@ -855,7 +922,7 @@ begin FProject.BeginChange; if Track = nil then - Track := FProject.AddTrackOfKind('Т1', tkText); + Track := FProject.AddTrackOfKind(FProject.UniqueTrackName('Т'), tkText); Clip := TClip.Create; Clip.Id := FProject.NewId('c'); @@ -1129,6 +1196,7 @@ begin UpdateRippleButton; UpdateCaption; SchedulePreview; + FCheckMisplacedOnShow := True; end else Log('Не удалось открыть проект: ' + Err); @@ -1145,6 +1213,14 @@ begin if lstPool.Items.Count > 0 then lstPool.ItemIndex := 0; end; + + { Спрашивать про клипы на чужих дорожках можно только теперь: окно + показано, и вопрос не окажется за кадром. } + if FCheckMisplacedOnShow then + begin + FCheckMisplacedOnShow := False; + CheckMisplacedClips; + end; end; { Проверка не по одному месту, а разом: человеку нужен ответ «чего не @@ -1636,7 +1712,9 @@ var Track: TTrack; Mismatches: TMismatches; Duration, PlaceAt: Double; - NormPath: string; + NormPath, Wanted: string; + NeedKind: TTrackKind; + I: Integer; begin Result := False; if (APoolIndex < 0) or (APoolIndex >= FProject.PoolCount) then @@ -1648,8 +1726,7 @@ begin if ATrackIndex < 0 then begin - FProject.AddTrack('V' + - IntToStr(FProject.TrackCountOf(tkVideo) + 1)); + FProject.AddTrack(FProject.UniqueTrackName('V')); ATrackIndex := FProject.TrackCount - 1; Log('Заведена дорожка ' + FProject.Tracks[ATrackIndex].Name); end; @@ -1657,6 +1734,36 @@ begin ATrackIndex := FProject.TrackCount - 1; Track := FProject.Tracks[ATrackIndex]; + { Дорожка чужого вида не годится: клип на ней не увидит ни сборка, ни + предпросмотр — уплощение обходит дорожки по видам. Поэтому не кладём + туда молча, а находим подходящую и говорим, куда положили. } + { Файл без картинки — только звук; всё остальное идёт на дорожку + картинки, а парный звук программа положит сама. } + if Item.Info.HasVideo or (Item.Info.Kind = mkImage) then + NeedKind := tkVideo + else + NeedKind := tkAudio; + if Track.Kind <> NeedKind then + begin + Wanted := Track.Name; + Track := nil; + for I := 0 to FProject.TrackCount - 1 do + if FProject.Tracks[I].Kind = NeedKind then + begin + Track := FProject.Tracks[I]; + Break; + end; + if Track = nil then + begin + if NeedKind = tkAudio then + Track := FProject.AddTrackOfKind(FProject.UniqueTrackName('A'), tkAudio) + else + Track := FProject.AddTrack(FProject.UniqueTrackName('V')); + end; + Log(Format('Дорожка %s не для этого вида клипов — положил на %s.', + [Wanted, Track.Name])); + end; + { Предупреждаем именно здесь, при попадании на монтаж: пока файл просто лежит в списке, он ни с чем не склеивается. } Mismatches := CompareToMaster(FProject.Master, Item.Info); @@ -1865,6 +1972,7 @@ procedure TMainForm.RebuildPreview; var Segments, AudioSegs, TrackSegs: TFlatSegmentArray; Overlays: TPreviewOverlays; + GenMaster: TMediaInfo; Missing, TrackMissing: TGenRequests; I, J: Integer; TotalLen: Double; @@ -1882,7 +1990,8 @@ begin { Уплощение для предпросмотра: клипы, которые кладутся поверх, идут отдельно. Плеер положит их сам, ничего не собирая. } - if not FlattenPreview(FProject, Segments, AudioSegs, Overlays, Missing) then + if not FlattenPreview(FProject, Segments, AudioSegs, Overlays, Missing, + FSettings.PreviewKey) then begin FPlayer.Stop; FLastLoadedEdl := ''; @@ -1940,7 +2049,11 @@ begin begin FGenerateBusy := True; SetStatus('Готовлю вставки для предпросмотра...'); - FGenerate := TGenerateThread.Create(Missing, FProject.Master); + { Вставки — картинки и связки — попадают в ролик наравне со съёмкой, + поэтому целятся в тот же битрейт. } + GenMaster := FProject.Master; + GenMaster.VideoBitrate := FProject.MaxVideoBitrate; + FGenerate := TGenerateThread.Create(Missing, GenMaster); FGenerate.OnProgress := @GenerateProgress; FGenerate.OnLog := @GenerateLog; FGenerate.OnTerminate := @GenerateDone; @@ -2166,12 +2279,59 @@ begin FSettings.NoteRecentProject(FProject.FileName); RefreshRecentMenu; Log('Открыт проект: ' + FProject.FileName); + CheckMisplacedClips; end; { --- Схлопывание --- } { Кнопка показывает и состояние, и режим: утоплена — автосхлопывание включено, надпись говорит, на какие дорожки оно действует. } +{ Клипы на дорожках чужого вида: находим и предлагаем перенести. + + Такой клип нарисован на монтаже, но в ролик не попадает: уплощение + обходит дорожки по видам и клип с чужой дорожки не видит. Пропажа тихая + — сборка проходит без единой жалобы, а в готовом файле фотографии или + надписи нет. Проверено на живом проекте, где фотография оказалась на + текстовой дорожке, а надпись — на дорожке картинки. + + Молча переносить нельзя: человек мог положить клип туда осознанно, и + внезапно переехавший клип — сюрприз хуже пропажи. Поэтому спрашиваем. } +procedure TMainForm.CheckMisplacedClips; +var + N: Integer; +begin + N := FProject.MisplacedClipCount; + if N = 0 then + Exit; + + Log(Format('ВНИМАНИЕ: %d %s на дорожках чужого вида — в сборку они не попадут.', + [N, Plural(N, 'клип', 'клипа', 'клипов')])); + + if ThemedMessageDlg('nlve', + Format('В проекте %d %s лежит на дорожках не своего вида: ' + + 'картинка на звуковой или текстовой, надпись на дорожке картинки.' + + LineEnding + LineEnding + + 'Такой клип виден на монтаже, но в готовый ролик не попадает — ' + + 'ни в сборку, ни в предпросмотр.' + LineEnding + LineEnding + + 'Перенести их на подходящие дорожки? Время клипов не изменится.', + [N, Plural(N, 'клип', 'клипа', 'клипов')]), + mtWarning, [mbYes, mbNo], 0) <> mrYes then + begin + SetStatus(Format('%d %s не попадёт в сборку: они на дорожках чужого вида.', + [N, Plural(N, 'клип', 'клипа', 'клипов')])); + Exit; + end; + + FProject.BeginChange; + N := FProject.FixMisplacedClips; + FTimeline.Invalidate; + FLastLoadedEdl := ''; + SchedulePreview; + UpdateCaption; + Log(Format('Перенесено на подходящие дорожки: %d.', [N])); + SetStatus(Format('Перенесено клипов: %d.', [N])); +end; + procedure TMainForm.UpdateRippleButton; var ModeText: string; @@ -2242,6 +2402,43 @@ begin UpdateGlueButton; end; +{ Держать ли курсор посередине при воспроизведении. + + Включено — монтаж едет под курсором, и всегда видно, что будет дальше. + Выключено — картинка стоит на месте, пока курсор не уйдёт за край; так + спокойнее, когда разглядываешь конкретное место, а ролик при этом + играет. } +procedure TMainForm.UpdateCenterButton; +var + State: string; +begin + btnCenter.Down := FSettings.CenterPlayhead; + if FSettings.CenterPlayhead then + State := 'включено' + else + State := 'выключено'; + btnCenter.Hint := 'Курсор посередине при воспроизведении: ' + State + '.' + + LineEnding + 'Клавиша \ переключает.'; +end; + +procedure TMainForm.ToggleCenterPlayhead; +begin + FSettings.CenterPlayhead := not FSettings.CenterPlayhead; + UpdateCenterButton; + if FSettings.CenterPlayhead then + begin + FTimeline.ScrollToPlayhead(True); + SetStatus('Курсор держится посередине монтажа.'); + end + else + SetStatus('Монтаж стоит на месте, курсор идёт по нему.'); +end; + +procedure TMainForm.btnCenterClick(Sender: TObject); +begin + ToggleCenterPlayhead; +end; + procedure TMainForm.ToggleRipple; begin FProject.RippleEnabled := not FProject.RippleEnabled; @@ -2281,6 +2478,143 @@ begin FRippleMenu.PopUp(P.X, P.Y); end; +{ --- Меню дорожки --- } + +{ Меню по правому щелчку в заголовке дорожки. + + Раньше дорожку можно было только добавить и убрать последнюю, а убрать + чаще нужно не последнюю. Порядок дорожек тоже правится здесь — тем, кому + перетаскивание заголовка неудобно. } +{ Участок подвинули мышью: показываем, что вышло, и помечаем проект + изменённым — отметки в нём и хранятся. } +procedure TMainForm.TimelineRegionChange(Sender: TObject); +begin + FProject.Modified := True; + UpdateCaption; + if FProject.HasRegion then + SetStatus(Format('Участок: %s — %s', + [SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)])) + else + SetStatus('Отметки участка сняты: собирается весь монтаж.'); +end; + +procedure TMainForm.BuildTrackMenu; +var + Item: TMenuItem; +begin + FTrackMenu := TPopupMenu.Create(Self); + + Item := TMenuItem.Create(FTrackMenu); + Item.Caption := 'Поднять дорожку'; + Item.OnClick := @TrackMenuUp; + FTrackMenu.Items.Add(Item); + + Item := TMenuItem.Create(FTrackMenu); + Item.Caption := 'Опустить дорожку'; + Item.OnClick := @TrackMenuDown; + FTrackMenu.Items.Add(Item); + + Item := TMenuItem.Create(FTrackMenu); + Item.Caption := 'Переименовать...'; + Item.OnClick := @TrackMenuRename; + FTrackMenu.Items.Add(Item); + + Item := TMenuItem.Create(FTrackMenu); + Item.Caption := '-'; + FTrackMenu.Items.Add(Item); + + Item := TMenuItem.Create(FTrackMenu); + Item.Caption := 'Удалить дорожку'; + Item.OnClick := @TrackMenuDelete; + FTrackMenu.Items.Add(Item); +end; + +procedure TMainForm.TimelineTrackMenu(Sender: TObject; ATrackIndex: Integer; + const AScreenPos: TPoint); +begin + if (ATrackIndex < 0) or (ATrackIndex >= FProject.TrackCount) then + Exit; + FTrackMenuIndex := ATrackIndex; + FTrackMenu.Items[0].Enabled := ATrackIndex > 0; + FTrackMenu.Items[1].Enabled := ATrackIndex < FProject.TrackCount - 1; + FTrackMenu.PopUp(AScreenPos.X, AScreenPos.Y); +end; + +procedure TMainForm.TrackMenuUp(Sender: TObject); +begin + if FTrackMenuIndex <= 0 then + Exit; + FProject.BeginChange; + FProject.MoveTrack(FTrackMenuIndex, FTrackMenuIndex - 1); + TimelineStructureChange(nil); + SetStatus('Дорожка поднята.'); +end; + +procedure TMainForm.TrackMenuDown(Sender: TObject); +begin + if (FTrackMenuIndex < 0) or (FTrackMenuIndex >= FProject.TrackCount - 1) then + Exit; + FProject.BeginChange; + FProject.MoveTrack(FTrackMenuIndex, FTrackMenuIndex + 1); + TimelineStructureChange(nil); + SetStatus('Дорожка опущена.'); +end; + +{ Удаление дорожки. С клипами — только с подтверждением: вместе с + дорожкой уходит всё, что на ней лежит, а отменить можно только одним + шагом назад. } +{ Переименование дорожки. + + Имя — только подпись, но на монтаже из десятка дорожек «карта», «звук + мотора» и «титры» читаются несравнимо лучше, чем V1, A2 и Т1. } +procedure TMainForm.TimelineTrackRename(Sender: TObject; ATrackIndex: Integer); +var + NewName: string; +begin + if (ATrackIndex < 0) or (ATrackIndex >= FProject.TrackCount) then + Exit; + NewName := FProject.Tracks[ATrackIndex].Name; + if not ThemedInputDlg('Имя дорожки', 'Как назвать дорожку:', NewName) then + Exit; + + FProject.BeginChange; + FProject.Tracks[ATrackIndex].Name := NewName; + FProject.EnsureUniqueTrackNames; + FTimeline.Invalidate; + UpdateCaption; + SetStatus('Дорожка названа: ' + FProject.Tracks[ATrackIndex].Name); +end; + +procedure TMainForm.TrackMenuRename(Sender: TObject); +begin + TimelineTrackRename(nil, FTrackMenuIndex); +end; + +procedure TMainForm.TrackMenuDelete(Sender: TObject); +var + Track: TTrack; + { Не Name: так называется свойство самой формы, и локальная переменная + его перекроет — компилятор ловит, но сообщение неочевидное. } + TrackName: string; +begin + if (FTrackMenuIndex < 0) or (FTrackMenuIndex >= FProject.TrackCount) then + Exit; + Track := FProject.Tracks[FTrackMenuIndex]; + TrackName := Track.Name; + + if (Track.Count > 0) and (ThemedMessageDlg('nlve', + Format('На дорожке %s %d %s. Удалить её вместе с ними?', + [TrackName, Track.Count, + Plural(Track.Count, 'клип', 'клипа', 'клипов')]), + mtConfirmation, [mbYes, mbNo], 0) <> mrYes) then + Exit; + + FProject.BeginChange; + FProject.RemoveTrack(FTrackMenuIndex); + TimelineStructureChange(nil); + SetStatus('Дорожка ' + TrackName + ' удалена.'); +end; + { --- Меню библиотеки --- } procedure TMainForm.BuildPoolMenu; @@ -2608,18 +2942,30 @@ end; Пересобирать цепочку на каждый кадр нельзя — она создаётся заново и звук щёлкает. Поэтому только при изменении. } +{ Разметка текста для предпросмотра. + + Сравнивается сама разметка, а не имя файла: имя у неё одно на весь + проект, и правка текста его не меняет. Плеер же, увидев прежнее имя, + файл не перечитывал — и новая надпись в окне не появлялась вовсе, пока + не перезагрузится весь список кусков. } procedure TMainForm.UpdateSubtitles; var - Path: string; + { Не Text: так называется свойство формы. } + Path, Markup: string; begin if (FProject = nil) or (FPlayer = nil) then Exit; if FProject.CacheDir = '' then Exit; + Markup := BuildAss(FProject); + if Markup = FLastAss then + Exit; + FLastAss := Markup; + Path := IncludeTrailingPathDelimiter(FProject.CacheDir) + 'subs.ass'; - if WriteAssFile(FProject, Path) then - FPlayer.SetSubtitleFile(Path) + if (Markup <> '') and WriteAssFile(FProject, Path) then + FPlayer.SetSubtitleFile(Path, True) else FPlayer.SetSubtitleFile(''); end; @@ -2784,8 +3130,11 @@ begin FTimeline.Playhead := FPlayer.TimePos; { Во время воспроизведения держим курсор посередине: так видно, что будет дальше, и не приходится гоняться за ним прокруткой. } + { Держать курсор посередине или дать монтажу стоять — решает человек: + на слабой машине и на мелком масштабе постоянная прокрутка мешает + разглядывать. } if not FPlayer.Paused then - FTimeline.ScrollToPlayhead(True); + FTimeline.ScrollToPlayhead(FSettings.CenterPlayhead); finally FUpdatingFromPlayer := False; end; @@ -2863,6 +3212,15 @@ begin begin Key := 0; TogglePlayback; + Exit; + end; + + { Обратная косая: пункта меню для неё нет намеренно — сочетание из + одной такой клавиши в меню выглядит как опечатка, а работать должно. } + if (Key = VK_OEM_5) and (Shift = []) then + begin + Key := 0; + ToggleCenterPlayhead; end; end; @@ -3099,6 +3457,137 @@ begin SetStatus('Цветовой ключ выключен.'); end; +{ Отметки участка. + + Участок нужен, чтобы собрать кусок монтажа, а не весь ролик: на длинном + материале проверить правку иначе почти невозможно — сборка занимает + столько же, сколько сам ролик, а то и больше. + + Отметки ставятся по курсору, как в монтажных программах. Перепутанные + местами меняются сами: требовать от человека помнить порядок — лишняя + строгость там, где всё однозначно. } +{ Первый выделенный клип: с него берут свойства. } +function TMainForm.FirstSelectedClip: TClip; +var + T, C: Integer; +begin + Result := nil; + for T := 0 to FProject.TrackCount - 1 do + for C := 0 to FProject.Tracks[T].Count - 1 do + if FProject.Tracks[T][C].Selected then + Exit(FProject.Tracks[T][C]); +end; + +{ Копирование оформления с клипа на клип. + + Настроить кадрирование, ключ и прозрачность — работа на минуты, а + клипов с одинаковой настройкой в монтаже бывает десяток: та же + миникарта, разрезанная на куски, или несколько снимков в одной рамке. } +procedure TMainForm.MenuCopyLook(Sender: TObject); +var + Src: TClip; +begin + Src := FirstSelectedClip; + if Src = nil then + begin + SetStatus('Сначала выделите клип, с которого брать свойства.'); + Exit; + end; + + if FLookClip = nil then + FLookClip := TClip.Create; + FLookClip.Kind := Src.Kind; + FLookClip.CopyLookFrom(Src); + SetStatus('Свойства клипа скопированы. Применить: Ctrl+Shift+V.'); +end; + +procedure TMainForm.MenuPasteLook(Sender: TObject); +var + T, C, N: Integer; +begin + if FLookClip = nil then + begin + SetStatus('Сначала скопируйте свойства клипа: Ctrl+Shift+C.'); + Exit; + end; + + N := 0; + FProject.BeginChange; + for T := 0 to FProject.TrackCount - 1 do + for C := 0 to FProject.Tracks[T].Count - 1 do + if FProject.Tracks[T][C].Selected then + begin + FProject.Tracks[T][C].CopyLookFrom(FLookClip); + Inc(N); + end; + + if N = 0 then + begin + FProject.CancelChange; + SetStatus('Выделите клипы, к которым применить свойства.'); + Exit; + end; + + FTimeline.Invalidate; + FLastLoadedEdl := ''; + SchedulePreview; + UpdateCaption; + SetStatus(Format('Свойства применены к %d %s.', + [N, Plural(N, 'клипу', 'клипам', 'клипам')])); +end; + +procedure TMainForm.MenuRegionIn(Sender: TObject); +begin + FProject.RegionStart := FTimeline.Playhead; + if FProject.RegionEnd <= FProject.RegionStart then + FProject.RegionEnd := FProject.EndTime; + FTimeline.Invalidate; + UpdateCaption; + SetStatus(Format('Участок: %s — %s', + [SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)])); +end; + +procedure TMainForm.MenuRegionOut(Sender: TObject); +var + Tmp: Double; +begin + FProject.RegionEnd := FTimeline.Playhead; + if FProject.RegionEnd < FProject.RegionStart then + begin + Tmp := FProject.RegionStart; + FProject.RegionStart := FProject.RegionEnd; + FProject.RegionEnd := Tmp; + end; + FTimeline.Invalidate; + UpdateCaption; + SetStatus(Format('Участок: %s — %s', + [SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)])); +end; + +procedure TMainForm.MenuRegionClear(Sender: TObject); +begin + FProject.RegionStart := 0; + FProject.RegionEnd := 0; + FTimeline.Invalidate; + UpdateCaption; + SetStatus('Отметки участка сняты: собирается весь монтаж.'); +end; + +{ Границы того, что собираем. Без отметок — весь монтаж. } +procedure TMainForm.DescribeRegion(out AFrom, ATo: Double); +begin + if FProject.HasRegion then + begin + AFrom := Max(0, FProject.RegionStart); + ATo := FProject.RegionEnd; + end + else + begin + AFrom := 0; + ATo := FProject.EndTime; + end; +end; + procedure TMainForm.MenuSelectAll(Sender: TObject); begin FTimeline.SelectAll; @@ -3111,6 +3600,29 @@ end; { К началу самого раннего клипа по всем дорожкам. Если монтаж начинается с пятой секунды, ноль — не то место, куда хотят попасть. } +{ Показывать ли в предпросмотре то, что даст сборка. + + Выключено — оверлей виден целиком, со своим фоном: так понятно, куда он + встал и где его края. Включено — выбитый цвет и прозрачность считаются + на лету, и окно совпадает с готовым роликом. + + Считается это не бесплатно, хотя и недорого: фильтр работает по площади + оверлея, а не всего кадра. Замерено на 2688x1512: наложение стоит 0.36 с + на десять секунд материала, ключ добавляет ещё 0.23 с. } +procedure TMainForm.MenuTogglePreviewKey(Sender: TObject); +begin + FSettings.PreviewKey := not FSettings.PreviewKey; + FKeyPreviewItem.Checked := FSettings.PreviewKey; + { Список кусков не изменился, а показывать надо иначе — заставляем + пересобрать цепочку. } + FLastLoadedEdl := ''; + SchedulePreview; + if FSettings.PreviewKey then + SetStatus('Предпросмотр показывает ключ и прозрачность.') + else + SetStatus('Предпросмотр показывает оверлей как есть.'); +end; + procedure TMainForm.MenuToggleRipple(Sender: TObject); begin ToggleRipple; @@ -3147,8 +3659,7 @@ end; procedure TMainForm.MenuAddTrack(Sender: TObject); begin FProject.BeginChange; - FProject.AddTrack('V' + - IntToStr(FProject.TrackCountOf(tkVideo) + 1)); + FProject.AddTrack(FProject.UniqueTrackName('V')); FTimeline.Invalidate; UpdateCaption; end; @@ -3223,8 +3734,9 @@ var Missing: TGenRequests; HasPrecise: Boolean; T, C: Integer; - Rebuilt: Double; - SubsPath: string; + Rebuilt, RegionFrom, RegionTo: Double; + SubsPath, RegionCaption, Extra: string; + Master: TMediaInfo; begin if not FlattenProject(FProject, Segments, AudioSegs, Missing) then begin @@ -3242,14 +3754,16 @@ begin Exit; end; + DescribeRegion(RegionFrom, RegionTo); + RegionCaption := ''; + if FProject.HasRegion then + RegionCaption := SecondsToStr(RegionFrom) + ' — ' + SecondsToStr(RegionTo); + { Сколько материала придётся пересобрать. Наложение, переход, полупрозрачность и чужие параметры файла — всё это перекодирование, и человек должен знать цену заранее, а не обнаружить её по времени сборки. } Rebuilt := 0; - for T := 0 to High(Segments) do - if Segments[T].Transcode or (Length(Segments[T].Layers) > 0) then - Rebuilt := Rebuilt + Segments[T].Duration; { Если есть хоть один точный рез, предупреждаем про контейнер: в MP4 перекодированный кусок и скопированный уживаются не всегда, а MKV @@ -3264,10 +3778,29 @@ begin { Куда собирать, в каком контейнере и что делать с текстом — один вопрос: ответ на любую его часть меняет допустимое в остальных. } if not AskExport(FExportChoice, HasText(FProject), HasPrecise, - FSettings.LastExportDir) then + FSettings.LastExportDir, RegionCaption) then Exit; FSettings.LastExportDir := ExtractFilePath(FExportChoice.Path); + { Участок режется после вопроса: человек мог снять галку и собрать всё. + Картинка и звук подрезаются по одному времени, иначе они разъедутся. } + if not (FProject.HasRegion and FExportChoice.RegionOnly) then + begin + RegionFrom := 0; + RegionTo := TotalDuration(Segments); + end + else + begin + ClipSegmentsToRange(Segments, RegionFrom, RegionTo); + ClipSegmentsToRange(AudioSegs, RegionFrom, RegionTo); + if Length(Segments) = 0 then + begin + ThemedMessageDlg('nlve', + 'В отмеченном участке нечего собирать.', mtInformation, [mbOK], 0); + Exit; + end; + end; + if HasPrecise and (LowerCase(ExtractFileExt(FExportChoice.Path)) <> '.mkv') then if ThemedMessageDlg('nlve', @@ -3277,19 +3810,30 @@ begin mtWarning, [mbYes, mbNo], 0) <> mrYes then Exit; + { Сколько материала придётся пересобрать — считаем уже по тому списку, + который пойдёт в сборку: с участком он короче, и обещать человеку + работу на весь ролик было бы неправдой. } + for T := 0 to High(Segments) do + if Segments[T].Transcode or (Length(Segments[T].Layers) > 0) then + Rebuilt := Rebuilt + Segments[T].Duration; + { Вжигание меняет расклад: куски с текстом перестают копироваться. Готовим их до подсчёта того, сколько придётся пересобрать. } SubsPath := ''; if HasText(FProject) then begin if FExportChoice.BurnText then + { Начало списка — не обязательно начало монтажа: при отмеченном + участке текст надо брать с его начала. } Rebuilt := Rebuilt + - BurnTextIntoSegments(FProject, Segments, FProject.CacheDir) + BurnTextIntoSegments(FProject, Segments, FProject.CacheDir, RegionFrom) else begin SubsPath := IncludeTrailingPathDelimiter(FProject.CacheDir) + 'export.ass'; - if not WriteAssFile(FProject, SubsPath) then + { Разметка тоже по участку: иначе субтитры в готовом файле + появлялись бы со сдвигом на его начало. } + if not WriteAssForRange(FProject, RegionFrom, RegionTo, SubsPath) then SubsPath := ''; end; end; @@ -3307,14 +3851,68 @@ begin mtConfirmation, [mbYes, mbNo], 0) <> mrYes then Exit; - Log('Сборка в ' + FExportChoice.Path); - Log(Format('%d %s, длительность %s с', + { Пересобираемые куски целятся в битрейт самого щедрого исходника, а не + в то, что кодировщик выберет сам: его выбор скромнее в разы, и + пересобранный кусок оказывается заметно хуже соседних скопированных. } + Master := FProject.Master; + Master.VideoBitrate := FProject.MaxVideoBitrate; + + { Журнал этой сборки: рядом с готовым файлом, под тем же именем. + Прежний одноимённый убираем — иначе две сборки слиплись бы в один + файл, и разобрать, где чья, было бы нельзя. } + FExportLogPath := ChangeFileExt(FExportChoice.Path, '.log'); + if FileExists(FExportLogPath) then + SysUtils.DeleteFile(FExportLogPath); + + LogExport(Format('nlve, сборка от %s', + [FormatDateTime('yyyy-mm-dd hh:nn:ss', Now)])); + LogExport('Проект: ' + FProject.FileName); + LogExport('Готовый файл: ' + FExportChoice.Path); + if FProject.HasRegion and FExportChoice.RegionOnly then + LogExport(Format('Собирается отмеченный участок: %s — %s', + [SecondsToStr(RegionFrom), SecondsToStr(RegionTo)])) + else + LogExport('Собирается весь монтаж.'); + LogExport(Format('Кадр проекта: %dx%d, %d/%d к/с, %s, %s', + [Master.Width, Master.Height, Master.FpsNum, Master.FpsDen, + Master.VideoCodec, Master.PixFmt])); + LogExport(Format('Целевой битрейт: %d кбит/с (наибольший среди файлов проекта)', + [Master.VideoBitrate div 1000])); + if FExportChoice.BurnText then + LogExport('Текст вжигается в картинку.') + else if SubsPath <> '' then + LogExport('Текст идёт отдельной дорожкой субтитров.') + else if HasText(FProject) then + LogExport('ВНИМАНИЕ: текст в проекте есть, но в сборку не попадает.'); + LogExport(Format('%d %s, длительность %s с', [Length(Segments), Plural(Length(Segments), 'кусок', 'куска', 'кусков'), SecondsToStr(TotalDuration(Segments))])); + { Что именно собирается — по кускам. Без этого списка по журналу нельзя + понять, попал ли в сборку тот клип, которого потом не нашли в ролике. } + for T := 0 to High(Segments) do + begin + Extra := ''; + if Length(Segments[T].Layers) > 0 then + Extra := Extra + ', слоёв ' + IntToStr(Length(Segments[T].Layers)); + if Segments[T].SubFile <> '' then + Extra := Extra + ', с текстом'; + if Segments[T].Transcode then + Extra := Extra + ', пересобирается'; + LogExport(Format(' кусок %d: %s, из %s, длина %s%s', + [T + 1, ExtractFileName(Segments[T].FilePath), + SecondsToStr(Segments[T].SrcStart), SecondsToStr(Segments[T].Duration), + Extra])); + end; + + { Временные куски после удачной сборки убираются: они весят столько же, + сколько готовый ролик, а нужны только чтобы продолжить прерванную + сборку. После неудачи их никто не трогает. } FExport := TExportThread.Create(Segments, AudioSegs, - FExportChoice.Path, True, FProject.Master, AProfile); + FExportChoice.Path, FSettings.KeepParts, Master, AProfile); FExport.SubtitlePath := SubsPath; + FExport.LogPath := FExportLogPath; + FExport.Resume := AskResume(FExportChoice.Path); FExport.OnProgress := @ExportProgress; FExport.OnLog := @ExportLog; FExport.OnTerminate := @ExportDone; @@ -3334,6 +3932,10 @@ begin if Assigned(FExport) then begin FExport.WaitFor; + if FExport.ReusedParts > 0 then + LogExport(Format('Взято готовыми из прошлой сборки: %d %s.', + [FExport.ReusedParts, + Plural(FExport.ReusedParts, 'кусок', 'куска', 'кусков')])); ShowExportReport(FExport.Report); FreeAndNil(FExport); end; @@ -3372,6 +3974,77 @@ begin FExportUi.AddLog('Файл: ' + Rep.OutputPath); end; +{ Журнал сборки лежит рядом с готовым файлом и называется так же. + + Зачем отдельно от общего журнала программы: тот перезаписывается при + следующем запуске, а разбираться, почему в ролике не то, приходится + потом — иногда через неделю. Рядом с файлом журнал никуда не денется и + не перепутается с чужим. } +procedure TMainForm.LogExport(const AText: string); +var + F: TextFile; +begin + Log(AText); + if FExportLogPath = '' then + Exit; + try + AssignFile(F, FExportLogPath); + if FileExists(FExportLogPath) then + Append(F) + else + Rewrite(F); + try + WriteLn(F, AText); + finally + CloseFile(F); + end; + except + on E: Exception do + FExportLogPath := ''; + end; +end; + +{ Прерванная сборка: куски от неё лежат в кэше рядом с готовым файлом. + + Спрашиваем, а не продолжаем молча: человек мог править монтаж между + попытками, и тогда «готовые» куски — от другой расстановки. Сама сборка + это проверит по отпечатку плана и при несовпадении соберёт заново, но + знать об этом человек должен заранее. } +function TMainForm.AskResume(const AOutputPath: string): Boolean; +var + DonePath: string; + Done: TStringList; + N: Integer; +begin + Result := False; + DonePath := CacheDirFor(AOutputPath) + 'готово.txt'; + if not FileExists(DonePath) then + Exit; + + Done := TStringList.Create; + try + try + Done.LoadFromFile(DonePath); + except + Exit; + end; + { Первая строка — отпечаток плана, куски идут дальше. } + N := Done.Count - 1; + if N <= 0 then + Exit; + + Result := ThemedMessageDlg('nlve', + Format('От прошлой сборки осталось готовых кусков: %d.' + LineEnding + + LineEnding + + 'Продолжить с них? Если монтаж с тех пор менялся, куски не ' + + 'подойдут — программа это заметит и соберёт заново.', + [N]), + mtConfirmation, [mbYes, mbNo], 0) = mrYes; + finally + Done.Free; + end; +end; + procedure TMainForm.ShowExportReport(const AReport: TExportReport); var I, Encoded: Integer; @@ -3379,17 +4052,17 @@ var begin if AReport.Cancelled then begin - Log('Сборка отменена.'); + LogExport('Сборка отменена.'); Exit; end; if not AReport.Succeeded then begin - Log('Сборка не удалась: ' + AReport.Message); + LogExport('Сборка не удалась: ' + AReport.Message); Exit; end; - Log('--- Отчёт о сборке ---'); + LogExport('--- Отчёт о сборке ---'); Encoded := 0; for I := 0 to High(AReport.Segments) do begin @@ -3397,14 +4070,14 @@ begin if AReport.Segments[I].Encoded then begin Inc(Encoded); - Log(Format(' часть %d (кусок %d, ПЕРЕКОДИРОВАНА): старт %s, длина %s, пакетов %d', + LogExport(Format(' часть %d (кусок %d, ПЕРЕКОДИРОВАНА): старт %s, длина %s, пакетов %d', [I + 1, AReport.Segments[I].Index + 1, SecondsToStr(AReport.Segments[I].ActualStart), SecondsToStr(AReport.Segments[I].Duration), AReport.Segments[I].Packets])); end else - Log(Format(' часть %d (кусок %d): старт %s (просили %s, сдвиг %s), длина %s, пакетов %d', + LogExport(Format(' часть %d (кусок %d): старт %s (просили %s, сдвиг %s), длина %s, пакетов %d', [I + 1, AReport.Segments[I].Index + 1, SecondsToStr(AReport.Segments[I].ActualStart), SecondsToStr(AReport.Segments[I].RequestedStart), @@ -3413,17 +4086,17 @@ begin AReport.Segments[I].Packets])); end; if Encoded > 0 then - Log(Format(' перекодировано частей: %d, остальное скопировано без потерь', + LogExport(Format(' перекодировано частей: %d, остальное скопировано без потерь', [Encoded])); - Log(Format(' сумма пакетов кусков: %d', [AReport.ExpectedPackets])); - Log(Format(' пакетов в готовом файле: %d', [AReport.ActualPackets])); + LogExport(Format(' сумма пакетов кусков: %d', [AReport.ExpectedPackets])); + LogExport(Format(' пакетов в готовом файле: %d', [AReport.ActualPackets])); if AReport.ExpectedPackets = AReport.ActualPackets then - Log(' СВЕРКА ПРОЙДЕНА: склейка не потеряла и не продублировала ни одного кадра.') + LogExport(' СВЕРКА ПРОЙДЕНА: склейка не потеряла и не продублировала ни одного кадра.') else - Log(Format(' РАСХОЖДЕНИЕ на %d кадров.', + LogExport(Format(' РАСХОЖДЕНИЕ на %d кадров.', [AReport.ActualPackets - AReport.ExpectedPackets])); - Log(' файл: ' + AReport.OutputPath); + LogExport(' файл: ' + AReport.OutputPath); SetStatus('Готово: ' + AReport.OutputPath); end; diff --git a/src/uMpvPlayer.pas b/src/uMpvPlayer.pas index 20ac3b5..8fdc762 100644 --- a/src/uMpvPlayer.pas +++ b/src/uMpvPlayer.pas @@ -218,7 +218,10 @@ type Держится отдельно от списка кусков: текст правится чаще, чем монтаж, и перезагружать из-за него картинку незачем. } - procedure SetSubtitleFile(const APath: string); + { AForce — перечитать файл, даже если имя прежнее. Нужно всегда, когда + разметка переписана: имя у неё одно на весь проект, и по имени + изменение не видно. } + procedure SetSubtitleFile(const APath: string; AForce: Boolean = False); end; implementation @@ -1096,9 +1099,9 @@ end; подключаем новые, не трогая воспроизведение. При загрузке нового списка кусков mpv забывает все внешние дорожки, поэтому там подключение повторяется — см. SelectExternalAudio. } -procedure TMpvPlayer.SetSubtitleFile(const APath: string); +procedure TMpvPlayer.SetSubtitleFile(const APath: string; AForce: Boolean); begin - if FSubtitlePath = APath then + if (FSubtitlePath = APath) and (not AForce) then Exit; FSubtitlePath := APath; if FHandle = nil then diff --git a/src/uProgressForm.lfm b/src/uProgressForm.lfm index 0d2bedd..0a829ac 100644 --- a/src/uProgressForm.lfm +++ b/src/uProgressForm.lfm @@ -38,6 +38,15 @@ object ProgressForm: TProgressForm Anchors = [akTop, akLeft, akRight] TabOrder = 0 end + object lblEta: TLabel + Left = 12 + Height = 20 + Top = 74 + Width = 500 + Anchors = [akTop, akLeft, akRight] + Caption = '' + ParentColor = False + end object btnAction: TThemedButton Left = 648 Height = 28 diff --git a/src/uProgressForm.pas b/src/uProgressForm.pas index 0b779bc..269e6c5 100644 --- a/src/uProgressForm.pas +++ b/src/uProgressForm.pas @@ -26,6 +26,7 @@ type TProgressForm = class(TForm) btnAction: TThemedButton; lblStage: TLabel; + lblEta: TLabel; memoLog: TLogView; pbBar: TProgressBar; pnlTop: TPanel; @@ -36,6 +37,11 @@ type FFinished: Boolean; FCancelRequested: Boolean; FOnCancelRequest: TNotifyEvent; + { Когда началась работа и какую долю показывали в прошлый раз: по ним + считается, сколько осталось. } + FStartedAt: TDateTime; + FLastFraction: Double; + function FormatSpan(const ASeconds: Double): string; public procedure SetStage(const AText: string); procedure SetFraction(AValue: Double); @@ -70,6 +76,9 @@ begin pbBar.Position := 0; memoLog.Clear; btnAction.Caption := 'Отмена'; + FStartedAt := Now; + FLastFraction := 0; + lblEta.Caption := ''; end; procedure TProgressForm.SetStage(const AText: string); @@ -77,13 +86,55 @@ begin lblStage.Caption := AText; end; +{ Время в виде «3 мин 20 с»: секунды сотнями человек не читает. } +function TProgressForm.FormatSpan(const ASeconds: Double): string; +var + Total, M, S: Integer; +begin + Total := Round(ASeconds); + if Total < 0 then + Total := 0; + M := Total div 60; + S := Total mod 60; + if M >= 60 then + Result := Format('%d ч %d мин', [M div 60, M mod 60]) + else if M > 0 then + Result := Format('%d мин %d с', [M, S]) + else + Result := Format('%d с', [S]); +end; + +{ Сколько прошло и сколько осталось. + + Осталось считается по простому правилу: если четверть пути заняла + минуту, весь путь займёт четыре. На деле скорость меняется — куски, + которые копируются, идут мгновенно, а те, что пересобираются, + медленно, — поэтому число называется «примерно» и пересчитывается на + каждом шаге. Даже такая оценка отвечает на главный вопрос: успею ли я + сходить за чаем. } procedure TProgressForm.SetFraction(AValue: Double); +var + { Не Left: так называется свойство формы. } + Elapsed, Remain: Double; begin if AValue < 0 then AValue := 0; if AValue > 1 then AValue := 1; pbBar.Position := Round(AValue * BarScale); + FLastFraction := AValue; + + Elapsed := (Now - FStartedAt) * SecsPerDay; + { Пока сделано меньше сотой доли, оценка была бы гаданием: первые + секунды уходят на запуск ffmpeg, а не на работу. } + if (AValue > 0.01) and (Elapsed > 1) then + begin + Remain := Elapsed * (1 - AValue) / AValue; + lblEta.Caption := Format('Прошло %s, осталось примерно %s (%d%%)', + [FormatSpan(Elapsed), FormatSpan(Remain), Round(AValue * 100)]); + end + else + lblEta.Caption := 'Прошло ' + FormatSpan(Elapsed); end; procedure TProgressForm.AddLog(const AText: string); @@ -98,6 +149,8 @@ begin FFinished := True; btnAction.Caption := 'Закрыть'; lblStage.Caption := AMessage; + { На месте оценки — итог: сколько всё это заняло. } + lblEta.Caption := 'Заняло ' + FormatSpan((Now - FStartedAt) * SecsPerDay); if ASuccess then lblStage.Font.Color := clDefault else diff --git a/src/uProject.pas b/src/uProject.pas index 26ddd5e..6da4a5b 100644 --- a/src/uProject.pas +++ b/src/uProject.pas @@ -143,6 +143,27 @@ type FColorKey: TColorKey; public constructor Create; + { Переносит на этот клип всё, что настроено у другого: громкость, + кадрирование, прозрачность, ключ, затухания, текст. + + Не переносится то, что делает клип этим клипом: имя, место на + монтаже, кусок исходника, связка и выделение. + + Зачем метод, а не переписывание полей на месте: копия клипа нужна в + нескольких местах (рез — самое частое), и каждое новое свойство + иначе приходится вспоминать в каждом из них. Один раз не вспомнили — + и после реза половина клипа теряла цветовой ключ, а вместе с ним и + прозрачность: она переставала быть наложением и закрывала собой всё, + что ниже. } + procedure CopySettingsFrom(ASource: TClip); + { Переносит только оформление: кадрирование, поворот, увеличение, + смещение, прозрачность, ключ, затухания, громкость. + + От CopySettingsFrom отличается тем, что не трогает вид клипа и его + текст: свойства переносят между разными клипами, и превращать + картинку в надпись при этом незачем. Оформление надписи переносится + только между надписями. } + procedure CopyLookFrom(ASource: TClip); function TlEnd: Double; function SrcOut: Double; { Попадает ли момент внутрь клипа. Правый край не включается: там уже @@ -236,6 +257,9 @@ type FTracks: TObjectList; FMaster: TMediaInfo; FRippleMode: TRippleMode; + { Отмеченный участок монтажа: от и до. Пока не отмечен, оба нуля. } + FRegionStart: Double; + FRegionEnd: Double; FRippleEnabled: Boolean; FFileName: string; FModified: Boolean; @@ -266,6 +290,14 @@ type { Номер новой связки. Отдельным именем, чтобы не пришлось помнить префикс в каждом месте, где связка заводится. } function NewGroupId: string; + { Имя, которого ещё нет ни у одной дорожки: V1, V2, ... Считать + дорожки нужного вида и прибавлять единицу нельзя — после удаления + средней счёт совпадёт с уже занятым именем, и в окне окажутся две + дорожки Т2. } + function UniqueTrackName(const APrefix: string): string; + { Разводит одинаковые имена дорожек, доставшиеся от старых проектов. + Имя — только подпись, но две дорожки Т2 в окне сбивают с толку. } + procedure EnsureUniqueTrackNames; function AddTrack(const AName: string): TTrack; function AddTrackOfKind(const AName: string; AKind: TTrackKind): TTrack; function FindTrack(const AId: string): TTrack; @@ -348,6 +380,38 @@ type { Режим действует всегда, даже когда автосхлопывание выключено: он определяет, что сделает Ctrl+Shift+R. } property RippleMode: TRippleMode read FRippleMode write FRippleMode; + { Отмеченный участок: собирать можно только его. Нужен, чтобы + проверить кусок монтажа, не собирая весь ролик — на длинном + материале это разница между минутой и часом. + + Отметок две, и обе живут в проекте, а не в настройках программы: + участок относится к этому монтажу, а не к привычкам человека. } + property RegionStart: Double read FRegionStart write FRegionStart; + property RegionEnd: Double read FRegionEnd write FRegionEnd; + function HasRegion: Boolean; + { Наибольший битрейт среди видеофайлов проекта. + + Им целятся при пересборке кусков. Брать средний или битрейт первого + файла нельзя: пересобранный кусок стоит рядом со скопированными, и + если он окажется хуже их, разница бросится в глаза именно на нём. + Лучше потратить место, чем показать шакала посреди чистой съёмки. } + function MaxVideoBitrate: Int64; + { Какая дорожка нужна клипу этого вида. Правило одно на всю + программу: картинке — дорожка картинки, звуку — звуковая, надписи — + текстовая. } + class function TrackKindFor(AClipKind: TClipKind): TTrackKind; + { Сколько клипов лежит на дорожках не своего вида. + + Такой клип не попадает никуда: уплощение обходит дорожки по видам, + и клип с чужой дорожки не видит ни сборка, ни предпросмотр. Пропажа + при этом тихая — на монтаже он нарисован, а в ролике его нет. } + function MisplacedClipCount: Integer; + { Переносит их на подходящие дорожки. Возвращает, сколько перенесено. + + Ищется первая дорожка нужного вида, где это время свободно; если + такой нет — заводится новая. Время клипа не меняется: человек ставил + его именно туда. } + function FixMisplacedClips: Integer; { Автоматическое схлопывание при перетаскивании клипов. } property RippleEnabled: Boolean read FRippleEnabled write FRippleEnabled; property FileName: string read FFileName write FFileName; @@ -402,6 +466,35 @@ end; { --- TClip --- } +procedure TClip.CopySettingsFrom(ASource: TClip); +begin + if ASource = nil then + Exit; + FKind := ASource.Kind; + FVolume := ASource.Volume; + FTransform := ASource.Transform; + FOpacity := ASource.Opacity; + FColorKey := ASource.ColorKey; + FFadeIn := ASource.FadeIn; + FFadeOut := ASource.FadeOut; + FText := ASource.Text; + FTextStyle := ASource.TextStyle; +end; + +procedure TClip.CopyLookFrom(ASource: TClip); +begin + if ASource = nil then + Exit; + FTransform := ASource.Transform; + FOpacity := ASource.Opacity; + FColorKey := ASource.ColorKey; + FFadeIn := ASource.FadeIn; + FFadeOut := ASource.FadeOut; + FVolume := ASource.Volume; + if (FKind = ckText) and (ASource.Kind = ckText) then + FTextStyle := ASource.TextStyle; +end; + constructor TClip.Create; begin inherited Create; @@ -548,6 +641,8 @@ begin FMaster := Default(TMediaInfo); FRippleMode := rmCurrentTrack; FRippleEnabled := False; + FRegionStart := 0; + FRegionEnd := 0; FFileName := ''; FModified := False; FNextId := 1; @@ -652,6 +747,45 @@ begin FModified := True; end; +function TProject.UniqueTrackName(const APrefix: string): string; +var + N, I: Integer; + Taken: Boolean; +begin + N := 1; + repeat + Result := APrefix + IntToStr(N); + Taken := False; + for I := 0 to FTracks.Count - 1 do + if TTrack(FTracks[I]).Name = Result then + begin + Taken := True; + Break; + end; + Inc(N); + until not Taken; +end; + +procedure TProject.EnsureUniqueTrackNames; +var + I, J: Integer; + Prefix: string; +begin + for I := 0 to FTracks.Count - 1 do + for J := 0 to I - 1 do + if TTrack(FTracks[J]).Name = TTrack(FTracks[I]).Name then + begin + case TTrack(FTracks[I]).Kind of + tkAudio: Prefix := 'A'; + tkText: Prefix := 'Т'; + else + Prefix := 'V'; + end; + TTrack(FTracks[I]).Name := UniqueTrackName(Prefix); + Break; + end; +end; + function TProject.AddTrack(const AName: string): TTrack; begin Result := AddTrackOfKind(AName, tkVideo); @@ -934,6 +1068,122 @@ begin end; end; +{ Участок считается отмеченным, только если он не пустой: две отметки в + одной точке — это отсутствие участка, а не участок нулевой длины. } +function TProject.HasRegion: Boolean; +begin + Result := FRegionEnd > FRegionStart + 0.001; +end; + +class function TProject.TrackKindFor(AClipKind: TClipKind): TTrackKind; +begin + case AClipKind of + ckAudio: Result := tkAudio; + ckText: Result := tkText; + else + Result := tkVideo; + end; +end; + +function TProject.MisplacedClipCount: Integer; +var + T, C: Integer; + Track: TTrack; +begin + Result := 0; + for T := 0 to TrackCount - 1 do + begin + Track := Tracks[T]; + for C := 0 to Track.Count - 1 do + if TrackKindFor(Track[C].Kind) <> Track.Kind then + Inc(Result); + end; +end; + +function TProject.FixMisplacedClips: Integer; +var + T, C, K: Integer; + Track, Target: TTrack; + Clip: TClip; + Need: TTrackKind; + Moved: TFPList; + + { Свободна ли дорожка в это время. } + function Fits(ATrack: TTrack; AClip: TClip): Boolean; + var + I: Integer; + begin + Result := True; + for I := 0 to ATrack.Count - 1 do + if (AClip.TlStart < ATrack[I].TlEnd - 0.001) and + (AClip.TlEnd > ATrack[I].TlStart + 0.001) then + Exit(False); + end; + +begin + Result := 0; + Moved := TFPList.Create; + try + { Сперва собираем список: переносить прямо во время обхода нельзя — + состав дорожек меняется под ногами. } + for T := 0 to TrackCount - 1 do + begin + Track := Tracks[T]; + for C := 0 to Track.Count - 1 do + if TrackKindFor(Track[C].Kind) <> Track.Kind then + Moved.Add(Track[C]); + end; + + for C := 0 to Moved.Count - 1 do + begin + Clip := TClip(Moved[C]); + Track := FindClipTrack(Clip); + if Track = nil then + Continue; + Need := TrackKindFor(Clip.Kind); + + Target := nil; + for K := 0 to TrackCount - 1 do + if (Tracks[K].Kind = Need) and Fits(Tracks[K], Clip) then + begin + Target := Tracks[K]; + Break; + end; + + if Target = nil then + case Need of + tkAudio: Target := AddTrackOfKind(UniqueTrackName('A'), tkAudio); + tkText: Target := AddTrackOfKind(UniqueTrackName('Т'), tkText); + else + Target := AddTrackOfKind(UniqueTrackName('V'), tkVideo); + end; + + Track.Extract(Clip); + Target.Add(Clip); + Target.Sort; + Inc(Result); + end; + finally + Moved.Free; + end; +end; + +function TProject.MaxVideoBitrate: Int64; +var + I: Integer; + Item: TMediaItem; +begin + Result := FMaster.VideoBitrate; + for I := 0 to FPool.Count - 1 do + begin + Item := TMediaItem(FPool[I]); + if not Item.Info.HasVideo then + Continue; + if Item.Info.VideoBitrate > Result then + Result := Item.Info.VideoBitrate; + end; +end; + procedure TProject.ClearSelection; var T, C: Integer; @@ -1434,7 +1684,9 @@ begin Root.Add('settings', TJSONObject.Create([ 'ripple_mode', RippleModeToStr(FRippleMode), - 'ripple_enabled', FRippleEnabled + 'ripple_enabled', FRippleEnabled, + 'region_start', FRegionStart, + 'region_end', FRegionEnd ])); Result := Root.FormatJSON; @@ -1551,12 +1803,15 @@ begin MigrateAudio; FixClipKinds; + EnsureUniqueTrackNames; Settings := Obj.Find('settings', jtObject) as TJSONObject; if Settings <> nil then begin FRippleMode := StrToRippleMode(Settings.Get('ripple_mode', 'current')); FRippleEnabled := Settings.Get('ripple_enabled', False); + FRegionStart := Settings.Get('region_start', Double(0)); + FRegionEnd := Settings.Get('region_end', Double(0)); { Старые проекты хранили один флаг «все дорожки». } if Settings.Get('ripple_all_tracks', False) then FRippleMode := rmAllTracks; diff --git a/src/uSettings.pas b/src/uSettings.pas index 7b3ca08..777e18c 100644 --- a/src/uSettings.pas +++ b/src/uSettings.pas @@ -37,6 +37,9 @@ type FVideoPanelHeight: Integer; FLogVisible: Boolean; FPlayheadSnap: Boolean; + FPreviewKey: Boolean; + FCenterPlayhead: Boolean; + FKeepParts: Boolean; FDepsReminder: Boolean; FRecentProjects: TStringList; function FileName: string; @@ -70,6 +73,14 @@ type property LogVisible: Boolean read FLogVisible write FLogVisible; { Прилипание курсора воспроизведения к границам клипов. } property PlayheadSnap: Boolean read FPlayheadSnap write FPlayheadSnap; + { Применять ли ключ и прозрачность прямо в предпросмотре. } + property PreviewKey: Boolean read FPreviewKey write FPreviewKey; + { Держать ли курсор посередине монтажа при воспроизведении. } + property CenterPlayhead: Boolean read FCenterPlayhead write FCenterPlayhead; + { Оставлять ли временные куски после удачной сборки. По умолчанию нет: + они весят столько же, сколько готовый ролик, а нужны только чтобы + продолжить прерванную сборку. } + property KeepParts: Boolean read FKeepParts write FKeepParts; { Напоминать ли о недостающих зависимостях при запуске. Гасится кнопкой «Не напоминать» в самом напоминании. } property DepsReminder: Boolean read FDepsReminder write FDepsReminder; @@ -103,6 +114,9 @@ begin FVideoPanelHeight := DefaultVideoHeight; FLogVisible := True; FPlayheadSnap := True; + FPreviewKey := True; + FCenterPlayhead := True; + FKeepParts := False; FDepsReminder := True; end; @@ -184,6 +198,9 @@ begin FVideoPanelHeight := Obj.Get('video_panel_height', FVideoPanelHeight); FLogVisible := Obj.Get('log_visible', FLogVisible); FPlayheadSnap := Obj.Get('playhead_snap', FPlayheadSnap); + FPreviewKey := Obj.Get('preview_key', FPreviewKey); + FCenterPlayhead := Obj.Get('center_playhead', FCenterPlayhead); + FKeepParts := Obj.Get('keep_parts', FKeepParts); FDepsReminder := Obj.Get('deps_reminder', FDepsReminder); Arr := Obj.Find('recent_projects', jtArray) as TJSONArray; @@ -236,6 +253,9 @@ begin Root.Add('video_panel_height', FVideoPanelHeight); Root.Add('log_visible', FLogVisible); Root.Add('playhead_snap', FPlayheadSnap); + Root.Add('preview_key', FPreviewKey); + Root.Add('center_playhead', FCenterPlayhead); + Root.Add('keep_parts', FKeepParts); Root.Add('deps_reminder', FDepsReminder); Arr := TJSONArray.Create; diff --git a/src/uSubtitles.pas b/src/uSubtitles.pas index 5b74bdf..6f10e16 100644 --- a/src/uSubtitles.pas +++ b/src/uSubtitles.pas @@ -79,9 +79,14 @@ function WriteAssForRange(AProject: TProject; const AFrom, ATo: Double; пересборки и подкладывает свою разметку. Возвращает, сколько секунд придётся пересобрать сверх того, что и так - пересобиралось: человеку это говорят до начала. } + пересобиралось: человеку это говорят до начала. + + AStartTime — время монтажа, которому соответствует начало списка. + Нужен, когда собирают не весь ролик, а отмеченный участок: иначе текст + брался бы с начала монтажа и лёг бы не на те куски. } function BurnTextIntoSegments(AProject: TProject; - var ASegments: TFlatSegmentArray; const ACacheDir: string): Double; + var ASegments: TFlatSegmentArray; const ACacheDir: string; + const AStartTime: Double = 0): Double; implementation @@ -479,7 +484,8 @@ begin end; function BurnTextIntoSegments(AProject: TProject; - var ASegments: TFlatSegmentArray; const ACacheDir: string): Double; + var ASegments: TFlatSegmentArray; const ACacheDir: string; + const AStartTime: Double): Double; var I: Integer; At, SegEnd: Double; @@ -489,7 +495,7 @@ begin if (AProject = nil) or (not HasText(AProject)) then Exit; - At := 0; + At := AStartTime; for I := 0 to High(ASegments) do begin SegEnd := At + ASegments[I].Duration; diff --git a/src/uTheme.pas b/src/uTheme.pas index f95f569..08c9e0e 100644 --- a/src/uTheme.pas +++ b/src/uTheme.pas @@ -69,7 +69,8 @@ type tiSnap, // прилипание: края притягиваются к общей линии tiRipple, // схлопывание: дыра между кусками закрывается tiLog, // журнал: полоса с сообщениями - tiGlue // курсор липнет к границам клипов + tiGlue, // курсор липнет к границам клипов + tiTarget // курсор держится середины монтажа ); { Полоска выполнения, которая рисует себя сама. @@ -233,6 +234,11 @@ function ThemedMessageDlg(const ACaption, AText: string; function ThemedChoiceDlg(const ACaption, AText: string; const ACaptions: array of string): Integer; +{ Ввод одной строки в тёмном окне. Системный InputQuery выглядел бы белым + пятном посреди тёмной программы. } +function ThemedInputDlg(const ACaption, APrompt: string; + var AValue: string): Boolean; + implementation {$IFDEF LCLGTK2} @@ -453,6 +459,7 @@ begin tiRipple: Stream.WriteBuffer(IconRippleData[0], Length(IconRippleData)); tiLog: Stream.WriteBuffer(IconLogData[0], Length(IconLogData)); tiGlue: Stream.WriteBuffer(IconGlueData[0], Length(IconGlueData)); + tiTarget: Stream.WriteBuffer(IconTargetData[0], Length(IconTargetData)); else Exit; end; @@ -1370,6 +1377,58 @@ begin end; end; +function ThemedInputDlg(const ACaption, APrompt: string; + var AValue: string): Boolean; +var + Dlg: TForm; + Lbl: TLabel; + Edit: TEdit; + BtnOk, BtnCancel: TThemedButton; +begin + Result := False; + Dlg := TForm.CreateNew(nil); + try + Dlg.Caption := ACaption; + Dlg.BorderStyle := bsDialog; + Dlg.Position := poScreenCenter; + Dlg.ClientWidth := 360; + Dlg.ClientHeight := 130; + + Lbl := TLabel.Create(Dlg); + Lbl.Parent := Dlg; + Lbl.SetBounds(16, 16, 328, 20); + Lbl.Caption := APrompt; + + Edit := TEdit.Create(Dlg); + Edit.Parent := Dlg; + Edit.SetBounds(16, 40, 328, 26); + Edit.Text := AValue; + + BtnOk := TThemedButton.Create(Dlg); + BtnOk.Parent := Dlg; + BtnOk.SetBounds(136, 84, 100, 30); + BtnOk.Caption := 'Готово'; + BtnOk.ModalResult := mrOk; + BtnOk.Default := True; + + BtnCancel := TThemedButton.Create(Dlg); + BtnCancel.Parent := Dlg; + BtnCancel.SetBounds(244, 84, 100, 30); + BtnCancel.Caption := 'Отмена'; + BtnCancel.ModalResult := mrCancel; + BtnCancel.Cancel := True; + + ApplyDarkTheme(Dlg); + Edit.SetFocus; + if Dlg.ShowModal <> mrOk then + Exit; + AValue := Trim(Edit.Text); + Result := AValue <> ''; + finally + Dlg.Free; + end; +end; + function ThemedMessageDlg(const ACaption, AText: string; ADlgType: TMsgDlgType; AButtons: TMsgDlgButtons; AHelpCtx: Longint): TModalResult; diff --git a/src/uTimelineCtrl.pas b/src/uTimelineCtrl.pas index 6f2a01a..735cf8b 100644 --- a/src/uTimelineCtrl.pas +++ b/src/uTimelineCtrl.pas @@ -38,11 +38,22 @@ type taPan, // прокрутка средней кнопкой taVolume, // тянем ручку громкости клипа taFadeIn, // тянем появление за верхний левый угол - taFadeOut // тянем уход за верхний правый угол + taFadeOut, // тянем уход за верхний правый угол + taRegionIn, // тянем начало отмеченного участка + taRegionOut, // тянем конец отмеченного участка + taDragTrack // тянем дорожку за заголовок, меняя порядок ); { Что находится под указателем в полосе заголовков дорожек. } - THeaderPart = (hpNone, hpBody, hpMute, hpSolo); + THeaderPart = (hpNone, hpBody, hpMute, hpSolo, hpUp, hpDown, hpName); + + { Правый щелчок по заголовку дорожки. Само меню строит окно: компонент + не знает, что с дорожкой можно делать. } + TTrackMenuEvent = procedure(Sender: TObject; ATrackIndex: Integer; + const AScreenPos: TPoint) of object; + + { Дорожку просят переименовать: окно спросит новое имя. } + TTrackRenameEvent = procedure(Sender: TObject; ATrackIndex: Integer) of object; { Файл из списка проекта бросили на монтаж. @@ -121,6 +132,14 @@ type FOnPlayheadChange: TNotifyEvent; FOnStructureChange: TNotifyEvent; FOnSelectionChange: TNotifyEvent; + { Отмеченный участок подвинули мышью. } + FOnRegionChange: TNotifyEvent; + { Правый щелчок по заголовку дорожки: окно покажет своё меню. } + FOnTrackMenu: TTrackMenuEvent; + FOnTrackRename: TTrackRenameEvent; + { Дорожка, которую тащат за заголовок. } + FDragTrackIndex: Integer; + FDragTrackFrom: Integer; FOnMediaDrop: TMediaDropEvent; FOnClipTransform: TClipEvent; FOnTrackAdded: TNotifyEvent; @@ -143,6 +162,13 @@ type function YToVolume(const AY: Integer; ATop: Integer): Double; procedure DrawRuler(ACanvas: TCanvas); + procedure DrawRegion(ACanvas: TCanvas); + procedure DrawRegionHandle(ACanvas: TCanvas; AX: Integer; + AIsStart: Boolean); + procedure DrawTrackArrow(ACanvas: TCanvas; ALeft, ATop: Integer; + AUp, AEnabled: Boolean); + function RegionHandleAt(AX, AY: Integer): Integer; + procedure DragRegionEdge(AX: Integer; AIsStart: Boolean); procedure DrawTracks(ACanvas: TCanvas); procedure DrawClip(ACanvas: TCanvas; AClip: TClip; ATop: Integer); procedure DrawPlayhead(ACanvas: TCanvas); @@ -283,6 +309,12 @@ type write FOnStructureChange; property OnSelectionChange: TNotifyEvent read FOnSelectionChange write FOnSelectionChange; + property OnRegionChange: TNotifyEvent read FOnRegionChange + write FOnRegionChange; + property OnTrackMenu: TTrackMenuEvent read FOnTrackMenu + write FOnTrackMenu; + property OnTrackRename: TTrackRenameEvent read FOnTrackRename + write FOnTrackRename; property OnMediaDrop: TMediaDropEvent read FOnMediaDrop write FOnMediaDrop; { Нажата кнопка кадрирования в углу клипа. } property OnClipTransform: TClipEvent read FOnClipTransform @@ -301,6 +333,16 @@ const { На сколько пикселей примагничиваются края при перетаскивании. } SnapPixels = 8; + { Уголок отметки участка: сторона треугольника в точках. } + RegionHandleWidth = 9; + { Стрелки порядка дорожек в заголовке. } + ArrowSize = 14; + ArrowLeft = 5; + { Полоса участка вверху линейки: в ней живут уголки, и протяжка по ней + отмечает участок, а не двигает курсор. Так же устроено в монтажных + программах: у линейки два этажа, верхний про отметки, нижний про + курсор. } + RegionBarHeight = 12; { Сдвиг мыши, до которого нажатие считается щелчком, а не перетаскиванием. Совсем без запаса нельзя: рука дрожит, и попасть кнопкой в один и тот же @@ -351,6 +393,9 @@ const ColorClipBorder = TColor($5080AA); // светлая рамка клипа ColorClipText = TColor($F0F0F0); ColorPlayhead = TColor($4040FF); // красный: привычный цвет курсора + ColorRegion = TColor($30A0D0); // отмеченный участок: янтарная полоса + ColorRegionEdge = TColor($1878B0); + ColorRegionHandle = TColor($40E0F0); // уголки отметок: жёлтые, как в Vegas ColorEdgeSnap = TColor($909090); // серый: рез притянут к опорному кадру ColorEdgePrecise = TColor($FFC030); // голубой: рез потребует перекодирования ColorWave = TColor($96C8D2); // пастельно-жёлтый: форма звука @@ -389,6 +434,8 @@ begin FActiveTrack := 0; FSnapEnabled := True; FPlayheadSnap := True; + FDragTrackIndex := -1; + FDragTrackFrom := -1; end; destructor TTimelineControl.Destroy; @@ -513,6 +560,22 @@ begin Result := hpBody; RowTop := TrackTop(ATrackIndex); + + { Стрелки порядка — слева, одна под другой: дорожку двигают вверх и + вниз чаще, чем делают с ней что-либо ещё, и лезть за этим в меню + неудобно. } + if (AX >= ArrowLeft) and (AX < ArrowLeft + ArrowSize) then + begin + if (AY >= RowTop + 6) and (AY < RowTop + 6 + ArrowSize) then + Exit(hpUp); + if (AY >= RowTop + 8 + ArrowSize) and (AY < RowTop + 8 + 2 * ArrowSize) then + Exit(hpDown); + end; + + { Имя: по двойному щелчку его переименовывают. } + if (AY >= RowTop + 4) and (AY < RowTop + 22) and (AX >= ArrowLeft + ArrowSize) then + Exit(hpName); + BtnTop := RowTop + FTrackHeight - HeaderButtonSize - 6; if (AY < BtnTop) or (AY > BtnTop + HeaderButtonSize) then Exit; @@ -704,9 +767,115 @@ begin T := T + Step; end; + { Отмеченный участок: полоса по низу линейки и стойки по краям. + + Рисуется после делений, чтобы не оказаться под ними, и только на + линейке: закрашивать сами дорожки нельзя — под краской не разглядеть + клипы, а участок отмечают как раз чтобы в них разбираться. } + DrawRegion(ACanvas); + ACanvas.Brush.Style := bsSolid; end; +procedure TTimelineControl.DrawRegion(ACanvas: TCanvas); +var + L, R: Integer; +begin + if (FProject = nil) or (not FProject.HasRegion) then + Exit; + + L := Max(FHeaderWidth, TimeToX(FProject.RegionStart)); + R := Min(ClientWidth, TimeToX(FProject.RegionEnd)); + if R <= L then + Exit; + + ACanvas.Brush.Style := bsSolid; + ACanvas.Brush.Color := ColorRegion; + ACanvas.FillRect(L, FRulerHeight - 6, R, FRulerHeight - 1); + + { Стойки во всю высоту: край участка должен быть виден и там, где + линейка уже уехала вверх за пределы видимого. } + ACanvas.Pen.Color := ColorRegionEdge; + if TimeToX(FProject.RegionStart) >= FHeaderWidth then + ACanvas.Line(L, 0, L, ClientHeight); + if TimeToX(FProject.RegionEnd) <= ClientWidth then + ACanvas.Line(R - 1, 0, R - 1, ClientHeight); + + { Уголки, за которые тянут. Отметки должны не только показывать, где + участок, но и позволять его двигать: клавишами это выходит долго — + поставил, посмотрел, промахнулся, ставь заново. } + DrawRegionHandle(ACanvas, TimeToX(FProject.RegionStart), True); + DrawRegionHandle(ACanvas, TimeToX(FProject.RegionEnd), False); +end; + +{ Уголок отметки: прямоугольный треугольник, прижатый к своей стороне + участка. Так видно, какой край он держит, — у симметричной стрелки это + пришлось бы угадывать. } +procedure TTimelineControl.DrawRegionHandle(ACanvas: TCanvas; AX: Integer; + AIsStart: Boolean); +var + Pts: array[0..2] of TPoint; +begin + if (AX < FHeaderWidth - RegionHandleWidth) or + (AX > ClientWidth + RegionHandleWidth) then + Exit; + + if AIsStart then + begin + Pts[0] := Point(AX, 0); + Pts[1] := Point(AX + RegionHandleWidth, 0); + Pts[2] := Point(AX, RegionHandleWidth); + end + else + begin + Pts[0] := Point(AX, 0); + Pts[1] := Point(AX - RegionHandleWidth, 0); + Pts[2] := Point(AX, RegionHandleWidth); + end; + + ACanvas.Brush.Style := bsSolid; + ACanvas.Brush.Color := ColorRegionHandle; + ACanvas.Pen.Color := ColorRegionEdge; + ACanvas.Polygon(Pts); +end; + +{ Что под указателем на линейке: 1 — уголок начала, 2 — уголок конца. } +{ Двигает край участка за уголком. + + Край прилипает к границам клипов тем же способом, что и курсор: участок + чаще всего отмечают по кускам, а попасть мышью в стык на общем плане + нельзя. Края не пропускаются друг за друга: перевёрнутый участок — это + не участок. } +procedure TTimelineControl.DragRegionEdge(AX: Integer; AIsStart: Boolean); +var + T: Double; +begin + if FProject = nil then + Exit; + T := Max(0, SnapPlayhead(XToTime(AX))); + if AIsStart then + FProject.RegionStart := Min(T, FProject.RegionEnd - 0.001) + else + FProject.RegionEnd := Max(T, FProject.RegionStart + 0.001); + Invalidate; + if Assigned(FOnRegionChange) then + FOnRegionChange(Self); +end; + +function TTimelineControl.RegionHandleAt(AX, AY: Integer): Integer; +begin + Result := 0; + if (FProject = nil) or (not FProject.HasRegion) then + Exit; + if (AY < 0) or (AY > RegionHandleWidth + 2) then + Exit; + + if Abs(AX - TimeToX(FProject.RegionStart)) <= RegionHandleWidth then + Exit(1); + if Abs(AX - TimeToX(FProject.RegionEnd)) <= RegionHandleWidth then + Exit(2); +end; + procedure TTimelineControl.DrawClip(ACanvas: TCanvas; AClip: TClip; ATop: Integer); var @@ -1298,18 +1467,25 @@ begin ACanvas.Font.Color := clGray; ACanvas.Font.Height := -12; ACanvas.Font.Style := [fsBold]; - ACanvas.TextOut(8, RowTop + 6, Track.Name); + ACanvas.TextOut(ArrowLeft + ArrowSize + 6, RowTop + 6, Track.Name); ACanvas.Font.Style := []; ACanvas.Font.Color := clGray; ACanvas.Font.Height := -10; if T = 0 then - ACanvas.TextOut(8, RowTop + 24, + ACanvas.TextOut(ArrowLeft + ArrowSize + 6, RowTop + 24, IntToStr(Track.Count) + ' кл. верх') else - ACanvas.TextOut(8, RowTop + 24, IntToStr(Track.Count) + ' кл.'); + ACanvas.TextOut(ArrowLeft + ArrowSize + 6, RowTop + 24, + IntToStr(Track.Count) + ' кл.'); ACanvas.Brush.Style := bsSolid; + { Стрелки порядка. У верхней дорожки некуда вверх, у нижней вниз — + такая стрелка рисуется тускло и не нажимается. } + DrawTrackArrow(ACanvas, ArrowLeft, RowTop + 6, True, T > 0); + DrawTrackArrow(ACanvas, ArrowLeft, RowTop + 8 + ArrowSize, False, + T < FProject.TrackCount - 1); + BtnTop := RowTop + FTrackHeight - HeaderButtonSize - 6; BtnLeft := FHeaderWidth - 2 * HeaderButtonSize - HeaderButtonGap - 8; { М — выключить дорожку целиком, С — слушать только её. } @@ -1321,6 +1497,36 @@ begin ACanvas.Brush.Style := bsSolid; end; +{ Треугольник порядка дорожек. } +procedure TTimelineControl.DrawTrackArrow(ACanvas: TCanvas; + ALeft, ATop: Integer; AUp, AEnabled: Boolean); +var + Pts: array[0..2] of TPoint; + Mid: Integer; +begin + Mid := ALeft + ArrowSize div 2; + if AUp then + begin + Pts[0] := Point(Mid, ATop + 2); + Pts[1] := Point(ALeft + 1, ATop + ArrowSize - 3); + Pts[2] := Point(ALeft + ArrowSize - 1, ATop + ArrowSize - 3); + end + else + begin + Pts[0] := Point(Mid, ATop + ArrowSize - 3); + Pts[1] := Point(ALeft + 1, ATop + 2); + Pts[2] := Point(ALeft + ArrowSize - 1, ATop + 2); + end; + + ACanvas.Brush.Style := bsSolid; + if AEnabled then + ACanvas.Brush.Color := ColorRulerText + else + ACanvas.Brush.Color := ColorButtonOff; + ACanvas.Pen.Color := ACanvas.Brush.Color; + ACanvas.Polygon(Pts); +end; + procedure TTimelineControl.DrawPlayhead(ACanvas: TCanvas); var X: Integer; @@ -1616,6 +1822,21 @@ begin Exit; end; + { Правый щелчок по заголовку — меню дорожки. Удалять и переставлять + дорожки больше негде: в главном меню есть только «добавить» и «убрать + последнюю», а убрать нужно бывает не последнюю. } + if (Button = mbRight) and (X < FHeaderWidth) and (Y >= FRulerHeight) then + begin + Idx := TrackIndexAt(Y); + if (Idx >= 0) and Assigned(FOnTrackMenu) then + begin + FActiveTrack := Idx; + Invalidate; + FOnTrackMenu(Self, Idx, ClientToScreen(Point(X, Y))); + end; + Exit; + end; + if Button <> mbLeft then Exit; @@ -1638,9 +1859,39 @@ begin FProject.Tracks[Idx].Solo := not FProject.Tracks[Idx].Solo; StructureChanged; end; + hpUp: + if Idx > 0 then + begin + FProject.MoveTrack(Idx, Idx - 1); + FActiveTrack := Idx - 1; + FProject.Modified := True; + StructureChanged; + end; + hpDown: + if Idx < FProject.TrackCount - 1 then + begin + FProject.MoveTrack(Idx, Idx + 1); + FActiveTrack := Idx + 1; + FProject.Modified := True; + StructureChanged; + end; + hpName: + begin + FActiveTrack := Idx; + Invalidate; + { Двойной щелчок по имени — переименование. Одиночный просто + выбирает дорожку: имя правят редко, а выбирают часто. } + if (ssDouble in Shift) and Assigned(FOnTrackRename) then + FOnTrackRename(Self, Idx); + end; hpBody: begin FActiveTrack := Idx; + { Заголовок можно потащить: порядок дорожек — это приоритет, и + менять его перетаскиванием привычнее, чем через меню. } + FAction := taDragTrack; + FDragTrackIndex := Idx; + FDragTrackFrom := Idx; Invalidate; if Assigned(FOnActiveTrackChange) then FOnActiveTrackChange(Self); @@ -1649,9 +1900,28 @@ begin Exit; end; - { Щелчок по линейке ставит курсор воспроизведения. } + { Щелчок по линейке: сперва уголки отмеченного участка, потом курсор. + + Приоритет у уголков: они мелкие, промахнуться мимо них легко, а + поставить курсор можно где угодно рядом. } if Y < FRulerHeight then begin + case RegionHandleAt(X, Y) of + 1: begin FAction := taRegionIn; Exit; end; + 2: begin FAction := taRegionOut; Exit; end; + end; + + { Верхний этаж линейки — про участок: протяжка по нему отмечает его + заново, даже если отметок не было. Нижний — про курсор. } + if (Y < RegionBarHeight) and (FProject <> nil) then + begin + FAction := taRegionOut; + FProject.RegionStart := Max(0, SnapPlayhead(XToTime(X))); + FProject.RegionEnd := FProject.RegionStart; + Invalidate; + Exit; + end; + FAction := taScrub; Playhead := Max(0, SnapPlayhead(XToTime(X))); Exit; @@ -1834,6 +2104,25 @@ begin на стык, соскакивал бы с него от малейшего движения мыши. } Playhead := Max(0, SnapPlayhead(XToTime(X))); + taDragTrack: + if (FProject <> nil) and (FDragTrackIndex >= 0) then + begin + Idx := TrackIndexAt(Y); + if (Idx >= 0) and (Idx <> FDragTrackIndex) then + begin + FProject.MoveTrack(FDragTrackIndex, Idx); + FDragTrackIndex := Idx; + FActiveTrack := Idx; + Invalidate; + end; + end; + + taRegionIn: + DragRegionEdge(X, True); + + taRegionOut: + DragRegionEdge(X, False); + taVolume: if FDragClip <> nil then begin @@ -1878,12 +2167,17 @@ begin { Утащили ниже последней дорожки — заводим новую, как в Vegas. За одно перетаскивание не больше одной: иначе движение мыши - вниз наплодило бы их десяток. } + вниз наплодило бы их десяток. Вид новой дорожки — по клипу: + картинку на звуковую дорожку класть незачем. } if (Idx < 0) and (FProject <> nil) and (Y > TracksBottom) and (not FTrackAddedDuringDrag) then begin - FProject.AddTrack('V' + - IntToStr(FProject.TrackCountOf(tkVideo) + 1)); + case TProject.TrackKindFor(FDragClip.Kind) of + tkAudio: FProject.AddTrackOfKind(FProject.UniqueTrackName('A'), tkAudio); + tkText: FProject.AddTrackOfKind(FProject.UniqueTrackName('Т'), tkText); + else + FProject.AddTrack(FProject.UniqueTrackName('V')); + end; FTrackAddedDuringDrag := True; Idx := FProject.TrackCount - 1; if Assigned(FOnTrackAdded) then @@ -1891,11 +2185,18 @@ begin end; { Перенос на другую дорожку: клип следует за указателем по - вертикали. Именно перенос, а не копирование. } + вертикали. Именно перенос, а не копирование. + + На дорожку чужого вида клип не пускаем. Уплощение обходит + дорожки по видам, и клип, попавший не на свою, пропадает и из + сборки, и из предпросмотра — молча: на монтаже он нарисован, а + в ролике его нет. Проверено на живом проекте, где фотография + оказалась на текстовой дорожке. } if (Idx >= 0) and (FProject <> nil) then begin TargetTrack := FProject.Tracks[Idx]; - if TargetTrack <> FDragTrack then + if (TargetTrack <> FDragTrack) and + (TargetTrack.Kind = TProject.TrackKindFor(FDragClip.Kind)) then begin FDragTrack.Extract(FDragClip); TargetTrack.Add(FDragClip); @@ -2097,6 +2398,37 @@ begin { Shift читается и здесь: курсор по щелчку ставится при отпускании, и решение о прилипании должно быть по клавише, которую держат сейчас. } FSnapSuspended := ssShift in Shift; + { Дорожку переставили — предпросмотр надо пересобрать: порядок дорожек + и есть порядок перекрытия. Сообщаем один раз, в конце: во время + перетаскивания дорожка проходит через все промежуточные места. } + if FAction = taDragTrack then + begin + FAction := taNone; + if (FProject <> nil) and (FDragTrackIndex <> FDragTrackFrom) then + begin + FProject.Modified := True; + StructureChanged; + end; + FDragTrackIndex := -1; + Exit; + end; + + { Отметка участка протяжкой: щелчок без движения снимает отметки — это + и есть привычный способ от них избавиться. } + if (FAction in [taRegionIn, taRegionOut]) and (FProject <> nil) then + begin + FAction := taNone; + if not FProject.HasRegion then + begin + FProject.RegionStart := 0; + FProject.RegionEnd := 0; + end; + if Assigned(FOnRegionChange) then + FOnRegionChange(Self); + Invalidate; + Exit; + end; + WasEditing := FAction in [taDragClip, taTrimIn, taTrimOut, taVolume, taFadeIn, taFadeOut]; WasTrimIn := FAction = taTrimIn; @@ -2232,19 +2564,17 @@ begin Tail := TClip.Create; Tail.Id := Clip.Id + '_b'; Tail.MediaId := Clip.MediaId; - Tail.Kind := Clip.Kind; Tail.SrcIn := Clip.SrcIn + Offset; Tail.TlStart := FPlayhead; Tail.Duration := Clip.Duration - Offset; Tail.EdgeOut := Clip.EdgeOut; - { Хвост — тот же клип, только вторая его половина. Всё, что было - настроено, должно перейти к нему: иначе после реза половина клипа - теряет громкость и кадрирование. } - Tail.Volume := Clip.Volume; - Tail.Opacity := Clip.Opacity; + { Хвост — тот же клип, только вторая его половина. Всё настроенное + переходит к нему одним махом: перечислять поля по одному значит + однажды забыть новое. } + Tail.CopySettingsFrom(Clip); + { Кроме появления: оно относится к началу клипа, а начало осталось у + первой половины. } Tail.FadeIn := 0; - Tail.FadeOut := Clip.FadeOut; - Tail.Transform := Clip.Transform; { Связка хвоста — новая. diff --git a/src/uTransform.pas b/src/uTransform.pas index 0c8b91a..acddee3 100644 --- a/src/uTransform.pas +++ b/src/uTransform.pas @@ -22,7 +22,7 @@ unit uTransform; interface uses - Classes, SysUtils; + Classes, SysUtils, uAppTypes; type { Как соотносятся кадр исходника и кадр проекта. } @@ -82,6 +82,16 @@ function OverlayFilter(const AT: TMediaTransform; ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer; out AX, AY, AWidth, AHeight: Integer): string; +{ Фильтр цветового ключа: этот цвет становится прозрачным. + + Один на всех: и сборка, и предпросмотр должны выбивать одинаково, иначе + окно обещает одно, а готовый ролик даёт другое. Цвет записывается как + 0xRRGGBB — порядок обратный тому, в каком он хранится у нас. } +function ColorKeyFilter(AColor: TRgb; ASimilarity, ABlend: Integer): string; + +{ Фильтр приглушения по альфа-каналу. Пусто, если приглушать нечего. } +function OpacityFilter(const AOpacity: Double): string; + function PreviewFitFilter(ADstWidth, ADstHeight: Integer): string; function FitModeToStr(AMode: TFitMode): string; @@ -91,7 +101,7 @@ function FitModeCaption(AMode: TFitMode): string; implementation uses - Math, uAppTypes; + Math; function DefaultTransform: TMediaTransform; begin @@ -143,6 +153,28 @@ begin (ASrcWidth = ADstWidth) and (ASrcHeight = ADstHeight); end; +{ Дробное число через точку: у ffmpeg разделитель всегда точка, а в + русской локали Format вставил бы запятую и развалил бы всю цепочку. } +function FilterNum(const AValue: Double): string; +begin + Result := SecondsToStr(AValue); +end; + +function ColorKeyFilter(AColor: TRgb; ASimilarity, ABlend: Integer): string; +begin + Result := Format('colorkey=0x%.2x%.2x%.2x:%s:%s', + [AColor and $FF, (AColor shr 8) and $FF, (AColor shr 16) and $FF, + FilterNum(ASimilarity / 100), FilterNum(ABlend / 100)]); +end; + +function OpacityFilter(const AOpacity: Double): string; +begin + if AOpacity >= 0.999 then + Result := '' + else + Result := 'colorchannelmixer=aa=' + FilterNum(Max(0, AOpacity)); +end; + function PreviewFitFilter(ADstWidth, ADstHeight: Integer): string; var W, H: string; diff --git a/tests/lfmcheck/lfmcheck.lpr b/tests/lfmcheck/lfmcheck.lpr index b01418f..31ce56f 100644 --- a/tests/lfmcheck/lfmcheck.lpr +++ b/tests/lfmcheck/lfmcheck.lpr @@ -15,7 +15,7 @@ uses { Interfaces нужен, чтобы связалась вся LCL и заработала загрузка файлов форм. } Interfaces, Forms, Classes, SysUtils, Math, TypInfo, uTheme, - uMediaProbe, uProject, uTimelineCtrl, + uMediaProbe, uProject, uTransform, uTimelineCtrl, uPanCropForm, uDepsForm, uMismatchForm, uProgressForm, uProjectInfoForm, uRemuxForm; @@ -153,6 +153,100 @@ begin end; end; +{ Рез не должен терять настройки клипа. + + Половина клипа после реза — тот же клип, и цветовой ключ, кадрирование, + прозрачность, громкость и текст должны остаться при обеих половинах. + Однажды не остались: у хвоста пропадал ключ, клип переставал быть + наложением и закрывал собой всё, что под ним. } +procedure CheckSplitKeepsSettings; +var + Proj: TProject; + Info: TMediaInfo; + Media: TMediaItem; + Timeline: TTimelineControl; + Head, Tail, Cl: TClip; + Key: TColorKey; + Tr: TMediaTransform; + I: Integer; +begin + WriteLn; + WriteLn('Рез сохраняет настройки клипа'); + WriteLn; + + Info := Default(TMediaInfo); + Info.Valid := True; + Info.Kind := mkVideo; + Info.Duration := 600; + Info.HasVideo := True; + Info.VideoCodec := 'hevc'; + Info.Width := 1920; + Info.Height := 1080; + Info.FpsNum := 30; + Info.FpsDen := 1; + Info.PixFmt := 'yuv420p'; + + Proj := TProject.Create; + Timeline := TTimelineControl.Create(nil); + try + Proj.Clear; + Proj.AddTrack('V1'); + Media := Proj.AddMedia('/несуществующий/видео.mp4', Info); + Cl := Proj.AddClip(Proj.Tracks[0], Media, 0, 10, 0); + + Key := DefaultColorKey; + Key.Enabled := True; + Key.Similarity := 22; + Cl.ColorKey := Key; + Cl.Opacity := 0.5; + Cl.Volume := 0.3; + Tr := Cl.Transform; + Tr.Zoom := 0.4; + Tr.OffsetX := 0.7; + Cl.Transform := Tr; + Cl.GroupId := 'g1'; + + Timeline.Project := Proj; + Timeline.PixelsPerSecond := 100; + Timeline.Playhead := 4; + Timeline.SplitAtPlayhead(False, False); + + CheckTrue('клипов стало два', Proj.Tracks[0].Count = 2); + if Proj.Tracks[0].Count <> 2 then + Exit; + + Head := nil; + Tail := nil; + for I := 0 to Proj.Tracks[0].Count - 1 do + if Proj.Tracks[0][I].TlStart < 0.001 then + Head := Proj.Tracks[0][I] + else + Tail := Proj.Tracks[0][I]; + CheckTrue('обе половины нашлись', (Head <> nil) and (Tail <> nil)); + if (Head = nil) or (Tail = nil) then + Exit; + + CheckTrue('ключ остался у хвоста', Tail.ColorKey.Enabled); + CheckTrue('и с тем же цветом', Tail.ColorKey.Color = Key.Color); + CheckTrue('и с тем же допуском', Tail.ColorKey.Similarity = 22); + CheckTrue('прозрачность осталась', Abs(Tail.Opacity - 0.5) < 0.001); + CheckTrue('громкость осталась', Abs(Tail.Volume - 0.3) < 0.001); + CheckTrue('кадрирование осталось', + (Abs(Tail.Transform.Zoom - 0.4) < 0.001) and + (Abs(Tail.Transform.OffsetX - 0.7) < 0.001)); + CheckTrue('ключ остался и у головы', Head.ColorKey.Enabled); + { Связки разные, и обе не пустые: иначе удаление одной половины + уносило бы вторую. } + CheckTrue('связка у половин разная и не пустая', + (Head.GroupId <> Tail.GroupId) and (Head.GroupId <> '') and + (Tail.GroupId <> '')); + CheckTrue('появление у хвоста снято', Abs(Tail.FadeIn) < 0.001); + finally + Timeline.Free; + Proj.Free; + end; +end; + begin WriteLn('Свойства из файлов форм'); WriteLn; @@ -180,6 +274,7 @@ begin CheckForm(TRemuxForm); CheckPlayheadSnap; + CheckSplitKeepsSettings; WriteLn; if Failed = 0 then diff --git a/tests/nlvetool.lpr b/tests/nlvetool.lpr index cb79d12..b886838 100644 --- a/tests/nlvetool.lpr +++ b/tests/nlvetool.lpr @@ -781,6 +781,138 @@ begin end; WriteLn; + { --- 9. Обрезка списка кусков по отмеченному участку --- } + WriteLn(' 9. Сборка только отмеченного участка'); + Proj := MakeProject(1, Media); + try + { Три куска по 5 секунд из разных мест файла: склеиться в один они не + могут, и границы участка приходятся на середину крайних. } + Proj.AddClip(Proj.Tracks[0], Media, 100, 5, 0); + Proj.AddClip(Proj.Tracks[0], Media, 200, 5, 5); + Proj.AddClip(Proj.Tracks[0], Media, 300, 5, 10); + FlattenStream(Proj, tkVideo, 0, Segs, Missing); + Check(Length(Segs) = 3, 'до обрезки три куска'); + + Check(Abs(ClipSegmentsToRange(Segs, 2, 12) - 10) < 0.001, + 'осталось десять секунд'); + DumpSegments(Segs); + Check(Length(Segs) = 3, 'куски остались все три'); + if Length(Segs) = 3 then + begin + Check(Abs(Segs[0].SrcStart - 102) < 0.001, + 'первый начинается на две секунды позже'); + Check(Abs(Segs[0].Duration - 3) < 0.001, 'и длится три секунды'); + Check(Abs(Segs[1].SrcStart - 200) < 0.001, 'средний не тронут'); + Check(Abs(Segs[1].Duration - 5) < 0.001, 'и целиком'); + Check(Abs(Segs[2].SrcStart - 300) < 0.001, 'последний с начала'); + Check(Abs(Segs[2].Duration - 2) < 0.001, 'и укорочен до двух секунд'); + end; + + { Участок целиком внутри одного куска. } + FlattenStream(Proj, tkVideo, 0, Segs, Missing); + Check(Abs(ClipSegmentsToRange(Segs, 6, 8) - 2) < 0.001, + 'внутри одного куска остались две секунды'); + Check(Length(Segs) = 1, 'и один кусок'); + if Length(Segs) = 1 then + Check(Abs(Segs[0].SrcStart - 201) < 0.001, 'взят с нужного места'); + + { Участок мимо монтажа. } + FlattenStream(Proj, tkVideo, 0, Segs, Missing); + Check(Abs(ClipSegmentsToRange(Segs, 100, 200)) < 0.001, + 'за концом монтажа не осталось ничего'); + Check(Length(Segs) = 0, 'и ни одного куска'); + finally + Proj.Free; + end; + WriteLn; + + { --- 10. Клипы на дорожках чужого вида --- } + WriteLn(' 10. Клип на дорожке не своего вида'); + Proj := MakeProject(1, Media); + try + Proj.EnsureAudioTracks; + Proj.AddTrackOfKind('Т1', tkText); + { Картинка на текстовой дорожке — ровно то, что нашлось в живом + проекте: клип виден на монтаже, а в ролик не попадает. } + Clip := Proj.AddClip(Proj.Tracks[Proj.TrackCount - 1], Media, 0, 3, 10); + Clip.Kind := ckImage; + + Check(Proj.MisplacedClipCount = 1, 'нашёлся один такой клип'); + FlattenStream(Proj, tkVideo, 0, Segs, Missing); + Check(Length(Segs) = 0, 'в уплощении его нет'); + + Check(Proj.FixMisplacedClips = 1, 'перенесён один клип'); + Check(Proj.MisplacedClipCount = 0, 'чужих клипов не осталось'); + FlattenStream(Proj, tkVideo, 0, Segs, Missing); + DumpSegments(Segs); + Check(Length(Segs) > 0, 'после переноса он попадает в уплощение'); + Clip := Proj.Tracks[0].ClipAt(11); + Check((Clip <> nil) and (Abs(Clip.TlStart - 10) < 0.001), + 'и стоит на прежнем месте'); + finally + Proj.Free; + end; + WriteLn; + + { --- 11. Оверлей под сплошным клипом в окне не показывается --- } + WriteLn(' 11. Оверлей закрыт сверху сплошным клипом'); + Proj := MakeProject(3, Media); + try + Proj.Master := Media.Info; + { Снизу вверх: V3 — съёмка, V2 — оверлей с ключом на весь ролик, + V1 — фотография поверх куска. Так и было в живом проекте. } + Proj.AddClip(Proj.Tracks[2], Media, 0, 20, 0); + Clip := Proj.AddClip(Proj.Tracks[1], Media, 0, 20, 0); + Key := DefaultColorKey; + Key.Enabled := True; + Clip.ColorKey := Key; + Clip := Proj.AddClip(Proj.Tracks[0], Media, 0, 5, 5); + Clip.Kind := ckImage; + + Check(FlattenPreview(Proj, Segs, AudioSegs, Overlays, Missing), + 'уплощение для предпросмотра прошло'); + { Фотография лежит с 5 по 10 секунду и закрывает оверлей: показывать + его там нельзя — в ролике его там не будет. Значит, от оверлея + остаются два окна: до фотографии и после. } + Check(Length(Overlays) = 2, 'оверлей показывается двумя окнами: ' + + IntToStr(Length(Overlays))); + if Length(Overlays) = 2 then + begin + Check(Abs(Overlays[0].TlStart) < 0.001, 'первое окно с начала'); + Check(Abs(Overlays[0].TlEnd - 5) < 0.001, 'и до фотографии'); + Check(Abs(Overlays[1].TlStart - 10) < 0.001, 'второе после неё'); + Check(Abs(Overlays[1].TlEnd - 20) < 0.001, 'и до конца'); + Check(Abs(Overlays[1].SrcStart - 10) < 0.001, + 'и берётся с того же места исходника'); + end; + finally + Proj.Free; + end; + WriteLn; + + { --- 12. Имена дорожек не повторяются --- } + WriteLn(' 12. Имена дорожек'); + Proj := MakeProject(3, Media); + try + Check(Proj.UniqueTrackName('V') = 'V4', 'следующее имя V4: ' + + Proj.UniqueTrackName('V')); + { Убираем среднюю: счёт дорожек снова три, но имя V3 уже занято, и + считать их для имени нельзя. } + Proj.RemoveTrack(1); + Check(Proj.UniqueTrackName('V') = 'V2', 'после удаления средней — V2: ' + + Proj.UniqueTrackName('V')); + Proj.AddTrack(Proj.UniqueTrackName('V')); + Check(Proj.Tracks[2].Name = 'V2', 'новая дорожка названа V2'); + + { Одинаковые имена, доставшиеся от старого проекта, разводятся. } + Proj.Tracks[2].Name := 'V1'; + Proj.EnsureUniqueTrackNames; + Check(Proj.Tracks[2].Name <> 'V1', 'повтор разведён: ' + Proj.Tracks[2].Name); + finally + Proj.Free; + end; + WriteLn; + WriteLn; if FailCount = 0 then begin @@ -1239,8 +1371,23 @@ begin end; end; + { Вжигание текста — последним, уже по окончательному списку кусков: + повторное уплощение стёрло бы отметки о разметке. Так же устроено и + окно сборки. } + if (ParamCount >= 4) and (LowerCase(ParamStr(4)) = 'burn') then + WriteLn('вжигаю текст, пересобрать придётся ', + SecondsToStr(BurnTextIntoSegments(Proj, Segs, Proj.CacheDir)), ' с'); + + { Куски после удачной сборки убираются — как и в самой программе. + Словом keep их можно оставить: пригодится, когда разбираешься, из + чего собрался ролик. } Thread := TExportThread.Create(Segs, AudioSegs, - ExpandFileName(ParamStr(3)), True, Proj.Master, Default(TEncodeProfile)); + ExpandFileName(ParamStr(3)), + (ParamCount >= 4) and (LowerCase(ParamStr(4)) = 'keep'), + Proj.Master, Default(TEncodeProfile)); + { Словом resume просят продолжить прерванную сборку: готовые куски + берутся с диска, а не считаются заново. } + Thread.Resume := (ParamCount >= 4) and (LowerCase(ParamStr(4)) = 'resume'); Watcher := TExportWatcher.Create(Thread); try Thread.OnProgress := @Watcher.Progress;