diff --git a/src/uExport.pas b/src/uExport.pas index c71fc69..67632e1 100644 --- a/src/uExport.pas +++ b/src/uExport.pas @@ -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 diff --git a/src/uFfmpegCmd.pas b/src/uFfmpegCmd.pas index 13f4357..fc5151c 100644 --- a/src/uFfmpegCmd.pas +++ b/src/uFfmpegCmd.pas @@ -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; diff --git a/src/uFlatten.pas b/src/uFlatten.pas index f7ad5ea..a017360 100644 --- a/src/uFlatten.pas +++ b/src/uFlatten.pas @@ -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. diff --git a/src/uMainForm.pas b/src/uMainForm.pas index 69dae88..87076a0 100644 --- a/src/uMainForm.pas +++ b/src/uMainForm.pas @@ -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; diff --git a/src/uMpvPlayer.pas b/src/uMpvPlayer.pas index 67f9495..2545eea 100644 --- a/src/uMpvPlayer.pas +++ b/src/uMpvPlayer.pas @@ -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 diff --git a/src/uProject.pas b/src/uProject.pas index 9040149..e14f3cb 100644 --- a/src/uProject.pas +++ b/src/uProject.pas @@ -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 diff --git a/tests/nlvetool.lpr b/tests/nlvetool.lpr index 28d0f5e..03ea9c4 100644 --- a/tests/nlvetool.lpr +++ b/tests/nlvetool.lpr @@ -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;