Ролик больше не хранится на диске дважды

Картинка собиралась в промежуточный файл, а потом сшивалась со звуком в
конечный. На часовом ролике это 91 ГБ в кэше плюс 91 ГБ рядом и лишний
полный проход копирования — ради того, чтобы приписать звуковую дорожку.

Теперь звук собирается раньше картинки, а склейка сразу кладёт всё вместе
в конечный файл. Тем же путём пошла и сборка с перекодированием.
Промежуточного файла нет вовсе, проход на один меньше.

Куски после удачной сборки удаляются, и в журнале сказано, сколько места
освободилось: на часовой съёмке их набирается больше сотни гигабайт, а
нужны они только чтобы продолжить прерванную сборку. После неудачной
сборки они остаются — с них и продолжают. Настройка keep_parts оставляет
их всегда.

README.md

@@ -413,6 +413,21 @@ Linux потом искала по нему `.dll`.
 со скопированными, и если он окажется хуже их, разница видна именно на
 нём. Лишнее место дешевле.
 
+## Место на диске
+
+Куски весят примерно столько же, сколько готовый ролик, а на длинном
+материале и больше: на часовой съёмке набралось 110 ГБ. Поэтому:
+
+- **картинка не собирается в промежуточный файл.** Звук собирается
+  раньше, и склейка сразу кладёт всё вместе в конечный файл. Раньше
+  получалось два полных ролика на диске одновременно — 91 ГБ в кэше и 91
+  ГБ рядом — и лишний проход копирования ради одной звуковой дорожки;
+- **после удачной сборки куски удаляются,** и в журнале сказано, сколько
+  места освободилось. После неудачной — остаются: с них продолжают.
+
+Оставить их можно настройкой `keep_parts` в файле настроек: пригодится,
+когда разбираешься, из чего собрался ролик.
+
 ## Прерванная сборка
 
 Каждый доведённый до конца кусок помечается в списке рядом с самими

src/uExport.pas

@@ -232,6 +232,32 @@ implementation
 uses
   Math, md5, FileUtil, uFfmpegCmd, uProcRunner;
 
+{ Размер файла или ноль, если его нет. }
+function FileSizeOf(const APath: string): Int64;
+var
+  F: TSearchRec;
+begin
+  Result := 0;
+  if APath = '' then
+    Exit;
+  if FindFirst(APath, faAnyFile, F) = 0 then
+  begin
+    Result := F.Size;
+    FindClose(F);
+  end;
+end;
+
+{ Размер по-человечески: гигабайты, если их много. }
+function SizeText(ABytes: Int64): string;
+begin
+  if ABytes >= Int64(1024) * 1024 * 1024 then
+    Result := Format('%.1f ГБ', [ABytes / (1024 * 1024 * 1024)])
+  else if ABytes >= 1024 * 1024 then
+    Result := Format('%.0f МБ', [ABytes / (1024 * 1024)])
+  else
+    Result := Format('%d КБ', [ABytes div 1024]);
+end;
+
 function CacheDirFor(const AOutputPath: string): string;
 begin
   Result := IncludeTrailingPathDelimiter(ExtractFilePath(AOutputPath)) +
@@ -930,9 +956,9 @@ begin
       куски по отдельности здесь нельзя, на стыках была бы видна смена
       качества. }
     SetStage('Склеиваю и перекодирую');
-    if RunFfmpeg(ArgsConcatEncode(AListPath, FVideoPath,
+    if RunFfmpeg(ArgsConcatEncode(AListPath, FOutputPath,
       FProfile.Width, FProfile.Height, FMaster.FpsNum, FMaster.FpsDen,
-      FProfile.BitrateKbps, FProfile.Codec, FMaster.PixFmt, True),
+      FProfile.BitrateKbps, FProfile.Codec, FMaster.PixFmt, True, FAudioPath),
       'Склейка с перекодированием') then
       Exit(True);
 
@@ -945,14 +971,15 @@ begin
       видеокарте кодек исходника. Отказываться из-за неё от сборки
       нельзя: медленно лучше, чем никак. }
     Log('Аппаратная распаковка не пошла, повторяю на процессоре.');
