4aiman/nlve
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Этапы 3 и 4: звук отдельно от картинки

Browse source 
У дорожки появился вид — картинка или звук, у клипа принадлежность к
связке. Проект заводит две дорожки картинки и две звука; при добавлении
файла со звуком клип кладётся парой, связанной общим номером.

Уплощение теперь делается двумя проходами: отдельно для картинки,
отдельно для звука. Одним проходом такое не выразить — в один и тот же
момент картинка берётся с одной дорожки, а звук с другой.

Сборка соответственно тоже раздваивается. Картинка собирается прежним
способом, копированием. Звук собирается в сырой поток и сжимается одним
проходом: куски дописываются друг за другом байтами, и длина каждого
считается из длительности, а не берётся у ffmpeg. Поэтому стык получается
с точностью до отсчёта, а не до звукового кадра, и звук не уезжает от
картинки. Тишина в дырах пишется нулями, без запуска ffmpeg вовсе.

Готовые потоки сшиваются копированием.

Предпросмотр получает второй список кусков как внешнюю звуковую дорожку.

Проекты, записанные раньше, переносятся при чтении: звук там шёл вместе с
клипом картинки и без пары просто пропал бы.

Проверено сборкой:
- картинка из молчащего синего файла 0..6 с, звук из другого файла с 2 по
  6 с. В результате тишина первые две секунды и тон дальше — звук встал
  туда, куда положен, а не туда, где картинка;
- обычный парный случай: клип с 2 по 6 с, тишина до него и тон в нём;
- проверки уплощения пройдены.
This commit is contained in:
chaiman 2026-08-20 09:50:03 +03:00
commit a06ecfd720
7 changed files with 547 additions and 38 deletions
Download patch file Download diff file Expand all files Collapse all files

174
src/uExport.pas
View file

