4aiman
0bbff345ba
Миникарта была видна в окне, но не в ролике. Предпросмотр рисовал оверлей поверх всего, не глядя на порядок дорожек, а сборка живёт по правилу «верхний клип побеждает целиком»: фотография лежала выше оверлея и в ролике его закрывала. Теперь окно считает так же — оверлей показывается только там, где его не закрывает сплошной клип с дорожки выше, а закрытый посередине разбивается на несколько окон показа. Текст не появлялся в окне. Разметка лежит в файле с одним именем на весь проект, а плеер сравнивал имена: имя прежнее — перечитывать нечего. Правка доходила до окна только вместе с перезагрузкой списка кусков. Теперь сравнивается сама разметка, и при изменении файл перечитывается. Отдельно проверено, что цепочка lavfi-complex субтитрам не мешает. Две дорожки Т2. Имя новой дорожке давалось по счёту дорожек своего вида плюс единица, и после удаления средней счёт совпадал с занятым именем. Имя подбирается свободное, а повторы из старых проектов разводятся при чтении. Проверки 11 и 12 в nlvetool flattest.
1465 lines
51 KiB
ObjectPascal
1465 lines
51 KiB
ObjectPascal
{
|
||
nlvetool — консольный инструмент для проверки внутренностей nlve без
|
||
запуска интерфейса.
|
||
|
||
Нужен потому, что часть вещей проверяется числами, а не глазами:
|
||
совпал ли индекс опорных кадров с тем, что выдаёт ffprobe, сколько
|
||
времени это заняло, правильно ли собирается строка EDL.
|
||
|
||
Команды:
|
||
kf <файл> индекс опорных кадров: способ, количество, время
|
||
kfcheck <файл> то же, но со сверкой быстрого пути с ffprobe
|
||
edl <файл> <старт> <длина> [<старт> <длина> ...]
|
||
собрать и напечатать строку edl://
|
||
export [--cancel-after=<сек>] <файл> <выход> <старт> <длина> [...]
|
||
собрать ролик из кусков и сверить число кадров;
|
||
с --cancel-after проверяется остановка на полпути
|
||
remux <файл> [<файл> ...] <расширение>
|
||
перепаковать файлы в другой контейнер
|
||
flattest проверить уплощение монтажа на наборе случаев
|
||
build <проект.nlve> <видео> [<картинка>]
|
||
собрать проект-образец: видео внизу, картинка
|
||
сверху посередине, дыра в начале
|
||
render <проект.nlve> <выход>
|
||
уплотить проект, создать вставки, собрать ролик
|
||
и сверить число кадров
|
||
subs <проект.nlve>
|
||
собрать разметку субтитров из текстовых клипов
|
||
и напечатать её
|
||
preview <проект.nlve>
|
||
собрать список кусков так же, как это делает
|
||
предпросмотр: с готовыми наложениями вместо
|
||
участков с прозрачностью и переходами
|
||
audio <проект.nlve>
|
||
разложить звуковые дорожки проекта на куски и
|
||
напечатать их вместе со строками edl://
|
||
buildcut <проект.nlve> <видео>
|
||
проект из одного файла с точным резом в заведомо
|
||
неопорной точке
|
||
}
|
||
program nlvetool;
|
||
|
||
{$mode objfpc}{$H+}
|
||
|
||
uses
|
||
{$IFDEF UNIX}
|
||
cthreads,
|
||
{$ENDIF}
|
||
Classes, SysUtils, DateUtils, Math, StrUtils,
|
||
uAppTypes, uEdl, uKeyframeIndex, uFfmpegCmd, uExport, uRemuxQueue,
|
||
uMediaProbe, uProject, uFlatten, uGenerate, uSubtitles, uTransform;
|
||
|
||
procedure PrintUsage;
|
||
begin
|
||
WriteLn('Использование:');
|
||
WriteLn(' nlvetool kf <файл>');
|
||
WriteLn(' nlvetool kfcheck <файл>');
|
||
WriteLn(' nlvetool edl <файл> <старт> <длина> [<старт> <длина> ...]');
|
||
WriteLn(' nlvetool export <файл> <выход> <старт> <длина> [<старт> <длина> ...]');
|
||
end;
|
||
|
||
{ Разбирает пары «старт длина» начиная с указанного номера аргумента. }
|
||
function ParseSegments(const APath: string; AFirstArg: Integer;
|
||
out ASegments: TFlatSegmentArray): Boolean;
|
||
var
|
||
I, N: Integer;
|
||
StartVal, LenVal: Double;
|
||
begin
|
||
ASegments := nil;
|
||
N := (ParamCount - AFirstArg + 1) div 2;
|
||
if N < 1 then
|
||
Exit(False);
|
||
|
||
SetLength(ASegments, N);
|
||
for I := 0 to N - 1 do
|
||
begin
|
||
if not TryStrToFloat(ParamStr(AFirstArg + I * 2), StartVal, InvariantFormat) or
|
||
not TryStrToFloat(ParamStr(AFirstArg + 1 + I * 2), LenVal, InvariantFormat) then
|
||
begin
|
||
WriteLn('Не удалось разобрать числа сегмента ', I + 1);
|
||
Exit(False);
|
||
end;
|
||
ASegments[I].FilePath := APath;
|
||
ASegments[I].SrcStart := StartVal;
|
||
ASegments[I].Duration := LenVal;
|
||
ASegments[I].Kind := skVideo;
|
||
end;
|
||
Result := True;
|
||
end;
|
||
|
||
function SourceName(ASource: TKeyframeSource): string;
|
||
begin
|
||
case ASource of
|
||
kfMp4Header: Result := 'разбор заголовка MP4';
|
||
kfFfprobe: Result := 'опрос ffprobe';
|
||
kfAllFrames: Result := 'каждый кадр опорный';
|
||
else
|
||
Result := 'нет';
|
||
end;
|
||
end;
|
||
|
||
procedure ShowIndex(const AIndex: TKeyframeIndex; const AElapsedMs: Int64);
|
||
var
|
||
I, N: Integer;
|
||
Line: string;
|
||
MinGap, MaxGap, Gap: Double;
|
||
begin
|
||
WriteLn(' способ: ', SourceName(AIndex.Source));
|
||
WriteLn(' время: ', AElapsedMs, ' мс');
|
||
|
||
if AIndex.AllFrames then
|
||
begin
|
||
WriteLn(' опорных: все кадры, резать можно где угодно');
|
||
Exit;
|
||
end;
|
||
|
||
N := Length(AIndex.Times);
|
||
WriteLn(' опорных: ', N);
|
||
if N = 0 then
|
||
Exit;
|
||
|
||
Line := '';
|
||
for I := 0 to Min(5, N - 1) do
|
||
Line := Line + SecondsToStr(AIndex.Times[I]) + ' ';
|
||
WriteLn(' первые: ', Trim(Line));
|
||
WriteLn(' последний: ', SecondsToStr(AIndex.Times[N - 1]));
|
||
|
||
if N > 1 then
|
||
begin
|
||
MinGap := AIndex.Times[1] - AIndex.Times[0];
|
||
MaxGap := MinGap;
|
||
for I := 2 to N - 1 do
|
||
begin
|
||
Gap := AIndex.Times[I] - AIndex.Times[I - 1];
|
||
if Gap < MinGap then
|
||
MinGap := Gap;
|
||
if Gap > MaxGap then
|
||
MaxGap := Gap;
|
||
end;
|
||
WriteLn(' интервал: от ', SecondsToStr(MinGap), ' до ', SecondsToStr(MaxGap), ' с');
|
||
end;
|
||
end;
|
||
|
||
procedure CmdKf(const APath: string; AFastOnly: Boolean);
|
||
var
|
||
Index: TKeyframeIndex;
|
||
Error: string;
|
||
Started: TDateTime;
|
||
Elapsed: Int64;
|
||
Ok: Boolean;
|
||
begin
|
||
Started := Now;
|
||
if AFastOnly then
|
||
Ok := ReadMp4KeyframeIndex(APath, Index, Error)
|
||
else
|
||
Ok := BuildKeyframeIndex(APath, Index, Error);
|
||
Elapsed := MilliSecondsBetween(Now, Started);
|
||
|
||
if not Ok then
|
||
begin
|
||
WriteLn('ОШИБКА: ', Error);
|
||
Halt(1);
|
||
end;
|
||
ShowIndex(Index, Elapsed);
|
||
end;
|
||
|
||
{ Сверяет быстрый путь с медленным: значения должны совпасть, иначе
|
||
разбору заголовка верить нельзя. }
|
||
procedure CmdKfCheck(const APath: string);
|
||
var
|
||
Fast, Slow: TKeyframeIndex;
|
||
Error: string;
|
||
Started: TDateTime;
|
||
FastMs, SlowMs: Int64;
|
||
I, N: Integer;
|
||
Diff, MaxDiff: Double;
|
||
begin
|
||
WriteLn('Быстрый путь (заголовок MP4):');
|
||
Started := Now;
|
||
if not ReadMp4KeyframeIndex(APath, Fast, Error) then
|
||
begin
|
||
WriteLn(' недоступен: ', Error);
|
||
Halt(1);
|
||
end;
|
||
FastMs := MilliSecondsBetween(Now, Started);
|
||
ShowIndex(Fast, FastMs);
|
||
|
||
WriteLn;
|
||
WriteLn('Медленный путь (ffprobe):');
|
||
Started := Now;
|
||
if not BuildKeyframeIndexViaProbe(APath, Slow, Error) then
|
||
begin
|
||
WriteLn(' ОШИБКА: ', Error);
|
||
Halt(1);
|
||
end;
|
||
SlowMs := MilliSecondsBetween(Now, Started);
|
||
ShowIndex(Slow, SlowMs);
|
||
|
||
WriteLn;
|
||
WriteLn('Сверка:');
|
||
if Length(Fast.Times) <> Length(Slow.Times) then
|
||
begin
|
||
WriteLn(' РАСХОЖДЕНИЕ: количество ', Length(Fast.Times), ' против ',
|
||
Length(Slow.Times));
|
||
Halt(1);
|
||
end;
|
||
|
||
N := Length(Fast.Times);
|
||
MaxDiff := 0;
|
||
for I := 0 to N - 1 do
|
||
begin
|
||
Diff := Abs(Fast.Times[I] - Slow.Times[I]);
|
||
if Diff > MaxDiff then
|
||
MaxDiff := Diff;
|
||
end;
|
||
WriteLn(' количество совпало: ', N);
|
||
WriteLn(' наибольшее расхождение меток: ', SecondsToStr(MaxDiff), ' с');
|
||
if FastMs > 0 then
|
||
WriteLn(' быстрее в ', (SlowMs div Max(FastMs, 1)), ' раз')
|
||
else
|
||
WriteLn(' быстрый путь занял меньше миллисекунды');
|
||
|
||
if MaxDiff > 0.001 then
|
||
begin
|
||
WriteLn(' ВЕРДИКТ: расхождение слишком велико');
|
||
Halt(1);
|
||
end;
|
||
WriteLn(' ВЕРДИКТ: совпадает');
|
||
end;
|
||
|
||
procedure CmdEdl;
|
||
var
|
||
Segments: TFlatSegmentArray;
|
||
begin
|
||
if not ParseSegments(ParamStr(2), 3, Segments) then
|
||
begin
|
||
PrintUsage;
|
||
Halt(2);
|
||
end;
|
||
|
||
WriteLn('сегментов: ', Length(Segments));
|
||
WriteLn('длительность: ', SecondsToStr(TotalDuration(Segments)), ' с');
|
||
WriteLn(BuildEdlUri(Segments));
|
||
end;
|
||
|
||
{ Приёмник событий экспорта. Отдельный класс нужен потому, что поток
|
||
отдаёт состояние через обработчики-методы. }
|
||
type
|
||
TExportWatcher = class
|
||
private
|
||
FThread: TExportThread;
|
||
FLastStage: string;
|
||
public
|
||
constructor Create(AThread: TExportThread);
|
||
procedure Progress(Sender: TObject);
|
||
procedure LogLine(Sender: TObject);
|
||
end;
|
||
|
||
constructor TExportWatcher.Create(AThread: TExportThread);
|
||
begin
|
||
inherited Create;
|
||
FThread := AThread;
|
||
end;
|
||
|
||
procedure TExportWatcher.Progress(Sender: TObject);
|
||
begin
|
||
{ Печатаем только смену этапа: строка на каждый процент забила бы вывод. }
|
||
if FThread.StageText <> FLastStage then
|
||
begin
|
||
FLastStage := FThread.StageText;
|
||
WriteLn('[этап] ', FLastStage);
|
||
end;
|
||
end;
|
||
|
||
procedure TExportWatcher.LogLine(Sender: TObject);
|
||
begin
|
||
WriteLn(' ', FThread.PendingLog);
|
||
end;
|
||
|
||
procedure CmdExport;
|
||
var
|
||
Segments: TFlatSegmentArray;
|
||
Thread: TExportThread;
|
||
Watcher: TExportWatcher;
|
||
Rep: TExportReport;
|
||
I, FirstArg: Integer;
|
||
Shift, CancelAfter, Waited: Double;
|
||
ExitCodeValue: Integer;
|
||
Cancelled: Boolean;
|
||
begin
|
||
{ Необязательный флаг остановки идёт первым, чтобы не мешать разбору
|
||
пар «старт длина», которых может быть сколько угодно. }
|
||
CancelAfter := 0;
|
||
FirstArg := 4;
|
||
if Copy(ParamStr(2), 1, 15) = '--cancel-after=' then
|
||
begin
|
||
if not TryStrToFloat(Copy(ParamStr(2), 16, MaxInt), CancelAfter,
|
||
InvariantFormat) then
|
||
begin
|
||
WriteLn('Не удалось разобрать значение --cancel-after');
|
||
Halt(2);
|
||
end;
|
||
FirstArg := 5;
|
||
end;
|
||
|
||
if not ParseSegments(ParamStr(FirstArg - 2), FirstArg, Segments) then
|
||
begin
|
||
PrintUsage;
|
||
Halt(2);
|
||
end;
|
||
|
||
WriteLn('исходник: ', ParamStr(FirstArg - 2));
|
||
WriteLn('выход: ', ParamStr(FirstArg - 1));
|
||
WriteLn('сегментов: ', Length(Segments));
|
||
WriteLn('длительность: ', SecondsToStr(TotalDuration(Segments)), ' с');
|
||
if CancelAfter > 0 then
|
||
WriteLn('остановка через: ', SecondsToStr(CancelAfter), ' с');
|
||
WriteLn;
|
||
|
||
{ Проверка вырезания и склейки картинки: звук здесь не собирается. }
|
||
Thread := TExportThread.Create(Segments, nil, ParamStr(FirstArg - 1), True,
|
||
Default(TMediaInfo), Default(TEncodeProfile));
|
||
Watcher := TExportWatcher.Create(Thread);
|
||
try
|
||
Thread.OnProgress := @Watcher.Progress;
|
||
Thread.OnLog := @Watcher.LogLine;
|
||
Thread.Start;
|
||
|
||
{ Поток общается через Synchronize, а в консольной программе цикла
|
||
сообщений нет. Значит, разбирать очередь обязан главный поток сам. }
|
||
Waited := 0;
|
||
Cancelled := False;
|
||
while not Thread.Finished do
|
||
begin
|
||
CheckSynchronize(100);
|
||
Waited := Waited + 0.1;
|
||
if (CancelAfter > 0) and (not Cancelled) and (Waited >= CancelAfter) then
|
||
begin
|
||
Cancelled := True;
|
||
WriteLn('[тест] запрашиваю остановку');
|
||
Thread.RequestCancel;
|
||
end;
|
||
end;
|
||
CheckSynchronize(0);
|
||
|
||
Rep := Thread.Report;
|
||
finally
|
||
Watcher.Free;
|
||
Thread.Free;
|
||
end;
|
||
|
||
if CancelAfter > 0 then
|
||
begin
|
||
WriteLn;
|
||
WriteLn('--- Проверка остановки ---');
|
||
WriteLn(' отмечено как отменённое: ', Rep.Cancelled);
|
||
WriteLn(' сообщение: ', Rep.Message);
|
||
if Rep.Cancelled and (not Rep.Succeeded) then
|
||
begin
|
||
WriteLn(' ВЕРДИКТ: остановка отработала');
|
||
Halt(0);
|
||
end;
|
||
WriteLn(' ВЕРДИКТ: остановка НЕ отработала');
|
||
Halt(1);
|
||
end;
|
||
|
||
WriteLn;
|
||
WriteLn('--- Отчёт ---');
|
||
for I := 0 to High(Rep.Segments) do
|
||
begin
|
||
Shift := Rep.Segments[I].ActualStart - Rep.Segments[I].RequestedStart;
|
||
WriteLn(Format(' кусок %d: старт %s (просили %s, сдвиг %s), длина %s, пакетов %d',
|
||
[I + 1,
|
||
SecondsToStr(Rep.Segments[I].ActualStart),
|
||
SecondsToStr(Rep.Segments[I].RequestedStart),
|
||
SecondsToStr(Shift),
|
||
SecondsToStr(Rep.Segments[I].Duration),
|
||
Rep.Segments[I].Packets]));
|
||
end;
|
||
|
||
WriteLn(' сумма пакетов кусков: ', Rep.ExpectedPackets);
|
||
WriteLn(' пакетов в готовом файле: ', Rep.ActualPackets);
|
||
WriteLn(' результат: ', Rep.Message);
|
||
|
||
ExitCodeValue := 0;
|
||
if not Rep.Succeeded then
|
||
ExitCodeValue := 1
|
||
else if Rep.ExpectedPackets <> Rep.ActualPackets then
|
||
begin
|
||
WriteLn(' ВЕРДИКТ: РАСХОЖДЕНИЕ на ',
|
||
Rep.ActualPackets - Rep.ExpectedPackets, ' кадров');
|
||
ExitCodeValue := 1;
|
||
end
|
||
else
|
||
WriteLn(' ВЕРДИКТ: склейка не потеряла и не продублировала ни одного кадра');
|
||
|
||
Halt(ExitCodeValue);
|
||
end;
|
||
|
||
type
|
||
TRemuxWatcher = class
|
||
private
|
||
FThread: TRemuxThread;
|
||
FEntries: TRemuxEntries;
|
||
public
|
||
constructor Create(AThread: TRemuxThread; const AEntries: TRemuxEntries);
|
||
procedure LogLine(Sender: TObject);
|
||
procedure Item(Sender: TObject; AIndex: Integer; AState: TRemuxState;
|
||
const AMessage: string);
|
||
property Entries: TRemuxEntries read FEntries;
|
||
end;
|
||
|
||
constructor TRemuxWatcher.Create(AThread: TRemuxThread;
|
||
const AEntries: TRemuxEntries);
|
||
begin
|
||
inherited Create;
|
||
FThread := AThread;
|
||
FEntries := Copy(AEntries);
|
||
end;
|
||
|
||
procedure TRemuxWatcher.LogLine(Sender: TObject);
|
||
begin
|
||
WriteLn(' ', FThread.PendingLog);
|
||
end;
|
||
|
||
procedure TRemuxWatcher.Item(Sender: TObject; AIndex: Integer;
|
||
AState: TRemuxState; const AMessage: string);
|
||
begin
|
||
if (AIndex < 0) or (AIndex > High(FEntries)) then
|
||
Exit;
|
||
FEntries[AIndex].State := AState;
|
||
FEntries[AIndex].Message := AMessage;
|
||
WriteLn('[', StateCaption(AState), '] ', FEntries[AIndex].Source,
|
||
' -> ', FEntries[AIndex].Target,
|
||
IfThen(AMessage <> '', ' (' + AMessage + ')', ''));
|
||
end;
|
||
|
||
procedure CmdRemux;
|
||
var
|
||
Entries: TRemuxEntries = nil;
|
||
Thread: TRemuxThread;
|
||
Watcher: TRemuxWatcher;
|
||
Ext: string;
|
||
I, N, Ok, Bad: Integer;
|
||
begin
|
||
{ Последний аргумент — целевое расширение, всё до него — файлы. }
|
||
Ext := ParamStr(ParamCount);
|
||
if (Ext = '') or (Ext[1] <> '.') then
|
||
begin
|
||
WriteLn('Последним аргументом должно быть расширение, например .mp4');
|
||
Halt(2);
|
||
end;
|
||
|
||
N := ParamCount - 2;
|
||
SetLength(Entries, N);
|
||
for I := 0 to N - 1 do
|
||
begin
|
||
Entries[I].Source := ExpandFileName(ParamStr(2 + I));
|
||
Entries[I].Target := SuggestTarget(Entries[I].Source, Ext);
|
||
Entries[I].Message := '';
|
||
if FileExists(Entries[I].Source) then
|
||
Entries[I].State := rsPending
|
||
else
|
||
Entries[I].State := rsBadPath;
|
||
end;
|
||
|
||
Thread := TRemuxThread.Create(Entries);
|
||
Watcher := TRemuxWatcher.Create(Thread, Entries);
|
||
try
|
||
Thread.OnLog := @Watcher.LogLine;
|
||
Thread.OnItem := @Watcher.Item;
|
||
Thread.Start;
|
||
while not Thread.Finished do
|
||
CheckSynchronize(100);
|
||
CheckSynchronize(0);
|
||
Entries := Watcher.Entries;
|
||
finally
|
||
Watcher.Free;
|
||
Thread.Free;
|
||
end;
|
||
|
||
Ok := 0;
|
||
Bad := 0;
|
||
for I := 0 to High(Entries) do
|
||
if Entries[I].State = rsDone then
|
||
Inc(Ok)
|
||
else
|
||
Inc(Bad);
|
||
|
||
WriteLn;
|
||
WriteLn('Успешно: ', Ok, ', с ошибками: ', Bad);
|
||
if Bad > 0 then
|
||
Halt(1);
|
||
end;
|
||
|
||
{ --- Проверка уплощения монтажа --- }
|
||
|
||
var
|
||
FailCount: Integer = 0;
|
||
|
||
procedure Check(ACondition: Boolean; const AWhat: string);
|
||
begin
|
||
if ACondition then
|
||
WriteLn(' ok ', AWhat)
|
||
else
|
||
begin
|
||
WriteLn(' ПЛОХО ', AWhat);
|
||
Inc(FailCount);
|
||
end;
|
||
end;
|
||
|
||
{ Проект с одним видеофайлом и нужным числом дорожек. Файл ненастоящий:
|
||
уплощение смотрит только на записанные параметры, а не на содержимое. }
|
||
function MakeProject(ATracks: Integer; out AMedia: TMediaItem): TProject;
|
||
var
|
||
Info: TMediaInfo;
|
||
I: Integer;
|
||
begin
|
||
Info := Default(TMediaInfo);
|
||
Info.Valid := True;
|
||
Info.Kind := mkVideo;
|
||
Info.Duration := 600;
|
||
Info.HasVideo := True;
|
||
Info.VideoCodec := 'hevc';
|
||
Info.Width := 1920;
|
||
Info.Height := 1080;
|
||
Info.FpsNum := 30;
|
||
Info.FpsDen := 1;
|
||
Info.PixFmt := 'yuv420p';
|
||
Info.HasAudio := True;
|
||
Info.AudioCodec := 'aac';
|
||
Info.SampleRate := 48000;
|
||
Info.Channels := 2;
|
||
|
||
Result := TProject.Create;
|
||
Result.Clear;
|
||
for I := 1 to ATracks do
|
||
Result.AddTrack('V' + IntToStr(I));
|
||
AMedia := Result.AddMedia('/несуществующий/видео.mp4', Info);
|
||
end;
|
||
|
||
procedure DumpSegments(const ASegments: TFlatSegmentArray);
|
||
var
|
||
I: Integer;
|
||
KindName: string;
|
||
begin
|
||
for I := 0 to High(ASegments) do
|
||
begin
|
||
case ASegments[I].Kind of
|
||
skBlack: KindName := 'чёрное';
|
||
skImage: KindName := 'картинка';
|
||
else
|
||
KindName := 'видео';
|
||
end;
|
||
WriteLn(Format(' [%d] %s из %s длина %s',
|
||
[I, KindName, SecondsToStr(ASegments[I].SrcStart),
|
||
SecondsToStr(ASegments[I].Duration)]));
|
||
end;
|
||
end;
|
||
|
||
procedure CmdFlatTest;
|
||
var
|
||
Proj: TProject;
|
||
Media: TMediaItem;
|
||
Segs, AudioSegs: TFlatSegmentArray;
|
||
Overlays: TPreviewOverlays;
|
||
Missing: TGenRequests;
|
||
Clip: TClip;
|
||
Key: TColorKey;
|
||
Tr: TMediaTransform;
|
||
TempFile, Err: string;
|
||
begin
|
||
WriteLn('Проверка уплощения монтажа');
|
||
WriteLn;
|
||
|
||
{ --- 1. Два подряд идущих куска одного файла склеиваются в один --- }
|
||
WriteLn(' 1. Два куска подряд из одного файла');
|
||
Proj := MakeProject(1, Media);
|
||
try
|
||
Proj.AddClip(Proj.Tracks[0], Media, 10, 5, 0);
|
||
Proj.AddClip(Proj.Tracks[0], Media, 15, 5, 5);
|
||
FlattenStream(Proj, tkVideo, 0, Segs, Missing);
|
||
DumpSegments(Segs);
|
||
Check(Length(Segs) = 1, 'склеились в один кусок');
|
||
if Length(Segs) = 1 then
|
||
begin
|
||
Check(Abs(Segs[0].SrcStart - 10) < 0.001, 'начало на 10 с');
|
||
Check(Abs(Segs[0].Duration - 10) < 0.001, 'длина 10 с');
|
||
end;
|
||
finally
|
||
Proj.Free;
|
||
end;
|
||
WriteLn;
|
||
|
||
{ --- 2. Куски из разных мест файла не склеиваются --- }
|
||
WriteLn(' 2. Два куска из разных мест файла');
|
||
Proj := MakeProject(1, Media);
|
||
try
|
||
Proj.AddClip(Proj.Tracks[0], Media, 100, 5, 0);
|
||
Proj.AddClip(Proj.Tracks[0], Media, 200, 5, 5);
|
||
FlattenStream(Proj, tkVideo, 0, Segs, Missing);
|
||
DumpSegments(Segs);
|
||
Check(Length(Segs) = 2, 'остались двумя кусками');
|
||
finally
|
||
Proj.Free;
|
||
end;
|
||
WriteLn;
|
||
|
||
{ --- 3. Верхний клип разрывает нижний надвое --- }
|
||
WriteLn(' 3. Верхний клип посреди нижнего');
|
||
Proj := MakeProject(2, Media);
|
||
try
|
||
{ Дорожка 0 — верхняя, она побеждает. }
|
||
Proj.AddClip(Proj.Tracks[1], Media, 0, 30, 0);
|
||
Proj.AddClip(Proj.Tracks[0], Media, 100, 10, 10);
|
||
FlattenStream(Proj, tkVideo, 0, Segs, Missing);
|
||
DumpSegments(Segs);
|
||
Check(Length(Segs) = 3, 'получилось три куска');
|
||
if Length(Segs) = 3 then
|
||
begin
|
||
Check(Abs(Segs[0].SrcStart - 0) < 0.001, 'первый — начало нижнего');
|
||
Check(Abs(Segs[0].Duration - 10) < 0.001, 'первый длиной 10 с');
|
||
Check(Abs(Segs[1].SrcStart - 100) < 0.001, 'второй — верхний клип');
|
||
Check(Abs(Segs[1].Duration - 10) < 0.001, 'второй длиной 10 с');
|
||
Check(Abs(Segs[2].SrcStart - 20) < 0.001,
|
||
'третий продолжает нижний с 20 с, а не с начала');
|
||
Check(Abs(Segs[2].Duration - 10) < 0.001, 'третий длиной 10 с');
|
||
end;
|
||
finally
|
||
Proj.Free;
|
||
end;
|
||
WriteLn;
|
||
|
||
{ --- 4. Дыра в начале и в середине становится чёрным --- }
|
||
WriteLn(' 4. Дыры превращаются в чёрные вставки');
|
||
Proj := MakeProject(1, Media);
|
||
try
|
||
Proj.AddClip(Proj.Tracks[0], Media, 0, 5, 3);
|
||
Proj.AddClip(Proj.Tracks[0], Media, 50, 5, 12);
|
||
FlattenStream(Proj, tkVideo, 0, Segs, Missing);
|
||
DumpSegments(Segs);
|
||
Check(Length(Segs) = 4, 'четыре куска: чёрное, видео, чёрное, видео');
|
||
if Length(Segs) = 4 then
|
||
begin
|
||
Check(Segs[0].Kind = skBlack, 'первый чёрный');
|
||
Check(Abs(Segs[0].Duration - 3) < 0.001, 'первый длиной 3 с');
|
||
Check(Segs[1].Kind = skVideo, 'второй видео');
|
||
Check(Segs[2].Kind = skBlack, 'третий чёрный');
|
||
Check(Abs(Segs[2].Duration - 4) < 0.001, 'третий длиной 4 с');
|
||
Check(Segs[3].Kind = skVideo, 'четвёртый видео');
|
||
end;
|
||
{ Обе дыры разной длины берутся из одного файла-заготовки: вставки
|
||
делаются готовых длин, а нужный кусок из них вырезается. Раньше на
|
||
каждую длину заводился свой файл, и любое движение клипа требовало
|
||
новой генерации — из-за этого предпросмотр отставал от монтажа. }
|
||
Check(Length(Missing) = 1, 'обе дыры обслуживает одна заготовка');
|
||
Check(Segs[0].FilePath = Segs[2].FilePath,
|
||
'обе чёрные вставки ссылаются на один файл');
|
||
finally
|
||
Proj.Free;
|
||
end;
|
||
WriteLn;
|
||
|
||
{ --- 5. Полностью перекрытый нижний клип не попадает в итог --- }
|
||
WriteLn(' 5. Нижний клип перекрыт целиком');
|
||
Proj := MakeProject(2, Media);
|
||
try
|
||
Proj.AddClip(Proj.Tracks[1], Media, 0, 10, 0);
|
||
Proj.AddClip(Proj.Tracks[0], Media, 200, 10, 0);
|
||
FlattenStream(Proj, tkVideo, 0, Segs, Missing);
|
||
DumpSegments(Segs);
|
||
Check(Length(Segs) = 1, 'остался один кусок');
|
||
if Length(Segs) = 1 then
|
||
Check(Abs(Segs[0].SrcStart - 200) < 0.001, 'взят верхний клип');
|
||
finally
|
||
Proj.Free;
|
||
end;
|
||
WriteLn;
|
||
|
||
{ --- 6. Выключенная дорожка не участвует --- }
|
||
WriteLn(' 6. Выключенная верхняя дорожка пропускается');
|
||
Proj := MakeProject(2, Media);
|
||
try
|
||
Proj.AddClip(Proj.Tracks[1], Media, 0, 10, 0);
|
||
Proj.AddClip(Proj.Tracks[0], Media, 200, 10, 0);
|
||
Proj.Tracks[0].Muted := True;
|
||
FlattenStream(Proj, tkVideo, 0, Segs, Missing);
|
||
DumpSegments(Segs);
|
||
Check(Length(Segs) = 1, 'остался один кусок');
|
||
if Length(Segs) = 1 then
|
||
Check(Abs(Segs[0].SrcStart - 0) < 0.001, 'взят нижний клип');
|
||
finally
|
||
Proj.Free;
|
||
end;
|
||
WriteLn;
|
||
|
||
{ --- 7. Сохранение и чтение проекта не меняют монтаж --- }
|
||
WriteLn(' 7. Проект переживает запись и чтение');
|
||
TempFile := IncludeTrailingPathDelimiter(GetCurrentDir) + 'flattest.nlve';
|
||
Proj := MakeProject(2, Media);
|
||
try
|
||
Proj.AddClip(Proj.Tracks[1], Media, 0, 30, 0);
|
||
Proj.AddClip(Proj.Tracks[0], Media, 100, 10, 10);
|
||
Proj.Tracks[0][0].EdgeIn := edPrecise;
|
||
Proj.RippleMode := rmAllTracks;
|
||
Proj.RippleEnabled := True;
|
||
FlattenStream(Proj, tkVideo, 0, Segs, Missing);
|
||
Check(Length(Segs) = 3, 'до записи три куска');
|
||
Check(Proj.SaveToFile(TempFile, Err), 'записан: ' + Err);
|
||
finally
|
||
Proj.Free;
|
||
end;
|
||
|
||
Proj := TProject.Create;
|
||
try
|
||
Check(Proj.LoadFromFile(TempFile, Err), 'прочитан: ' + Err);
|
||
{ Четыре: две картинки и две звука. Звуковые заводятся сразу, чтобы
|
||
каждому клипу картинки было куда положить парный звук. }
|
||
Check(Proj.TrackCount = 4, 'дорожек снова четыре');
|
||
Check(Proj.TrackCountOf(tkVideo) = 2, 'из них две для картинки');
|
||
Check(Proj.TrackCountOf(tkAudio) = 2, 'и две для звука');
|
||
Check(Proj.PoolCount = 1, 'файл в списке один');
|
||
Check(Proj.RippleMode = rmAllTracks, 'режим схлопывания сохранился');
|
||
Check(Proj.RippleEnabled, 'состояние схлопывания сохранилось');
|
||
if Proj.TrackCount = 2 then
|
||
Check(Proj.Tracks[0][0].EdgeIn = edPrecise, 'признак точного реза сохранился');
|
||
FlattenStream(Proj, tkVideo, 0, Segs, Missing);
|
||
DumpSegments(Segs);
|
||
Check(Length(Segs) = 3, 'после чтения снова три куска');
|
||
if Length(Segs) = 3 then
|
||
Check(Abs(Segs[2].SrcStart - 20) < 0.001, 'третий кусок на том же месте');
|
||
finally
|
||
Proj.Free;
|
||
end;
|
||
DeleteFile(TempFile);
|
||
WriteLn;
|
||
|
||
{ --- 8. Оверлей в предпросмотре не закрывает нижний клип --- }
|
||
WriteLn(' 8. Клип с ключом поверх: основа и оверлей врозь');
|
||
Proj := MakeProject(2, Media);
|
||
try
|
||
Proj.Master := Media.Info;
|
||
{ Нижняя дорожка — обычный кусок, верхняя — тот же файл с выбитым
|
||
цветом во всю длину. Так выглядит компас или карта поверх ролика. }
|
||
Proj.AddClip(Proj.Tracks[1], Media, 0, 10, 0);
|
||
Clip := Proj.AddClip(Proj.Tracks[0], Media, 100, 10, 0);
|
||
Key := DefaultColorKey;
|
||
Key.Enabled := True;
|
||
Clip.ColorKey := Key;
|
||
Tr := Clip.Transform;
|
||
Tr.Zoom := 0.5;
|
||
Clip.Transform := Tr;
|
||
|
||
{ Обычное уплощение: побеждает верхний, нижнего не видно. }
|
||
FlattenStream(Proj, tkVideo, 0, Segs, Missing);
|
||
Check(Length(Segs) = 1, 'при сборке кусок один');
|
||
if Length(Segs) = 1 then
|
||
Check(Abs(Segs[0].SrcStart - 100) < 0.001, 'и это верхний клип');
|
||
|
||
{ Уплощение для предпросмотра: верхний ушёл в оверлей. }
|
||
Check(FlattenPreview(Proj, Segs, AudioSegs, Overlays, Missing),
|
||
'уплощение для предпросмотра прошло');
|
||
DumpSegments(Segs);
|
||
Check(Length(Segs) = 1, 'основа из одного куска');
|
||
if Length(Segs) = 1 then
|
||
Check(Abs(Segs[0].SrcStart - 0) < 0.001, 'в основе виден нижний клип');
|
||
Check(Length(Overlays) = 1, 'оверлей один');
|
||
if Length(Overlays) = 1 then
|
||
begin
|
||
Check(Abs(Overlays[0].TlStart) < 0.001, 'оверлей с начала');
|
||
Check(Abs(Overlays[0].TlEnd - 10) < 0.001, 'и до конца');
|
||
Check(Abs(Overlays[0].SrcStart - 100) < 0.001, 'берётся с 100 с');
|
||
Check((Overlays[0].Width = 960) and (Overlays[0].Height = 540),
|
||
'уменьшен вдвое: ' + IntToStr(Overlays[0].Width) + 'x' +
|
||
IntToStr(Overlays[0].Height));
|
||
Check((Overlays[0].X = 480) and (Overlays[0].Y = 270),
|
||
'и стоит в середине кадра: ' + IntToStr(Overlays[0].X) + ':' +
|
||
IntToStr(Overlays[0].Y));
|
||
end;
|
||
finally
|
||
Proj.Free;
|
||
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
|
||
WriteLn('ВЕРДИКТ: все проверки пройдены');
|
||
Halt(0);
|
||
end;
|
||
WriteLn('ВЕРДИКТ: не пройдено проверок: ', FailCount);
|
||
Halt(1);
|
||
end;
|
||
|
||
{ --- Сборка проекта-образца и его отрисовка --- }
|
||
|
||
procedure CmdBuild;
|
||
var
|
||
Proj: TProject;
|
||
Info: TMediaInfo;
|
||
Video, Image: TMediaItem;
|
||
Err: string;
|
||
begin
|
||
Proj := TProject.Create;
|
||
try
|
||
Proj.Clear;
|
||
Proj.AddTrack('V1');
|
||
Proj.AddTrack('V2');
|
||
Proj.EnsureAudioTracks;
|
||
|
||
if not ProbeMedia(ExpandFileName(ParamStr(3)), Info, Err) then
|
||
begin
|
||
WriteLn('Не удалось прочитать видео: ', Err);
|
||
Halt(1);
|
||
end;
|
||
Video := Proj.AddMedia(ExpandFileName(ParamStr(3)), Info);
|
||
WriteLn('видео: ', DescribeMedia(Info));
|
||
|
||
{ Нижняя дорожка: два куска видео из разных мест, между ними дыра
|
||
в две секунды, и ещё дыра в начале. }
|
||
{ Парой: клип картинки и его звук на соответствующей звуковой
|
||
дорожке. Так собранный проект похож на настоящий. }
|
||
Proj.AddClipPair(Proj.Tracks[1], Video, 100, 6, 1.5);
|
||
Proj.AddClipPair(Proj.Tracks[1], Video, 400, 6, 9.5);
|
||
|
||
if ParamCount >= 4 then
|
||
begin
|
||
if not ProbeMedia(ExpandFileName(ParamStr(4)), Info, Err) then
|
||
begin
|
||
WriteLn('Не удалось прочитать картинку: ', Err);
|
||
Halt(1);
|
||
end;
|
||
Image := Proj.AddMedia(ExpandFileName(ParamStr(4)), Info);
|
||
WriteLn('картинка: ', DescribeMedia(Info));
|
||
{ Верхняя дорожка: картинка ровно посередине первого куска —
|
||
она должна разорвать его надвое. }
|
||
Proj.AddClip(Proj.Tracks[0], Image, 0, 3, 3.5);
|
||
end;
|
||
|
||
if not Proj.SaveToFile(ExpandFileName(ParamStr(2)), Err) then
|
||
begin
|
||
WriteLn('Не удалось записать проект: ', Err);
|
||
Halt(1);
|
||
end;
|
||
WriteLn('проект записан: ', Proj.FileName);
|
||
WriteLn('длина монтажа: ', SecondsToStr(Proj.EndTime), ' с');
|
||
finally
|
||
Proj.Free;
|
||
end;
|
||
end;
|
||
|
||
{ Проект для проверки цветового ключа: нижний клип во всю длину и
|
||
верхний с выбитым пурпурным поверх него. Собранное потом смотрим по
|
||
точкам кадра: где был пурпурный, должно быть видно нижний клип. }
|
||
procedure CmdKeyTest;
|
||
var
|
||
Proj: TProject;
|
||
Info: TMediaInfo;
|
||
Bottom, Top: TMediaItem;
|
||
Clip: TClip;
|
||
Key: TColorKey;
|
||
Err: string;
|
||
begin
|
||
Proj := TProject.Create;
|
||
try
|
||
Proj.Clear;
|
||
Proj.AddTrack('V1');
|
||
Proj.AddTrack('V2');
|
||
Proj.EnsureAudioTracks;
|
||
|
||
if not ProbeMedia(ExpandFileName(ParamStr(3)), Info, Err) then
|
||
begin
|
||
WriteLn('Не удалось прочитать нижнее видео: ', Err);
|
||
Halt(1);
|
||
end;
|
||
Bottom := Proj.AddMedia(ExpandFileName(ParamStr(3)), Info);
|
||
WriteLn('низ: ', DescribeMedia(Info));
|
||
Proj.AddClipPair(Proj.Tracks[1], Bottom, 0, 3, 0);
|
||
|
||
if not ProbeMedia(ExpandFileName(ParamStr(4)), Info, Err) then
|
||
begin
|
||
WriteLn('Не удалось прочитать верхнее видео: ', Err);
|
||
Halt(1);
|
||
end;
|
||
Top := Proj.AddMedia(ExpandFileName(ParamStr(4)), Info);
|
||
WriteLn('верх: ', DescribeMedia(Info));
|
||
Clip := Proj.AddClip(Proj.Tracks[0], Top, 0, 3, 0);
|
||
|
||
Key := DefaultColorKey;
|
||
Key.Enabled := True;
|
||
Clip.ColorKey := Key;
|
||
|
||
if not Proj.SaveToFile(ExpandFileName(ParamStr(2)), Err) then
|
||
begin
|
||
WriteLn('Не удалось записать проект: ', Err);
|
||
Halt(1);
|
||
end;
|
||
WriteLn('проект записан: ', Proj.FileName);
|
||
finally
|
||
Proj.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure CmdBuildCut;
|
||
var
|
||
Proj: TProject;
|
||
Info: TMediaInfo;
|
||
Video: TMediaItem;
|
||
Err: string;
|
||
Clip: TClip;
|
||
begin
|
||
Proj := TProject.Create;
|
||
try
|
||
Proj.Clear;
|
||
Proj.AddTrack('V1');
|
||
|
||
if not ProbeMedia(ExpandFileName(ParamStr(3)), Info, Err) then
|
||
begin
|
||
WriteLn('Не удалось прочитать видео: ', Err);
|
||
Halt(1);
|
||
end;
|
||
Video := Proj.AddMedia(ExpandFileName(ParamStr(3)), Info);
|
||
WriteLn('видео: ', DescribeMedia(Info));
|
||
|
||
{ Первый кусок с обычным резом, второй — с точным, причём начало
|
||
выбрано заведомо не на опорном кадре: у этого материала они идут
|
||
через 1.001 с, а 200.500 между ними. }
|
||
Proj.AddClip(Proj.Tracks[0], Video, 100.0, 5, 0);
|
||
Clip := Proj.AddClip(Proj.Tracks[0], Video, 200.5, 5, 5);
|
||
Clip.EdgeIn := edPrecise;
|
||
|
||
if not Proj.SaveToFile(ExpandFileName(ParamStr(2)), Err) then
|
||
begin
|
||
WriteLn('Не удалось записать проект: ', Err);
|
||
Halt(1);
|
||
end;
|
||
WriteLn('проект записан: ', Proj.FileName);
|
||
WriteLn('второй кусок начинается точно с 200.500000 с');
|
||
finally
|
||
Proj.Free;
|
||
end;
|
||
end;
|
||
|
||
type
|
||
TGenWatcher = class
|
||
private
|
||
FThread: TGenerateThread;
|
||
FLast: string;
|
||
public
|
||
constructor Create(AThread: TGenerateThread);
|
||
procedure Progress(Sender: TObject);
|
||
procedure LogLine(Sender: TObject);
|
||
end;
|
||
|
||
constructor TGenWatcher.Create(AThread: TGenerateThread);
|
||
begin
|
||
inherited Create;
|
||
FThread := AThread;
|
||
end;
|
||
|
||
procedure TGenWatcher.Progress(Sender: TObject);
|
||
begin
|
||
if FThread.StageText <> FLast then
|
||
begin
|
||
FLast := FThread.StageText;
|
||
WriteLn('[этап] ', FLast);
|
||
end;
|
||
end;
|
||
|
||
procedure TGenWatcher.LogLine(Sender: TObject);
|
||
begin
|
||
WriteLn(' ', FThread.PendingLog);
|
||
end;
|
||
|
||
|
||
{ Раскладка звуковых дорожек.
|
||
|
||
Нужна потому, что «звука нет вот здесь» глазами не разобрать: громкость
|
||
может быть верной, а кусок в этом месте — ссылаться не туда. Здесь
|
||
печатается ровно то, что уходит в плеер: место на монтаже, файл, место
|
||
в файле, длина. }
|
||
procedure CmdAudio;
|
||
var
|
||
Proj: TProject;
|
||
Segs: TFlatSegmentArray;
|
||
Missing: TGenRequests;
|
||
Err: string;
|
||
I, J: Integer;
|
||
Total, At: Double;
|
||
Kind: string;
|
||
begin
|
||
Proj := TProject.Create;
|
||
try
|
||
if not Proj.LoadFromFile(ExpandFileName(ParamStr(2)), Err) then
|
||
begin
|
||
WriteLn('Не удалось прочитать проект: ', Err);
|
||
Halt(1);
|
||
end;
|
||
|
||
Total := Max(AudibleEnd(Proj, tkVideo), AudibleEnd(Proj, tkAudio));
|
||
WriteLn('проект: ', Proj.FileName);
|
||
WriteLn('длина слышимого: ', SecondsToStr(Total), ' с');
|
||
WriteLn;
|
||
|
||
for I := 0 to Proj.TrackCount - 1 do
|
||
begin
|
||
if Proj.Tracks[I].Kind <> tkAudio then
|
||
Continue;
|
||
WriteLn('=== ', Proj.Tracks[I].Name, ' ===');
|
||
if not Proj.TrackAudible(Proj.Tracks[I]) then
|
||
begin
|
||
WriteLn(' не слышна (заглушена или пуста)');
|
||
WriteLn;
|
||
Continue;
|
||
end;
|
||
if Proj.Tracks[I].Count = 0 then
|
||
begin
|
||
WriteLn(' клипов нет');
|
||
WriteLn;
|
||
Continue;
|
||
end;
|
||
if not FlattenAudioTrack(Proj, Proj.Tracks[I], Total, Segs, Missing) then
|
||
begin
|
||
WriteLn(' разложить не удалось');
|
||
WriteLn;
|
||
Continue;
|
||
end;
|
||
|
||
At := 0;
|
||
for J := 0 to High(Segs) do
|
||
begin
|
||
if Segs[J].Kind = skBlack then
|
||
Kind := 'тишина'
|
||
else
|
||
Kind := 'звук ';
|
||
WriteLn(Format(' [%2d] %s монтаж %8s..%8s длина %8s из %8s %s',
|
||
[J, Kind, SecondsToStr(At), SecondsToStr(At + Segs[J].Duration),
|
||
SecondsToStr(Segs[J].Duration), SecondsToStr(Segs[J].SrcStart),
|
||
ExtractFileName(Segs[J].FilePath)]));
|
||
if (Segs[J].Kind = skBlack) and (not FileExists(Segs[J].FilePath)) then
|
||
WriteLn(' ВНИМАНИЕ: вставки тишины нет на диске');
|
||
At := At + Segs[J].Duration;
|
||
end;
|
||
WriteLn(' всего по дорожке: ', SecondsToStr(At), ' с');
|
||
WriteLn;
|
||
WriteLn(' ', BuildEdlUri(Segs));
|
||
WriteLn;
|
||
end;
|
||
finally
|
||
Proj.Free;
|
||
end;
|
||
end;
|
||
|
||
|
||
{ Список кусков предпросмотра.
|
||
|
||
Отличается от сборки одним: участки с прозрачностью и переходами плеер
|
||
показать не может, поэтому они заранее сводятся в отдельные файлы. Здесь
|
||
видно, какие именно участки и во что превратились. }
|
||
|
||
{ Разметка субтитров из текстовых клипов.
|
||
|
||
Точного замера шрифта здесь нет — он требует холста, а холст оконного
|
||
набора. Поэтому ширины оцениваются приблизительно; для проверки самой
|
||
разметки этого хватает, а окно ставит точный замер. }
|
||
procedure CmdSubs;
|
||
var
|
||
Proj: TProject;
|
||
Err, Text: string;
|
||
begin
|
||
Proj := TProject.Create;
|
||
try
|
||
if not Proj.LoadFromFile(ExpandFileName(ParamStr(2)), Err) then
|
||
begin
|
||
WriteLn('Не удалось прочитать проект: ', Err);
|
||
Halt(1);
|
||
end;
|
||
Text := BuildAss(Proj);
|
||
if Text = '' then
|
||
begin
|
||
WriteLn('Текстовых клипов в проекте нет.');
|
||
Halt(1);
|
||
end;
|
||
Write(Text);
|
||
finally
|
||
Proj.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure CmdPreview;
|
||
var
|
||
Proj: TProject;
|
||
Segs, AudioSegs: TFlatSegmentArray;
|
||
Missing: TGenRequests;
|
||
Err: string;
|
||
I: Integer;
|
||
At: Double;
|
||
Gen: TGenerateThread;
|
||
GenWatch: TGenWatcher;
|
||
Kind: string;
|
||
begin
|
||
Proj := TProject.Create;
|
||
try
|
||
if not Proj.LoadFromFile(ExpandFileName(ParamStr(2)), Err) then
|
||
begin
|
||
WriteLn('Не удалось прочитать проект: ', Err);
|
||
Halt(1);
|
||
end;
|
||
|
||
if not FlattenProject(Proj, Segs, AudioSegs, Missing) then
|
||
begin
|
||
WriteLn('Уплотить нечего.');
|
||
Halt(1);
|
||
end;
|
||
|
||
ResolveLayers(Proj, Segs, Missing);
|
||
|
||
if Length(Missing) > 0 then
|
||
begin
|
||
WriteLn('Не хватает вставок: ', Length(Missing), '. Делаю.');
|
||
Gen := TGenerateThread.Create(Missing, Proj.Master);
|
||
GenWatch := TGenWatcher.Create(Gen);
|
||
try
|
||
Gen.OnProgress := @GenWatch.Progress;
|
||
Gen.OnLog := @GenWatch.LogLine;
|
||
Gen.Start;
|
||
while not Gen.Finished do
|
||
CheckSynchronize(100);
|
||
CheckSynchronize(0);
|
||
if not Gen.Succeeded then
|
||
begin
|
||
WriteLn('Не вышло: ', Gen.Message);
|
||
Halt(1);
|
||
end;
|
||
finally
|
||
GenWatch.Free;
|
||
Gen.Free;
|
||
end;
|
||
|
||
{ Второй заход: теперь файлы на месте и должны подставиться. }
|
||
Missing := nil;
|
||
ResolveLayers(Proj, Segs, Missing);
|
||
if Length(Missing) > 0 then
|
||
begin
|
||
WriteLn('Часть наложений так и не появилась.');
|
||
Halt(1);
|
||
end;
|
||
end;
|
||
|
||
At := 0;
|
||
for I := 0 to High(Segs) do
|
||
begin
|
||
if Length(Segs[I].Layers) > 0 then
|
||
Kind := 'НАЛОЖЕНИЕ (плеер не покажет)'
|
||
else if Segs[I].Kind = skBlack then
|
||
Kind := 'чёрное'
|
||
else
|
||
Kind := 'кусок ';
|
||
WriteLn(Format(' [%2d] %s монтаж %8s..%8s из %8s %s',
|
||
[I, Kind, SecondsToStr(At), SecondsToStr(At + Segs[I].Duration),
|
||
SecondsToStr(Segs[I].SrcStart), ExtractFileName(Segs[I].FilePath)]));
|
||
At := At + Segs[I].Duration;
|
||
end;
|
||
WriteLn;
|
||
WriteLn(BuildEdlUri(Segs));
|
||
finally
|
||
Proj.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure CmdRender;
|
||
var
|
||
Proj: TProject;
|
||
Segs, AudioSegs: TFlatSegmentArray;
|
||
Missing: TGenRequests;
|
||
Err: string;
|
||
Gen: TGenerateThread;
|
||
GenWatch: TGenWatcher;
|
||
Thread: TExportThread;
|
||
Watcher: TExportWatcher;
|
||
Rep: TExportReport;
|
||
I: Integer;
|
||
Ok: Boolean;
|
||
begin
|
||
Proj := TProject.Create;
|
||
try
|
||
if not Proj.LoadFromFile(ExpandFileName(ParamStr(2)), Err) then
|
||
begin
|
||
WriteLn('Не удалось прочитать проект: ', Err);
|
||
Halt(1);
|
||
end;
|
||
WriteLn('проект: ', Proj.FileName);
|
||
WriteLn('дорожек: ', Proj.TrackCount);
|
||
WriteLn('файлов: ', Proj.PoolCount);
|
||
WriteLn('длина: ', SecondsToStr(Proj.EndTime), ' с');
|
||
WriteLn;
|
||
|
||
if not FlattenProject(Proj, Segs, AudioSegs, Missing) then
|
||
begin
|
||
WriteLn('Уплотить нечего.');
|
||
Halt(1);
|
||
end;
|
||
|
||
WriteLn('кусков после уплощения: ', Length(Segs));
|
||
DumpSegments(Segs);
|
||
WriteLn('надо создать вставок: ', Length(Missing));
|
||
WriteLn;
|
||
|
||
if Length(Missing) > 0 then
|
||
begin
|
||
Gen := TGenerateThread.Create(Missing, Proj.Master);
|
||
GenWatch := TGenWatcher.Create(Gen);
|
||
try
|
||
Gen.OnProgress := @GenWatch.Progress;
|
||
Gen.OnLog := @GenWatch.LogLine;
|
||
Gen.Start;
|
||
while not Gen.Finished do
|
||
CheckSynchronize(100);
|
||
CheckSynchronize(0);
|
||
Ok := Gen.Succeeded;
|
||
Err := Gen.Message;
|
||
finally
|
||
GenWatch.Free;
|
||
Gen.Free;
|
||
end;
|
||
if not Ok then
|
||
begin
|
||
WriteLn('Не удалось создать вставки: ', Err);
|
||
Halt(1);
|
||
end;
|
||
WriteLn('вставки созданы.');
|
||
WriteLn;
|
||
|
||
{ После создания уплощаем заново: теперь все файлы на месте. }
|
||
FlattenProject(Proj, Segs, AudioSegs, Missing);
|
||
if Length(Missing) > 0 then
|
||
begin
|
||
WriteLn('Часть вставок так и не появилась.');
|
||
Halt(1);
|
||
end;
|
||
end;
|
||
|
||
{ Вжигание текста — последним, уже по окончательному списку кусков:
|
||
повторное уплощение стёрло бы отметки о разметке. Так же устроено и
|
||
окно сборки. }
|
||
if (ParamCount >= 4) and (LowerCase(ParamStr(4)) = 'burn') then
|
||
WriteLn('вжигаю текст, пересобрать придётся ',
|
||
SecondsToStr(BurnTextIntoSegments(Proj, Segs, Proj.CacheDir)), ' с');
|
||
|
||
Thread := TExportThread.Create(Segs, AudioSegs,
|
||
ExpandFileName(ParamStr(3)), True, Proj.Master, Default(TEncodeProfile));
|
||
Watcher := TExportWatcher.Create(Thread);
|
||
try
|
||
Thread.OnProgress := @Watcher.Progress;
|
||
Thread.OnLog := @Watcher.LogLine;
|
||
Thread.Start;
|
||
while not Thread.Finished do
|
||
CheckSynchronize(100);
|
||
CheckSynchronize(0);
|
||
Rep := Thread.Report;
|
||
finally
|
||
Watcher.Free;
|
||
Thread.Free;
|
||
end;
|
||
finally
|
||
Proj.Free;
|
||
end;
|
||
|
||
WriteLn;
|
||
WriteLn('--- Отчёт ---');
|
||
for I := 0 to High(Rep.Segments) do
|
||
WriteLn(Format(' часть %d (из куска %d)%s: старт %s, длина %s, пакетов %d',
|
||
[I + 1, Rep.Segments[I].Index + 1,
|
||
IfThen(Rep.Segments[I].Encoded, ' ПЕРЕКОДИРОВАНА', ''),
|
||
SecondsToStr(Rep.Segments[I].ActualStart),
|
||
SecondsToStr(Rep.Segments[I].Duration), Rep.Segments[I].Packets]));
|
||
WriteLn(' сумма пакетов кусков: ', Rep.ExpectedPackets);
|
||
WriteLn(' пакетов в готовом файле: ', Rep.ActualPackets);
|
||
WriteLn(' результат: ', Rep.Message);
|
||
|
||
if not Rep.Succeeded then
|
||
Halt(1);
|
||
if Rep.ExpectedPackets <> Rep.ActualPackets then
|
||
begin
|
||
WriteLn(' ВЕРДИКТ: РАСХОЖДЕНИЕ на ',
|
||
Rep.ActualPackets - Rep.ExpectedPackets, ' кадров');
|
||
Halt(1);
|
||
end;
|
||
WriteLn(' ВЕРДИКТ: склейка не потеряла и не продублировала ни одного кадра');
|
||
end;
|
||
|
||
var
|
||
Cmd: string;
|
||
begin
|
||
if ParamCount < 1 then
|
||
begin
|
||
PrintUsage;
|
||
Halt(2);
|
||
end;
|
||
|
||
Cmd := LowerCase(ParamStr(1));
|
||
|
||
if (Cmd = 'kf') and (ParamCount >= 2) then
|
||
CmdKf(ParamStr(2), False)
|
||
else if (Cmd = 'kfcheck') and (ParamCount >= 2) then
|
||
CmdKfCheck(ParamStr(2))
|
||
else if (Cmd = 'edl') and (ParamCount >= 4) then
|
||
CmdEdl
|
||
else if (Cmd = 'export') and (ParamCount >= 5) then
|
||
CmdExport
|
||
else if (Cmd = 'remux') and (ParamCount >= 3) then
|
||
CmdRemux
|
||
else if Cmd = 'flattest' then
|
||
CmdFlatTest
|
||
else if (Cmd = 'build') and (ParamCount >= 3) then
|
||
CmdBuild
|
||
else if (Cmd = 'keytest') and (ParamCount >= 4) then
|
||
CmdKeyTest
|
||
else if (Cmd = 'buildcut') and (ParamCount >= 3) then
|
||
CmdBuildCut
|
||
else if (Cmd = 'subs') and (ParamCount >= 2) then
|
||
CmdSubs
|
||
else if (Cmd = 'preview') and (ParamCount >= 2) then
|
||
CmdPreview
|
||
else if (Cmd = 'audio') and (ParamCount >= 2) then
|
||
CmdAudio
|
||
else if (Cmd = 'render') and (ParamCount >= 3) then
|
||
CmdRender
|
||
else
|
||
begin
|
||
PrintUsage;
|
||
Halt(2);
|
||
end;
|
||
end.
|