-    Exit(RunFfmpeg(ArgsConcatEncode(AListPath, FVideoPath,
+    Exit(RunFfmpeg(ArgsConcatEncode(AListPath, FOutputPath,
       FProfile.Width, FProfile.Height, FMaster.FpsNum, FMaster.FpsDen,
-      FProfile.BitrateKbps, FProfile.Codec, FMaster.PixFmt, False),
+      FProfile.BitrateKbps, FProfile.Codec, FMaster.PixFmt, False, FAudioPath),
       'Склейка с перекодированием без аппаратной распаковки'));
   end;
 
   SetStage('Склеиваю');
-  Result := RunFfmpeg(ArgsConcat(AListPath, FVideoPath), 'Склейка');
+  Result := RunFfmpeg(ArgsConcatMux(AListPath, FAudioPath, FSubtitlePath,
+    FOutputPath), 'Склейка');
 end;
 
 procedure TExportThread.Verify;
@@ -1204,6 +1231,7 @@ procedure TExportThread.Execute;
 var
   ListPath: string;
   I: Integer;
+  Freed: Int64;
   ToolError: string;
 begin
   try
@@ -1247,23 +1275,24 @@ begin
     if not WriteConcatList(ListPath) then
       Exit;
 
-    { Картинка собирается в отдельный файл, а не сразу в конечный: звук у
-      неё свой, из исходников, и он почти наверняка не тот, что нужен.
-      Настоящий звук собирается отдельно и подставляется при сшивании. }
-    FVideoPath := FCacheDir + 'video' + ExtractFileExt(FOutputPath);
-    if not ConcatAll(ListPath) then
-      Exit;
+    { Звук собирается раньше картинки, и склейка сразу кладёт всё вместе в
+      конечный файл.
 
+      Так было не всегда: сперва картинка собиралась в отдельный файл, а
+      потом сшивалась со звуком. На часовом ролике это 91 ГБ
+      промежуточного файла и лишний полный проход копирования — места
+      требовалось вдвое больше готового ролика. }
+    FVideoPath := '';
     if not BuildAudio then
     begin
       if FReport.Cancelled then
         Exit;
-      { Без звука ролик всё равно лучше, чем ничего: картинка уже собрана. }
-      Log('Звук собрать не удалось, оставляю картинку как есть.');
-      if not RenameFile(FVideoPath, FOutputPath) then
-        FileUtil.CopyFile(FVideoPath, FOutputPath);
-    end
-    else if not MuxFinal then
+      { Без звука ролик всё равно лучше, чем ничего. }
+      Log('Звук собрать не удалось, собираю картинку без него.');
+      FAudioPath := '';
+    end;
+
+    if not ConcatAll(ListPath) then
       Exit;
 
     Verify;
@@ -1277,18 +1306,38 @@ begin
     FReport.Succeeded := True;
     FReport.Message := 'Готово.';
 
+    { Уборка после удачной сборки.
+
+      Куски весят столько же, сколько готовый ролик, а на длинном
+      материале и больше: на часовой съёмке набралось 110 ГБ. Держать их
+      после того, как ролик собран, незачем — продолжать больше нечего.
+      После неудачи, наоборот, не трогаем: с них и продолжим.
+
+      Считаем освобождённое: цифра говорит человеку, сколько места было
+      занято, лучше любого объяснения. }
     if not FKeepIntermediate then
     begin
+      Freed := 0;
       for I := 0 to High(FReport.Segments) do
         { Удаляем только то, что сами создали в своём каталоге. Части,
           указывающие на общий кэш сгенерированных вставок, трогать нельзя:
           они нужны и предпросмотру, и следующей сборке. }
         if Copy(FReport.Segments[I].TempPath, 1, Length(FCacheDir)) = FCacheDir then
+        begin
+          Inc(Freed, FileSizeOf(FReport.Segments[I].TempPath));
           DeleteFile(FReport.Segments[I].TempPath);
+        end;
+
+      Inc(Freed, FileSizeOf(FAudioPath));
+      DeleteFile(FAudioPath);
       DeleteFile(ListPath);
+      DeleteFile(FCacheDir + 'готово.txt');
       RemoveDir(FCacheDir);
-      Log('Временные куски удалены.');
-    end;
+      Log(Format('Временные куски удалены, освободилось %s.',
+        [SizeText(Freed)]));
+    end
+    else
+      Log('Временные куски оставлены: ' + FCacheDir);
   except
     on E: Exception do
     begin

src/uFfmpegCmd.pas

@@ -115,6 +115,18 @@ function TsSupportsCodecs(const AVideoCodec, AAudioCodec: string): Boolean;
 { Склеить куски по списку. Формат вывода ffmpeg определит по расширению. }
 function ArgsConcat(const AListFile, ADst: string): TArgs;
 
+{ Склейка сразу с готовым звуком и разметкой — прямо в конечный файл.
+
+  Зачем. Раньше картинка сначала собиралась в отдельный файл, а потом
+  сшивалась со звуком в конечный. На часовом ролике это означало 91 ГБ
+  промежуточного файла и лишний полный проход копирования: места нужно
+  вдвое больше готового ролика, и всё это ради того, чтобы приписать
+  звуковую дорожку.
+
+  Звук собирается раньше картинки, и склейка сразу кладёт всё вместе куда
+  надо. Пусто в AAudio — значит звука нет, тогда это обычная склейка. }
+function ArgsConcatMux(const AListFile, AAudio, ASubFile, ADst: string): TArgs;
+
 { Склеить куски и сразу перекодировать картинку в заданный размер и поток.
 
   Нужно для сборки «под площадку»: когда ролик надо отдать в 1080p с
@@ -127,7 +139,8 @@ function ArgsConcat(const AListFile, ADst: string): TArgs;
   процессоре идёт медленнее реального времени, и смысл теряется. }
 function ArgsConcatEncode(const AListFile, ADst: string;
   AWidth, AHeight, AFpsNum, AFpsDen, ABitrateKbps: Integer;
-  const AVideoCodec, APixFmt: string; AHwDecode: Boolean = True): TArgs;
+  const AVideoCodec, APixFmt: string; AHwDecode: Boolean = True;
+  const AAudio: string = ''): TArgs;
 
 { Перепаковать файл в другой контейнер без перекодирования. }
 { Звук куска в сыром виде: 16 бит со знаком, частота и число каналов
@@ -709,7 +722,8 @@ end;
 
 function ArgsConcatEncode(const AListFile, ADst: string;
   AWidth, AHeight, AFpsNum, AFpsDen, ABitrateKbps: Integer;
-  const AVideoCodec, APixFmt: string; AHwDecode: Boolean): TArgs;
+  const AVideoCodec, APixFmt: string; AHwDecode: Boolean;
+  const AAudio: string): TArgs;
 var
   Fps, Enc: string;
 begin
@@ -730,13 +744,13 @@ begin
   if AHwDecode and (Pos('nvenc', Enc) > 0) then
     Result := Concat(Result, ['-hwaccel', 'cuda']);
 
-  Result := Concat(Result, [
-    '-f', 'concat',
-    '-safe', '0',
-    '-i', AListFile,
-    '-map', '0:v:0',
-    '-map', '0:a:0?'
-  ]);
+  Result := Concat(Result, ['-f', 'concat', '-safe', '0', '-i', AListFile]);
+  { Готовый звук подмешивается прямо здесь, чтобы не собирать картинку в
+    промежуточный файл ради одной звуковой дорожки. }
+  if AAudio <> '' then
+    Result := Concat(Result, ['-i', AAudio, '-map', '0:v:0', '-map', '1:a:0'])
+  else
+    Result := Concat(Result, ['-map', '0:v:0', '-map', '0:a:0?']);
 
   { Вписываем целиком и добиваем полями: соотношение сторон менять нельзя,
     иначе кадр растянется. }
@@ -789,6 +803,46 @@ begin
   Result := Concat(Result, [ADst]);
 end;
 
+function ArgsConcatMux(const AListFile, AAudio, ASubFile, ADst: string): TArgs;
+var
+  Next: Integer;
+begin
+  Result := Concat(CommonFfmpegPrefix, [
+    '-f', 'concat',
+    { Без -safe 0 демультиплексор откажется брать абсолютные пути. }
+    '-safe', '0',
+    '-i', AListFile
+  ]);
+
+  Next := 1;
+  if AAudio <> '' then
+    Result := Concat(Result, ['-i', AAudio]);
+  if ASubFile <> '' then
+    Result := Concat(Result, ['-i', ASubFile]);
+
+  Result := Concat(Result, ['-map', '0:v:0']);
+  if AAudio <> '' then
+  begin
+    Result := Concat(Result, ['-map', IntToStr(Next) + ':a:0']);
+    Inc(Next);
+  end
+  else
+    { Звука своего нет — берём тот, что пришёл с кусками, если он там есть. }
+    Result := Concat(Result, ['-map', '0:a:0?']);
+
+  if ASubFile <> '' then
+    Result := Concat(Result, ['-map', IntToStr(Next) + ':s:0', '-c:s', 'ass',
+      '-metadata:s:s:0', 'title=Надписи',
+      '-metadata:s:s:0', 'language=rus']);
+
+  Result := Concat(Result, ['-c:v', 'copy', '-c:a', 'copy',
+    '-avoid_negative_ts', 'make_zero']);
+  Result := Concat(Result, ProgressArgs);
+  if WantsFaststart(ADst) then
+    Result := Concat(Result, ['-movflags', '+faststart']);
+  Result := Concat(Result, [ADst]);
+end;
+
 function ArgsRemux(const ASrc, ADst: string): TArgs;
 begin
   Result := Concat(CommonFfmpegPrefix, [

src/uMainForm.pas

@@ -3905,8 +3905,11 @@ begin
        Extra]));
   end;
 