@ -87,6 +87,12 @@ type
TExportThread = class(TThread)
private
FSegments: TFlatSegmentArray;
{ Куски звука. Отдельный список: звук можно двигать независимо от
картинки, и точки реза у них разные. }
FAudio: TFlatSegmentArray;
{ Собранная звуковая дорожка и картинка без звука. }
FAudioPath: string;
FVideoPath: string;
FOutputPath: string;
FCacheDir: string;
FKeepIntermediate: Boolean;
@ -134,13 +140,18 @@ type
function WriteConcatList(out AListPath: string): Boolean;
function ConcatAll(const AListPath: string): Boolean;
procedure Verify;
{ Сборка звука: куски сводятся в сырой поток и сжимаются одним
проходом. Сырой поток нужен для точности — стык получается с
точностью до отсчёта, а не до звукового кадра. }
function BuildAudio: Boolean;
function MuxFinal: Boolean;
protected
procedure Execute; override;
public
{ AMaster нужен, чтобы понять, влезут ли кодеки проекта в MPEG-TS.
Можно передать пустую запись — тогда способ склейки выберется
по одному лишь числу источников. }
constructor Create(const ASegments: TFlatSegmentArray;
constructor Create(const ASegments, AAudio: TFlatSegmentArray;
const AOutputPath: string; AKeepIntermediate: Boolean;
const AMaster: TMediaInfo);
@ -162,7 +173,7 @@ function CacheDirFor(const AOutputPath: string): string;
implementation
uses
Math, uFfmpegCmd, uProcRunner;
Math, FileUtil, uFfmpegCmd, uProcRunner;
function CacheDirFor(const AOutputPath: string): string;
begin
@ -171,7 +182,7 @@ begin
PathDelim;
end;
constructor TExportThread.Create(const ASegments: TFlatSegmentArray;
constructor TExportThread.Create(const ASegments, AAudio: TFlatSegmentArray;
const AOutputPath: string; AKeepIntermediate: Boolean;
const AMaster: TMediaInfo);
var
@ -195,6 +206,14 @@ begin
FSegments[I].FilePath := ExpandFileName(FSegments[I].FilePath);
end;
SetLength(FAudio, Length(AAudio));
for I := 0 to High(AAudio) do
begin
FAudio[I] := AAudio[I];
if FAudio[I].FilePath <> '' then
FAudio[I].FilePath := ExpandFileName(FAudio[I].FilePath);
end;
FOutputPath := ExpandFileName(AOutputPath);
FCacheDir := CacheDirFor(FOutputPath);
FKeepIntermediate := AKeepIntermediate;
@ -634,7 +653,7 @@ function TExportThread.ConcatAll(const AListPath: string): Boolean;
begin
SetStage('Склеиваю');
FStepWork := FReport.TotalDuration;
Result := RunFfmpeg(ArgsConcat(AListPath, FOutputPath), 'Склейка');
Result := RunFfmpeg(ArgsConcat(AListPath, FVideoPath), 'Склейка');
end;
procedure TExportThread.Verify;
@ -658,6 +677,132 @@ begin
FReport.ActualPackets := Actual;
end;
{ --- Звук --- }
function TExportThread.BuildAudio: Boolean;
var
RawPath, PartPath: string;
All, Part: TFileStream;
I: Integer;
Need: Int64;
Zero: array[0..65535] of Byte;
Res: TProcResult;
Chunk: Int64;
Rate, Channels: Integer;
begin
Result := False;
FAudioPath := '';
if Length(FAudio) = 0 then
Exit;
Rate := FMaster.SampleRate;
if Rate <= 0 then
Rate := 48000;
Channels := FMaster.Channels;
if Channels <= 0 then
Channels := 2;
RawPath := FCacheDir + 'audio.raw';
PartPath := FCacheDir + 'audio_part.raw';
FillChar(Zero, SizeOf(Zero), 0);
SetStage('Собираю звук');
try
All := TFileStream.Create(RawPath, fmCreate);
try
for I := 0 to High(FAudio) do
begin
if Terminated then
Exit;
{ Сколько байт должен занять кусок. Считается из длительности, а
не берётся у ffmpeg: тогда длина всей дорожки совпадает с
монтажом до отсчёта, и звук не уезжает от картинки. }
Need := Round(FAudio[I].Duration * Rate) * Channels * 2;
if FAudio[I].FilePath <> '' then
begin
Res := RunProcess(FfmpegExe,
ArgsExtractAudioRaw(FAudio[I].FilePath, PartPath,
FAudio[I].SrcStart, FAudio[I].Duration, Rate, Channels,
FAudio[I].Volume),
nil, @ErrorLine, @CancelQuery);
if Res.Cancelled then
Exit;
if Res.Started and (Res.ExitCode = 0) and FileExists(PartPath) then
begin
Part := TFileStream.Create(PartPath, fmOpenRead or fmShareDenyNone);
try
Chunk := Part.Size;
if Chunk > Need then
Chunk := Need;
if Chunk > 0 then
All.CopyFrom(Part, Chunk);
Dec(Need, Chunk);
finally
Part.Free;
end;
SysUtils.DeleteFile(PartPath);
end;
end;
{ Чего не хватило — дополняем тишиной. Так же заполняются дыры и
куски файлов без звука. }
while Need > 0 do
begin
Chunk := SizeOf(Zero);
if Chunk > Need then
Chunk := Need;
All.WriteBuffer(Zero, Chunk);
Dec(Need, Chunk);
end;
{ Учёт работы: секунда звука весит столько же, сколько секунда
картинки на вырезании. }
FDoneWork := FDoneWork + FAudio[I].Duration;
PublishProgress;
end;
finally
All.Free;
end;
SetStage('Сжимаю звук');
FAudioPath := FCacheDir + 'audio.m4a';
Res := RunProcess(FfmpegExe,
ArgsEncodeAudio(RawPath, FAudioPath, Rate, Channels, FMaster.AudioCodec),
@ProgressLine, @ErrorLine, @CancelQuery);
if Res.Cancelled then
Exit;
if (not Res.Started) or (Res.ExitCode <> 0) or (not FileExists(FAudioPath)) then
begin
FReport.Message := 'Не удалось сжать звук.';
Exit;
end;
Result := True;
finally
SysUtils.DeleteFile(RawPath);
SysUtils.DeleteFile(PartPath);
end;
end;
function TExportThread.MuxFinal: Boolean;
var
Res: TProcResult;
begin
SetStage('Сшиваю');
Res := RunProcess(FfmpegExe,
ArgsMux(FVideoPath, FAudioPath, FOutputPath),
@ProgressLine, @ErrorLine, @CancelQuery);
Result := Res.Started and (Res.ExitCode = 0) and FileExists(FOutputPath);
if Res.Cancelled then
Result := False
else if not Result then
FReport.Message := 'Не удалось сшить картинку со звуком.';
end;
procedure TExportThread.Execute;
var
ListPath: string;
@ -690,17 +835,34 @@ begin
ChooseIntermediateFormat;
{ Единица учёта работы — секунда материала. Каждая секунда проходит
через вырезание и через склейку, отсюда двойной вес. }
FTotalWork := FReport.TotalDuration * 2;
через вырезание, склейку и сборку звука, отсюда тройной вес. }
FTotalWork := FReport.TotalDuration * 3;
FDoneWork := 0;
if not ExtractSegments then
Exit;
if not WriteConcatList(ListPath) then
Exit;
{ Картинка собирается в отдельный файл, а не сразу в конечный: звук у
неё свой, из исходников, и он почти наверняка не тот, что нужен.
Настоящий звук собирается отдельно и подставляется при сшивании. }
FVideoPath := FCacheDir + 'video' + ExtractFileExt(FOutputPath);
if not ConcatAll(ListPath) then
Exit;
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
Exit;
Verify;
if not FileExists(FOutputPath) then

61
src/uFfmpegCmd.pas
View file

@ -110,6 +110,21 @@ function TsSupportsCodecs(const AVideoCodec, AAudioCodec: string): Boolean;
function ArgsConcat(const AListFile, ADst: string): TArgs;
{ Перепаковать файл в другой контейнер без перекодирования. }
{ Звук куска в сыром виде: 16 бит со знаком, частота и число каналов
проекта. Сырой поток нужен потому, что куски потом просто дописываются
друг за другом байтами — так стык получается с точностью до отсчёта, а
не до звукового кадра. }
function ArgsExtractAudioRaw(const ASource, ATarget: string;
const AStart, ADuration: Double; ARate, AChannels: Integer;
const AVolume: Double): TArgs;
{ Сжатие собранного сырого звука. Один проход на весь ролик. }
function ArgsEncodeAudio(const ASource, ATarget: string;
ARate, AChannels: Integer; const ACodec: string): TArgs;
{ Сшивание готовой картинки с готовым звуком. Оба потока копируются. }
function ArgsMux(const AVideo, AAudio, ATarget: string): TArgs;
function ArgsRemux(const ASrc, ADst: string): TArgs;
{ Сведения о файле в JSON. }
@ -183,6 +198,52 @@ uses
{ Общие параметры вывода в формате проекта. Объявлено заранее, потому что
используется выше по тексту, чем определено. }
function ArgsExtractAudioRaw(const ASource, ATarget: string;
const AStart, ADuration: Double; ARate, AChannels: Integer;
const AVolume: Double): TArgs;
var
Filter: string;
begin
Result := ['-hide_banner', '-nostdin', '-loglevel', 'error', '-y',
'-ss', SecondsToStr(AStart), '-t', SecondsToStr(ADuration),
'-i', ASource, '-vn', '-map', '0:a:0?'];
{ Громкость применяется здесь же: звук всё равно перекодируется, второго
прохода ради неё не нужно. }
if Abs(AVolume - 1) > 0.001 then
begin
Filter := 'volume=' + SecondsToStr(AVolume);
Result := Concat(Result, ['-af', Filter]);
end;
Result := Concat(Result,
['-ac', IntToStr(AChannels), '-ar', IntToStr(ARate),
'-f', 's16le', ATarget]);
end;
function ArgsEncodeAudio(const ASource, ATarget: string;
ARate, AChannels: Integer; const ACodec: string): TArgs;
var
Codec: string;
begin
Codec := ACodec;
if Codec = '' then
Codec := 'aac';
Result := ['-hide_banner', '-nostdin', '-loglevel', 'error', '-y',
'-f', 's16le', '-ar', IntToStr(ARate), '-ac', IntToStr(AChannels),
'-i', ASource, '-c:a', Codec, '-b:a', '192k',
'-progress', 'pipe:1', '-nostats', ATarget];
end;
function ArgsMux(const AVideo, AAudio, ATarget: string): TArgs;
begin
Result := ['-hide_banner', '-nostdin', '-loglevel', 'warning', '-y',
'-i', AVideo, '-i', AAudio,
'-map', '0:v:0', '-map', '1:a:0', '-c', 'copy',
'-avoid_negative_ts', 'make_zero',
'-progress', 'pipe:1', '-nostats', ATarget];
end;
function MasterOutputArgs(AWidth, AHeight, AFpsNum, AFpsDen: Integer;
const AVideoCodec, APixFmt, AAudioCodec: string;
ASampleRate, AChannels: Integer): TArgs; forward;

47
src/uFlatten.pas
View file

@ -55,7 +55,21 @@ type
У кусков, требующих генерации, FilePath указывает на будущий файл в кэше;
сам файл может ещё не существовать. Список того, что надо создать,
возвращается в AMissing. }
function FlattenProject(AProject: TProject; out ASegments: TFlatSegmentArray;
{ Уплощение одного потока: либо картинки, либо звука.
Проходов два, потому что звук можно двигать отдельно от картинки: в один
и тот же момент картинка берётся с одной дорожки, а звук с другой. При
одном общем проходе такое не выразить.
Дорожки другого вида в проходе не участвуют вовсе — ни как источники,
ни как границы кусков. }
function FlattenStream(AProject: TProject; AKind: TTrackKind;
out ASegments: TFlatSegmentArray; out AMissing: TGenRequests): Boolean;
{ Оба потока разом. Список того, что надо создать, общий: чёрные вставки
годятся и картинке, и звуку — в них есть и то, и другое. }
function FlattenProject(AProject: TProject;
out AVideo, AAudio: TFlatSegmentArray;
out AMissing: TGenRequests): Boolean;
{ Путь к сгенерированному клипу. Имя выводится из содержимого запроса,
@ -189,8 +203,8 @@ begin
end;
end;
function FlattenProject(AProject: TProject; out ASegments: TFlatSegmentArray;
out AMissing: TGenRequests): Boolean;
function FlattenStream(AProject: TProject; AKind: TTrackKind;
out ASegments: TFlatSegmentArray; out AMissing: TGenRequests): Boolean;
var
Bounds: array of Double;
BoundCount: Integer;
@ -215,6 +229,8 @@ var
Result := nil;
for Ti := 0 to AProject.TrackCount - 1 do
begin
if AProject.Tracks[Ti].Kind <> AKind then
Continue;
{ Выключенные дорожки пропускаются, а если где-то включено «соло» —
то и все несолирующие. }
if not AProject.TrackAudible(AProject.Tracks[Ti]) then
@ -243,6 +259,8 @@ begin
for T := 0 to AProject.TrackCount - 1 do
begin
Track := AProject.Tracks[T];
if Track.Kind <> AKind then
Continue;
if not AProject.TrackAudible(Track) then
Continue;
for C := 0 to Track.Count - 1 do
@ -423,4 +441,27 @@ begin
Result := True;
end;
function FlattenProject(AProject: TProject;
out AVideo, AAudio: TFlatSegmentArray;
out AMissing: TGenRequests): Boolean;
var
MissA: TGenRequests;
I: Integer;
begin
AAudio := nil;
MissA := nil;
Result := FlattenStream(AProject, tkVideo, AVideo, AMissing);
if not Result then
Exit;
{ Звук уплощается всегда, даже если звуковых дорожек нет: тогда выйдет
один кусок тишины на всю длину, и это правильный ответ. }
FlattenStream(AProject, tkAudio, AAudio, MissA);
for I := 0 to High(MissA) do
begin
SetLength(AMissing, Length(AMissing) + 1);
AMissing[High(AMissing)] := MissA[I];
end;
end;
end.

35
src/uMainForm.pas
View file

@ -78,6 +78,7 @@ type
FPreviewDirty: Boolean;
FUpdatingFromPlayer: Boolean;
FLastLoadedEdl: string;
FLastLoadedAudioEdl: string;
FLastHwdec: string;
FLogFilePath: string;
FLogFileStarted: Boolean;
@ -191,7 +192,7 @@ type
{ Заставляет предпросмотр показывать кадр проекта, а не кадр исходника. }
procedure ApplyPreviewFrame;
procedure RebuildPreview;
procedure LoadPreviewEdl(const ASegments: TFlatSegmentArray);
procedure LoadPreviewEdl(const ASegments, AAudio: TFlatSegmentArray);
procedure GenerateDone(Sender: TObject);
procedure GenerateProgress(Sender: TObject);
procedure GenerateLog(Sender: TObject);
@ -1292,7 +1293,7 @@ end;
procedure TMainForm.RebuildPreview;
var
Segments: TFlatSegmentArray;
Segments, AudioSegs: TFlatSegmentArray;
Missing: TGenRequests;
begin
if (FPlayer = nil) or (not FPlayer.Initialized) then
@ -1306,7 +1307,7 @@ begin
Exit;
end;
if not FlattenProject(FProject, Segments, Missing) then
if not FlattenProject(FProject, Segments, AudioSegs, Missing) then
begin
FPlayer.Stop;
FLastLoadedEdl := '';
@ -1326,12 +1327,12 @@ begin
Exit;
end;
LoadPreviewEdl(Segments);
LoadPreviewEdl(Segments, AudioSegs);
end;
procedure TMainForm.LoadPreviewEdl(const ASegments: TFlatSegmentArray);
procedure TMainForm.LoadPreviewEdl(const ASegments, AAudio: TFlatSegmentArray);
var
Edl: string;
Edl, AudioEdl: string;
Pos, Total: Double;
WasPaused: Boolean;
begin
@ -1342,11 +1343,19 @@ begin
ApplyPreviewFrame;
Edl := BuildEdlUri(ASegments);
{ Звук идёт отдельным списком кусков и подаётся плееру как внешняя
звуковая дорожка. Иначе картинку и звук из разных мест монтажа
одновременно не показать: у одного файла звук всегда свой.
Проверено замером: mpv принимает edl:// в качестве внешнего звука и
берёт его именно оттуда. }
AudioEdl := BuildEdlUri(AAudio);
{ Список кусков запоминаем всегда, даже если строка не изменилась:
громкость в неё не входит, а брать её потом неоткуда. }
FPreviewSegments := ASegments;
FPreviewSegments := AAudio;
FLastVolumeSent := -1;
if Edl = FLastLoadedEdl then
if (Edl = FLastLoadedEdl) and (AudioEdl = FLastLoadedAudioEdl) then
Exit;
Pos := FTimeline.Playhead;
@ -1360,9 +1369,12 @@ begin
{ Позиция и состояние паузы задаются прямо при загрузке, а не отдельной
перемоткой следом. Иначе mpv успевает начать с нуля, и на каждой
правке монтажа слышен и виден кусок не оттуда. }
{ Внешний звук назначается до загрузки: он часть того, что открывается. }
FPlayer.SetAudioSource(AudioEdl);
FPlayer.LoadUrl(Edl, Format('start=%s,pause=%s',
[SecondsToStr(Pos), BoolToStr(WasPaused, 'yes', 'no')]));
FLastLoadedEdl := Edl;
FLastLoadedAudioEdl := AudioEdl;
{ Пока плеер не доедет, его сообщения о позиции игнорируются — иначе
курсор на монтаже прыгнул бы в начало при каждой правке. }
@ -2320,12 +2332,12 @@ end;
procedure TMainForm.MenuExport(Sender: TObject);
var
Segments: TFlatSegmentArray;
Segments, AudioSegs: TFlatSegmentArray;
Missing: TGenRequests;
HasPrecise: Boolean;
T, C: Integer;
begin
if not FlattenProject(FProject, Segments, Missing) then
if not FlattenProject(FProject, Segments, AudioSegs, Missing) then
begin
ThemedMessageDlg('nlve', 'На монтаже нечего собирать.', mtInformation, [mbOK], 0);
Exit;
@ -2379,7 +2391,8 @@ begin
[Length(Segments), Plural(Length(Segments), 'кусок', 'куска', 'кусков'),
SecondsToStr(TotalDuration(Segments))]));
FExport := TExportThread.Create(Segments, SaveExportDialog.FileName, True, FProject.Master);
FExport := TExportThread.Create(Segments, AudioSegs,
SaveExportDialog.FileName, True, FProject.Master);
FExport.OnProgress := @ExportProgress;
FExport.OnLog := @ExportLog;
FExport.OnTerminate := @ExportDone;