+  { Временные куски после удачной сборки убираются: они весят столько же,
+    сколько готовый ролик, а нужны только чтобы продолжить прерванную
+    сборку. После неудачи их никто не трогает. }
   FExport := TExportThread.Create(Segments, AudioSegs,
-    FExportChoice.Path, True, Master, AProfile);
+    FExportChoice.Path, FSettings.KeepParts, Master, AProfile);
   FExport.SubtitlePath := SubsPath;
   FExport.LogPath := FExportLogPath;
   FExport.Resume := AskResume(FExportChoice.Path);

src/uSettings.pas

@@ -39,6 +39,7 @@ type
     FPlayheadSnap: Boolean;
     FPreviewKey: Boolean;
     FCenterPlayhead: Boolean;
+    FKeepParts: Boolean;
     FDepsReminder: Boolean;
     FRecentProjects: TStringList;
     function FileName: string;
@@ -76,6 +77,10 @@ type
     property PreviewKey: Boolean read FPreviewKey write FPreviewKey;
     { Держать ли курсор посередине монтажа при воспроизведении. }
     property CenterPlayhead: Boolean read FCenterPlayhead write FCenterPlayhead;
+    { Оставлять ли временные куски после удачной сборки. По умолчанию нет:
+      они весят столько же, сколько готовый ролик, а нужны только чтобы
+      продолжить прерванную сборку. }
+    property KeepParts: Boolean read FKeepParts write FKeepParts;
     { Напоминать ли о недостающих зависимостях при запуске. Гасится
       кнопкой «Не напоминать» в самом напоминании. }
     property DepsReminder: Boolean read FDepsReminder write FDepsReminder;
@@ -111,6 +116,7 @@ begin
   FPlayheadSnap := True;
   FPreviewKey := True;
   FCenterPlayhead := True;
+  FKeepParts := False;
   FDepsReminder := True;
 end;
 
@@ -194,6 +200,7 @@ begin
     FPlayheadSnap := Obj.Get('playhead_snap', FPlayheadSnap);
     FPreviewKey := Obj.Get('preview_key', FPreviewKey);
     FCenterPlayhead := Obj.Get('center_playhead', FCenterPlayhead);
+    FKeepParts := Obj.Get('keep_parts', FKeepParts);
     FDepsReminder := Obj.Get('deps_reminder', FDepsReminder);
 
     Arr := Obj.Find('recent_projects', jtArray) as TJSONArray;
@@ -248,6 +255,7 @@ begin
     Root.Add('playhead_snap', FPlayheadSnap);
     Root.Add('preview_key', FPreviewKey);
     Root.Add('center_playhead', FCenterPlayhead);
+    Root.Add('keep_parts', FKeepParts);
     Root.Add('deps_reminder', FDepsReminder);
 
     Arr := TJSONArray.Create;

tests/nlvetool.lpr

@@ -1378,8 +1378,13 @@ begin
       WriteLn('вжигаю текст, пересобрать придётся ',
         SecondsToStr(BurnTextIntoSegments(Proj, Segs, Proj.CacheDir)), ' с');
 
+    { Куски после удачной сборки убираются — как и в самой программе.
+      Словом keep их можно оставить: пригодится, когда разбираешься, из
+      чего собрался ролик. }
     Thread := TExportThread.Create(Segs, AudioSegs,
-      ExpandFileName(ParamStr(3)), True, Proj.Master, Default(TEncodeProfile));
+      ExpandFileName(ParamStr(3)),
+      (ParamCount >= 4) and (LowerCase(ParamStr(4)) = 'keep'),
+      Proj.Master, Default(TEncodeProfile));
     { Словом resume просят продолжить прерванную сборку: готовые куски
       берутся с диска, а не считаются заново. }
     Thread.Resume := (ParamCount >= 4) and (LowerCase(ParamStr(4)) = 'resume');