20
src/uMpvPlayer.pas
View file

@ -57,6 +57,7 @@ type
FInitialized: Boolean;
FVideoFilter: string;
FHwdec: string;
FAudioSource: string;
{ Работаем ли под Wine. Там свои правила вывода картинки, и узнать об
этом надо до создания плеера. }
FUnderWine: Boolean;
@ -135,6 +136,13 @@ type
когда фильтр действительно нужен. }
procedure SetHwdec(const AMode: string);
{ Внешняя звуковая дорожка: список кусков звука, отдельный от
картинки. Нужен потому, что звук можно двигать отдельно, и у одного
файла звук всегда свой.
Пустая строка снимает внешний звук. }
procedure SetAudioSource(const AUrl: string);
function GetPropString(const AName: string): string;
function GetPropDouble(const AName: string; out AValue: Double): Boolean;
@ -637,6 +645,18 @@ begin
mpv_set_property_string(FHandle, 'vf', PAnsiChar(Value));
end;
procedure TMpvPlayer.SetAudioSource(const AUrl: string);
begin
if FHandle = nil then
Exit;
if AUrl = FAudioSource then
Exit;
FAudioSource := AUrl;
{ Свойство действует на следующий loadfile, поэтому задавать его надо
до загрузки, а не после. }
mpv_set_property_string(FHandle, 'audio-files', PAnsiChar(AUrl));
end;
procedure TMpvPlayer.SetHwdec(const AMode: string);
begin
if FHandle = nil then

206
src/uProject.pas
View file

@ -34,7 +34,11 @@ type
кадра придётся перекодировать. }
TEdgeMode = (edSnap, edPrecise);
TClipKind = (ckVideo, ckImage, ckBlack);
{ ckAudio — звуковой клип: картинку из него не берут.
Отдельный вид, а не признак дорожки, потому что решение принимается по
клипу: сборка спрашивает у куска, что из него доставать. }
TClipKind = (ckVideo, ckImage, ckBlack, ckAudio);
{ На какие дорожки действует схлопывание.
@ -81,6 +85,7 @@ type
FSelected: Boolean;
FVolume: Double;
FTransform: TMediaTransform;
FGroupId: string;
public
constructor Create;
function TlEnd: Double;
@ -107,14 +112,24 @@ type
настройка, но она лишь заготовка — её берёт новый клип при
добавлении. }
property Transform: TMediaTransform read FTransform write FTransform;
{ Связка. Клипы с одинаковым непустым значением двигаются, режутся и
удаляются вместе. По умолчанию так связаны картинка и её звук;
Ctrl+G связывает и развязывает что угодно. }
property GroupId: string read FGroupId write FGroupId;
{ Выделение живёт только в памяти и в файл проекта не пишется. }
property Selected: Boolean read FSelected write FSelected;
end;
{ Что живёт на дорожке. Картинка и звук разделены, потому что их можно
двигать порознь: звук из одного места монтажа под картинкой из
другого — обычное дело. }
TTrackKind = (tkVideo, tkAudio);
TTrack = class
private
FId: string;
FName: string;
FKind: TTrackKind;
FMuted: Boolean;
FSolo: Boolean;
FClips: TObjectList;
@ -134,6 +149,7 @@ type
property Count: Integer read GetCount;
property Id: string read FId write FId;
property Name: string read FName write FName;
property Kind: TTrackKind read FKind write FKind;
property Muted: Boolean read FMuted write FMuted;
{ Когда хоть у одной дорожки включено «соло», в результат идут только
такие дорожки. Удобно, чтобы послушать одну, не выключая остальные
@ -177,6 +193,24 @@ type
procedure RemoveTrack(AIndex: Integer);
procedure MoveTrack(AFrom, ATo: Integer);
{ Сколько дорожек каждого вида и как найти парную.
Пара определяется порядковым номером: у первой дорожки картинки
первая дорожка звука. Так связка «картинка плюс её звук» ложится
напротив друг друга, и монтаж читается взглядом. }
function TrackCountOf(AKind: TTrackKind): Integer;
function TrackOfKind(AKind: TTrackKind; AIndex: Integer): TTrack;
function IndexAmongKind(ATrack: TTrack): Integer;
{ Заводит недостающие звуковые дорожки, чтобы у каждой дорожки
картинки была парная. }
procedure EnsureAudioTracks;
{ Перенос проектов, записанных до разделения звука и картинки: там
звук шёл вместе с клипом картинки, и без пары он бы просто пропал. }
procedure MigrateAudio;
{ Кладёт клип и, если в файле есть звук, парный звуковой клип на
соответствующую звуковую дорожку. Возвращает клип картинки. }
function AddClipPair(ATrack: TTrack; AMedia: TMediaItem;
const ASrcIn, ADuration, ATlStart: Double): TClip;
function AddClip(ATrack: TTrack; AMedia: TMediaItem;
const ASrcIn, ADuration, ATlStart: Double): TClip;
function FindClipTrack(AClip: TClip): TTrack;
@ -420,8 +454,12 @@ begin
Clear;
{ Две дорожки с самого начала: одна пустая дорожка не показывает главного —
что верхняя перекрывает нижнюю. }
{ Две дорожки картинки и две звука. Звук снизу: так принято везде, и
так он не мешает смотреть на картинку. }
AddTrack('V1');
AddTrack('V2');
AddTrack('A1').Kind := tkAudio;
AddTrack('A2').Kind := tkAudio;
FModified := False;
end;
@ -542,6 +580,150 @@ begin
FModified := True;
end;
function TProject.TrackCountOf(AKind: TTrackKind): Integer;
var
I: Integer;
begin
Result := 0;
for I := 0 to FTracks.Count - 1 do
if TTrack(FTracks[I]).Kind = AKind then
Inc(Result);
end;
function TProject.TrackOfKind(AKind: TTrackKind; AIndex: Integer): TTrack;
var
I, N: Integer;
begin
Result := nil;
N := 0;
for I := 0 to FTracks.Count - 1 do
if TTrack(FTracks[I]).Kind = AKind then
begin
if N = AIndex then
Exit(TTrack(FTracks[I]));
Inc(N);
end;
end;
function TProject.IndexAmongKind(ATrack: TTrack): Integer;
var
I, N: Integer;
begin
Result := -1;
N := 0;
for I := 0 to FTracks.Count - 1 do
if TTrack(FTracks[I]).Kind = ATrack.Kind then
begin
if TTrack(FTracks[I]) = ATrack then
Exit(N);
Inc(N);
end;
end;
procedure TProject.MigrateAudio;
var
T, C: Integer;
Track, Dst: TTrack;
Clip, Snd: TClip;
Item: TMediaItem;
Group: string;
Sources: TFPList;
begin
{ Если звуковые дорожки уже есть, проект новый и переносить нечего. }
if TrackCountOf(tkAudio) > 0 then
Exit;
if TrackCountOf(tkVideo) = 0 then
Exit;
EnsureAudioTracks;
{ Клипы собираются заранее: добавление в дорожку меняет её список, и
перебирать его на ходу нельзя. }
Sources := TFPList.Create;
try
for T := 0 to FTracks.Count - 1 do
begin
Track := TTrack(FTracks[T]);
if Track.Kind <> tkVideo then
Continue;
for C := 0 to Track.Count - 1 do
Sources.Add(Track[C]);
end;
for C := 0 to Sources.Count - 1 do
begin
Clip := TClip(Sources[C]);
if Clip.Kind = ckBlack then
Continue;
Item := FindMedia(Clip.MediaId);
if (Item = nil) or (not Item.Info.HasAudio) then
Continue;
Dst := nil;
for T := 0 to FTracks.Count - 1 do
if TTrack(FTracks[T]).IndexOf(Clip) >= 0 then
begin
Dst := TrackOfKind(tkAudio, IndexAmongKind(TTrack(FTracks[T])));
Break;
end;
if Dst = nil then
Continue;
Group := NewId('g');
Clip.GroupId := Group;
Snd := AddClip(Dst, Item, Clip.SrcIn, Clip.Duration, Clip.TlStart);
Snd.GroupId := Group;
Snd.Kind := ckAudio;
Snd.Volume := Clip.Volume;
end;
finally
Sources.Free;
end;
for T := 0 to FTracks.Count - 1 do
TTrack(FTracks[T]).Sort;
end;
procedure TProject.EnsureAudioTracks;
var
Need, Have, I: Integer;
Track: TTrack;
begin
Need := TrackCountOf(tkVideo);
Have := TrackCountOf(tkAudio);
for I := Have to Need - 1 do
begin
Track := AddTrack('A' + IntToStr(I + 1));
Track.Kind := tkAudio;
end;
end;
function TProject.AddClipPair(ATrack: TTrack; AMedia: TMediaItem;
const ASrcIn, ADuration, ATlStart: Double): TClip;
var
ATrackAudio: TTrack;
Snd: TClip;
Group: string;
begin
Result := AddClip(ATrack, AMedia, ASrcIn, ADuration, ATlStart);
if (ATrack.Kind <> tkVideo) or (not AMedia.Info.HasAudio) then
Exit;
EnsureAudioTracks;
ATrackAudio := TrackOfKind(tkAudio, IndexAmongKind(ATrack));
if ATrackAudio = nil then
Exit;
Group := NewId('g');
Result.GroupId := Group;
Snd := AddClip(ATrackAudio, AMedia, ASrcIn, ADuration, ATlStart);
Snd.GroupId := Group;
{ Клип звука знает, что он звук: иначе сборка попыталась бы взять из
него картинку. }
Snd.Kind := ckAudio;
Snd.Transform := DefaultTransform;
end;
function TProject.AddClip(ATrack: TTrack; AMedia: TMediaItem;
const ASrcIn, ADuration, ATlStart: Double): TClip;
begin
@ -797,6 +979,22 @@ begin
Result := edSnap;
end;
function TrackKindToStr(AKind: TTrackKind): string;
begin
if AKind = tkAudio then
Result := 'audio'
else
Result := 'video';
end;
function StrToTrackKind(const AValue: string): TTrackKind;
begin
if AValue = 'audio' then
Result := tkAudio
else
Result := tkVideo;
end;
function KindToStr(AKind: TClipKind): string;
begin
case AKind of
@ -933,6 +1131,7 @@ begin
Obj := TJSONObject.Create;
Obj.Add('id', Track.Id);
Obj.Add('name', Track.Name);
Obj.Add('kind', TrackKindToStr(Track.Kind));
Obj.Add('muted', Track.Muted);
Obj.Add('solo', Track.Solo);
@ -949,6 +1148,7 @@ begin
'edge_in', EdgeToStr(Clip.EdgeIn),
'edge_out', EdgeToStr(Clip.EdgeOut),
'kind', KindToStr(Clip.Kind),
'group', Clip.GroupId,
'volume', Clip.Volume,
'transform', TJSONObject.Create([
'fit', FitModeToStr(Clip.Transform.Fit),
@ -1036,6 +1236,7 @@ begin
Track := TTrack.Create;
Track.Id := TrackObj.Get('id', '');
Track.Name := TrackObj.Get('name', '');
Track.Kind := StrToTrackKind(TrackObj.Get('kind', 'video'));
Track.Muted := TrackObj.Get('muted', False);
Track.Solo := TrackObj.Get('solo', False);
FTracks.Add(Track);
@ -1057,6 +1258,7 @@ begin
Clip.EdgeOut := StrToEdge(ClipObj.Get('edge_out', 'snap'));
Clip.Kind := StrToKind(ClipObj.Get('kind', 'video'));
Clip.Volume := ClipObj.Get('volume', Double(1));
Clip.GroupId := ClipObj.Get('group', '');
{ Проекты, записанные до появления кадрирования у клипа,
берут его у файла — там оно и хранилось раньше. }
if ClipObj.Find('transform') <> nil then
@ -1073,6 +1275,8 @@ begin
Track.Sort;
end;
MigrateAudio;
Settings := Obj.Find('settings', jtObject) as TJSONObject;
if Settings <> nil then
begin

42
tests/nlvetool.lpr
View file

@ -306,7 +306,8 @@ begin
WriteLn('остановка через: ', SecondsToStr(CancelAfter), ' с');
WriteLn;
Thread := TExportThread.Create(Segments, ParamStr(FirstArg - 1), True,
{ Проверка вырезания и склейки картинки: звук здесь не собирается. }
Thread := TExportThread.Create(Segments, nil, ParamStr(FirstArg - 1), True,
Default(TMediaInfo));
Watcher := TExportWatcher.Create(Thread);
try
@ -563,7 +564,7 @@ begin
try
Proj.AddClip(Proj.Tracks[0], Media, 10, 5, 0);
Proj.AddClip(Proj.Tracks[0], Media, 15, 5, 5);
FlattenProject(Proj, Segs, Missing);
FlattenStream(Proj, tkVideo, Segs, Missing);
DumpSegments(Segs);
Check(Length(Segs) = 1, 'склеились в один кусок');
if Length(Segs) = 1 then
@ -582,7 +583,7 @@ begin
try
Proj.AddClip(Proj.Tracks[0], Media, 100, 5, 0);
Proj.AddClip(Proj.Tracks[0], Media, 200, 5, 5);
FlattenProject(Proj, Segs, Missing);
FlattenStream(Proj, tkVideo, Segs, Missing);
DumpSegments(Segs);
Check(Length(Segs) = 2, 'остались двумя кусками');
finally
@ -597,7 +598,7 @@ begin
{ Дорожка 0 — верхняя, она побеждает. }
Proj.AddClip(Proj.Tracks[1], Media, 0, 30, 0);
Proj.AddClip(Proj.Tracks[0], Media, 100, 10, 10);
FlattenProject(Proj, Segs, Missing);
FlattenStream(Proj, tkVideo, Segs, Missing);
DumpSegments(Segs);
Check(Length(Segs) = 3, 'получилось три куска');
if Length(Segs) = 3 then
@ -621,7 +622,7 @@ begin
try
Proj.AddClip(Proj.Tracks[0], Media, 0, 5, 3);
Proj.AddClip(Proj.Tracks[0], Media, 50, 5, 12);
FlattenProject(Proj, Segs, Missing);
FlattenStream(Proj, tkVideo, Segs, Missing);
DumpSegments(Segs);
Check(Length(Segs) = 4, 'четыре куска: чёрное, видео, чёрное, видео');
if Length(Segs) = 4 then
@ -651,7 +652,7 @@ begin
try
Proj.AddClip(Proj.Tracks[1], Media, 0, 10, 0);
Proj.AddClip(Proj.Tracks[0], Media, 200, 10, 0);
FlattenProject(Proj, Segs, Missing);
FlattenStream(Proj, tkVideo, Segs, Missing);
DumpSegments(Segs);
Check(Length(Segs) = 1, 'остался один кусок');
if Length(Segs) = 1 then
@ -668,7 +669,7 @@ begin
Proj.AddClip(Proj.Tracks[1], Media, 0, 10, 0);
Proj.AddClip(Proj.Tracks[0], Media, 200, 10, 0);
Proj.Tracks[0].Muted := True;
FlattenProject(Proj, Segs, Missing);
FlattenStream(Proj, tkVideo, Segs, Missing);
DumpSegments(Segs);
Check(Length(Segs) = 1, 'остался один кусок');
if Length(Segs) = 1 then
@ -688,7 +689,7 @@ begin
Proj.Tracks[0][0].EdgeIn := edPrecise;
Proj.RippleMode := rmAllTracks;
Proj.RippleEnabled := True;
FlattenProject(Proj, Segs, Missing);
FlattenStream(Proj, tkVideo, Segs, Missing);
Check(Length(Segs) = 3, 'до записи три куска');
Check(Proj.SaveToFile(TempFile, Err), 'записан: ' + Err);
finally
@ -698,13 +699,17 @@ begin
Proj := TProject.Create;
try
Check(Proj.LoadFromFile(TempFile, Err), 'прочитан: ' + Err);
Check(Proj.TrackCount = 2, 'дорожек снова две');
{ Четыре: две картинки и две звука. Звуковые заводятся сразу, чтобы
каждому клипу картинки было куда положить парный звук. }
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, 'признак точного реза сохранился');
FlattenProject(Proj, Segs, Missing);
FlattenStream(Proj, tkVideo, Segs, Missing);
DumpSegments(Segs);
Check(Length(Segs) = 3, 'после чтения снова три куска');
if Length(Segs) = 3 then
@ -739,6 +744,7 @@ begin
Proj.Clear;
Proj.AddTrack('V1');
Proj.AddTrack('V2');
Proj.EnsureAudioTracks;
if not ProbeMedia(ExpandFileName(ParamStr(3)), Info, Err) then
begin
@ -750,8 +756,10 @@ begin
{ Нижняя дорожка: два куска видео из разных мест, между ними дыра
в две секунды, и ещё дыра в начале. }
Proj.AddClip(Proj.Tracks[1], Video, 100, 6, 1.5);
Proj.AddClip(Proj.Tracks[1], Video, 400, 6, 9.5);
{ Парой: клип картинки и его звук на соответствующей звуковой
дорожке. Так собранный проект похож на настоящий. }
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
@ -853,7 +861,7 @@ end;
procedure CmdRender;
var
Proj: TProject;
Segs: TFlatSegmentArray;
Segs, AudioSegs: TFlatSegmentArray;
Missing: TGenRequests;
Err: string;
Gen: TGenerateThread;
@ -877,7 +885,7 @@ begin
WriteLn('длина: ', SecondsToStr(Proj.EndTime), ' с');
WriteLn;
if not FlattenProject(Proj, Segs, Missing) then
if not FlattenProject(Proj, Segs, AudioSegs, Missing) then
begin
WriteLn('Уплотить нечего.');
Halt(1);
@ -914,7 +922,7 @@ begin
WriteLn;
{ После создания уплощаем заново: теперь все файлы на месте. }
FlattenProject(Proj, Segs, Missing);
FlattenProject(Proj, Segs, AudioSegs, Missing);
if Length(Missing) > 0 then
begin
WriteLn('Часть вставок так и не появилась.');
@ -922,8 +930,8 @@ begin
end;
end;
Thread := TExportThread.Create(Segs, ExpandFileName(ParamStr(3)), True,
Proj.Master);
Thread := TExportThread.Create(Segs, AudioSegs,
ExpandFileName(ParamStr(3)), True, Proj.Master);
Watcher := TExportWatcher.Create(Thread);
try
Thread.OnProgress := @Watcher.Progress;