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

Чёрные вставки стоят копейки, текст режет кусок

Browse source 
Дыра в сорок минут требовала двухчасового чёрного файла: лестница готовых
длин доходила до восьми часов, и NVENC кодировал такое минутами. Отсюда
«Делаю чёрную вставку 1 из 3», которое не кончается. Теперь длины две, 15
и 60 секунд, длинная дыра набирается повторами минутного файла, а само
чёрное кодируется мегабитом вместо полусотни.

Промежуток короче половины кадра дырой больше не считается: между
клипами, сдвинутыми встык мышью, оставались микросекунды. Мышь при этом
кладёт клипы на кадровую сетку — между кадрами времени не существует.

Правка монтажа прекращает генерацию, ставшую ненужной: раньше закрытая
дыра не отменяла уже начатую работу.

Ctrl+Shift+R работает без мыши: дыра ищется на активной дорожке, если
указатель не над дорожками, и команда отвечает в строке состояния, а не
молчит.

Вжигание текста режет кусок на части и пересобирает только середину.
Надпись в тридцать секунд внутри сорокаминутного куска стоила сорока
минут пересборки. Часть после надписи помечается точным резом, иначе
копия пошла бы от опорного кадра и картинка сдвинулась бы.

Проверки: flattest 13 и 14, схлопывание без мыши в lfmcheck, сборка с
надписью внутри длинного куска — 1.000000 с пересборки вместо 6.
This commit is contained in:
4aiman 2026-09-11 19:35:26 +03:00
commit 939184fce7
9 changed files with 500 additions and 32 deletions
Download patch file Download diff file Expand all files Collapse all files

34
README.md
View file

@ -398,6 +398,21 @@ Linux потом искала по нему `.dll`.
каждого слоя считается на каждый отсчёт, и длина результата получается
ровно такой, какая нужна.
## Текст режет кусок, а не пересобирает его целиком
Вжигание надписи не делает весь кусок пересобираемым. Кусок режется на
части: до надписи, под надписью и после. Пересобирается только середина,
остальное копируется. Надпись в тридцать секунд внутри сорокаминутного
куска раньше стоила сорока минут пересборки — половины ролика.
Часть, которая начинается не с начала куска, помечается точным резом:
копия пошла бы от ближайшего опорного кадра и сдвинула бы картинку.
Сборка перекодирует огрызок до опорного кадра, а дальше снова копирует —
доли секунды вместо минут.
Обрезки короче секунды не копируются, а дожигаются вместе с надписью:
возни с опорными кадрами там больше, чем выгоды.
## Качество пересобираемых кусков
Куски, которые нельзя скопировать, целятся в наибольший битрейт среди
@ -428,6 +443,25 @@ Linux потом искала по нему `.dll`.
Оставить их можно настройкой `keep_parts` в файле настроек: пригодится,
когда разбираешься, из чего собрался ролик.
## Дыры и вставки
Промежуток короче половины кадра проекта дырой не считается: между
клипами, сдвинутыми встык мышью, остаются микросекунды, и заказывать под
них чёрную вставку не нужно. Мышь при этом кладёт клипы на кадровую
сетку — между кадрами времени не существует.
Готовые вставки делаются двух длин, 15 и 60 секунд. Дыра длиннее минуты
набирается повторами одного и того же минутного файла: и список кусков
предпросмотра, и список склейки повторы принимают. Раньше лестница длин
доходила до восьми часов, и дыра в сорок минут требовала двухчасового
чёрного файла — программа выглядела зависшей.
Чёрное кодируется отдельным скромным потоком в мегабит: целиться в
битрейт съёмки там нечему.
Если правка монтажа сделала идущую генерацию ненужной, она прекращается:
программа проверяет, нужна ли ещё та вставка, что делается сейчас.
## Прерванная сборка
Каждый доведённый до конца кусок помечается в списке рядом с самими

10
src/uFfmpegCmd.pas
View file

@ -259,6 +259,10 @@ uses
слоёв, а она по тексту раньше самой функции. }
function BitrateArgs(ABitrate: Int64): TArgs; forward;
const
{ Поток для чёрных вставок: мегабит в секунду. }
BlackBitrate = 1000000;
{ Общие параметры вывода в формате проекта. Объявлено заранее, потому что
используется выше по тексту, чем определено. }
function ArgsExtractAudioRaw(const ASource, ATarget: string;
@ -1138,8 +1142,12 @@ begin
Format('anullsrc=channel_layout=%s:sample_rate=%d',
[IfThen(AChannels = 1, 'mono', 'stereo'), ASampleRate])]);
{ Чёрный кадр жмётся в ничто, и целиться в битрейт съёмки тут незачем:
мегабита в секунду хватит с запасом. Без явного числа сюда попало бы
то, чем целятся пересобираемые куски, — полсотни мегабит на чёрное. }
Result := Concat(Result, MasterOutputArgs(0, 0, AFpsNum, AFpsDen,
AVideoCodec, APixFmt, AAudioCodec, ASampleRate, AChannels));
AVideoCodec, APixFmt, AAudioCodec, ASampleRate, AChannels,
BlackBitrate));
Result := Concat(Result, NoBFramesArgs);
Result := Concat(Result, ['-t', SecondsToStr(ADuration)]);
Result := Concat(Result, ProgressArgs);

56
src/uFlatten.pas
View file

@ -221,7 +221,17 @@ const
Теперь вставка берётся из готового файла подходящей длины, а нужный
кусок из неё просто вырезается. Файлов получается несколько штук на
проект, и делаются они один раз. }
LengthBuckets: array[0..5] of Double = (15, 60, 300, 1800, 7200, 28800);
LengthBuckets: array[0..1] of Double = (15, 60);
{ Длиннее минуты готовых вставок не делаем.
Раньше лестница доходила до восьми часов, и дыра в сорок минут
требовала двухчасового чёрного файла: NVENC в 2688x1512 при 60 к/с
кодирует его минутами, а пока он делается, программа выглядит
зависшей. Длинная дыра теперь набирается из одного и того же
минутного файла, повторённого нужное число раз — и список кусков
предпросмотра, и список склейки повторы принимают. }
MaxInsertLength = 60.0;
function QuantizeDuration(const AValue: Double): Double;
begin
@ -479,6 +489,8 @@ var
Path: string;
Seen: TStringList;
Partner, Under: TClip;
Left, HalfFrame: Double;
Piece: TFlatSegment;
{ Слой из клипа: где в исходнике брать картинку и с какой
непрозрачностью её накладывать. }
@ -683,6 +695,13 @@ begin
if AProject = nil then
Exit;
{ Половина кадра проекта. Частота бывает не задана — тогда берём
полмиллисекунды, как было раньше. }
if (AProject.Master.FpsNum > 0) and (AProject.Master.FpsDen > 0) then
HalfFrame := 0.5 * AProject.Master.FpsDen / AProject.Master.FpsNum
else
HalfFrame := 0.0005;
{ --- Границы --- }
N := 0;
for T := 0 to AProject.TrackCount - 1 do
@ -729,8 +748,15 @@ begin
begin
SegStart := Bounds[I];
SegEnd := Bounds[I + 1];
{ Совпавшие границы дают промежуток нулевой длины — пропускаем. }
if SegEnd - SegStart < 0.0005 then
{ Промежуток короче половины кадра — это не дыра, а остаток
вычислений в долях секунды.
Раньше порог был жёсткий, полмиллисекунды, и зазор в двадцать три
микросекунды между сдвинутыми встык клипами оказывался с ним рядом.
Стоит зазору чуть подрасти — и программа заказывает чёрную вставку
туда, где на глаз всё встык. Половина кадра — естественная мера:
короче неё в ролике не бывает ничего. }
if SegEnd - SegStart < HalfFrame then
Continue;
{ Внутри промежутка победитель не меняется, поэтому достаточно
@ -916,6 +942,30 @@ begin
end;
end;
{ Длинная вставка набирается повторами одного файла: см.
MaxInsertLength. Куски картинки и видео не трогаем — они берутся из
настоящих файлов и такой разбивке не подлежат. }
if (Seg.Kind in [skBlack, skImage]) and
(Seg.Duration > MaxInsertLength + 0.0005) then
begin
Left := Seg.Duration;
Piece := Seg;
while Left > 0.0005 do
begin
Piece.Duration := Min(MaxInsertLength, Left);
{ Лишний запас: последняя часть может быть короче, и файл под неё
берётся тот же самый, из которого вырезается сколько надо. }
if RawCount >= Length(Raw) then
SetLength(Raw, RawCount + 16);
Raw[RawCount] := Piece;
Inc(RawCount);
Left := Left - Piece.Duration;
end;
Continue;
end;
if RawCount >= Length(Raw) then
SetLength(Raw, RawCount + 16);
Raw[RawCount] := Seg;
Inc(RawCount);
end;

17
src/uGenerate.pas
View file

@ -64,6 +64,11 @@ type
property PendingLog: string read FPendingLog;
property Succeeded: Boolean read FSucceeded;
property Cancelled: Boolean read FCancelled;
{ Что этот поток делает. Список задан при создании и не меняется,
поэтому читать его из главного потока безопасно. Нужен, чтобы
понять, не стала ли работа лишней после правки монтажа. }
function TargetCount: Integer;
function TargetPath(AIndex: Integer): string;
property Message: string read FMessage;
property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
@ -88,6 +93,18 @@ begin
FMaster := AMaster;
end;
function TGenerateThread.TargetCount: Integer;
begin
Result := Length(FRequests);
end;
function TGenerateThread.TargetPath(AIndex: Integer): string;
begin
if (AIndex < 0) or (AIndex > High(FRequests)) then
Exit('');
Result := FRequests[AIndex].TargetPath;
end;
procedure TGenerateThread.RequestCancel;
begin
FCancelRequested := True;

48
src/uMainForm.pas
View file

@ -301,6 +301,8 @@ type
procedure LoadPreviewEdl(const ASegments, AAudio: TFlatSegmentArray);
procedure BuildOverlayPreview(const AOverlays: TPreviewOverlays;
const ATotal: Double);
{ Нужно ли ещё то, что делает идущая генерация. }
function GenerationStillNeeded: Boolean;
procedure GenerateDone(Sender: TObject);
procedure GenerateProgress(Sender: TObject);
procedure GenerateLog(Sender: TObject);
@ -1982,7 +1984,19 @@ begin
if FGenerateBusy then
begin
{ Пока идёт создание вставок, пересборку откладываем: иначе запустим
второй такой же поток. }
второй такой же поток.
Но сперва смотрим, нужна ли ещё та работа, что идёт. Дыру могли
закрыть, клип подвинуть — и тогда вставка делается впустую, а
чёрная минута в 2688x1512 считается не мгновенно. Ненужное
прекращаем: поток сам доложит о завершении, и пересборка пойдёт по
свежей расстановке. }
if Assigned(FGenerate) and (not GenerationStillNeeded) then
begin
Log('Расстановка изменилась — прекращаю делать ненужные вставки.');
SetStatus('Расстановка изменилась, лишние вставки отменены.');
FGenerate.RequestCancel;
end;
FPreviewDirty := True;
FPreviewTimer.Enabled := True;
Exit;
@ -2129,6 +2143,32 @@ begin
FPreviewOverlayUrl := BuildEdlUri(Segs);
end;
{ Делает ли идущая генерация то, что монтажу ещё нужно.
Уплощение считается заново — оно дешёвое, ffmpeg не запускает. Если ни
одна из готовящихся вставок в новом списке не нужна, работу можно
прекращать. Ошибиться тут не страшно: отменённое, если оно всё же
понадобится, закажут заново на следующей пересборке. }
function TMainForm.GenerationStillNeeded: Boolean;
var
Segs, Auds: TFlatSegmentArray;
Ovl: TPreviewOverlays;
Missing: TGenRequests;
I, J: Integer;
begin
Result := False;
if not Assigned(FGenerate) then
Exit;
if not FlattenPreview(FProject, Segs, Auds, Ovl, Missing,
FSettings.PreviewKey) then
Exit;
for I := 0 to High(Missing) do
for J := 0 to FGenerate.TargetCount - 1 do
if Missing[I].TargetPath = FGenerate.TargetPath(J) then
Exit(True);
end;
procedure TMainForm.LoadPreviewEdl(const ASegments, AAudio: TFlatSegmentArray);
var
Edl, AudioEdl: string;
@ -3595,7 +3635,11 @@ end;
procedure TMainForm.MenuRipple(Sender: TObject);
begin
FTimeline.RippleCloseGap;
{ Команда должна отвечать всегда: молчание читается как «не работает». }
if FTimeline.RippleCloseGap then
SetStatus('Дыра схлопнута.')
else
SetStatus('Под курсором дыры нет: схлопывать нечего.');
end;
{ К началу самого раннего клипа по всем дорожкам. Если монтаж начинается

188
src/uSubtitles.pas
View file

@ -94,6 +94,9 @@ uses
Math, LazUTF8;
const
{ Короче этого копируемые обрезки не делаем: возни с опорными кадрами
больше, чем выгоды от копирования секунды. }
MinCopyPiece = 1.0;
{ Запас по ширине: наши мерки и мерки libass расходятся на проценты. }
WidthSafety = 0.95;
{ Поля от краёв кадра в долях ширины и высоты. }
@ -483,38 +486,195 @@ begin
Result := (Text <> '') and WriteText(Text, APath);
end;
{ Отрезки, которые задевает текст, внутри указанного куска. Отрезки
сливаются, если налезают друг на друга: две надписи подряд — это одна
пересобираемая часть, а не две. }
procedure CollectTextRanges(AProject: TProject; const AFrom, ATo: Double;
out AStarts, AEnds: TDoubleArray; out ACount: Integer);
var
T, C, I, J: Integer;
Clip: TClip;
S, E, TmpS, TmpE: Double;
begin
ACount := 0;
SetLength(AStarts, 0);
SetLength(AEnds, 0);
if AProject = nil then
Exit;
for T := 0 to AProject.TrackCount - 1 do
begin
if AProject.Tracks[T].Kind <> tkText then
Continue;
if not AProject.TrackAudible(AProject.Tracks[T]) then
Continue;
for C := 0 to AProject.Tracks[T].Count - 1 do
begin
Clip := AProject.Tracks[T][C];
if Trim(Clip.Text) = '' then
Continue;
S := Max(AFrom, Clip.TlStart);
E := Min(ATo, Clip.TlEnd);
if E <= S + 0.0005 then
Continue;
SetLength(AStarts, ACount + 1);
SetLength(AEnds, ACount + 1);
AStarts[ACount] := S;
AEnds[ACount] := E;
Inc(ACount);
end;
end;
{ Сортировка вставками: надписей в куске единицы. }
for I := 1 to ACount - 1 do
begin
TmpS := AStarts[I];
TmpE := AEnds[I];
J := I - 1;
while (J >= 0) and (AStarts[J] > TmpS) do
begin
AStarts[J + 1] := AStarts[J];
AEnds[J + 1] := AEnds[J];
Dec(J);
end;
AStarts[J + 1] := TmpS;
AEnds[J + 1] := TmpE;
end;
{ Слияние налезающих. }
I := 0;
while I < ACount - 1 do
if AStarts[I + 1] <= AEnds[I] + MinCopyPiece then
begin
AEnds[I] := Max(AEnds[I], AEnds[I + 1]);
for J := I + 1 to ACount - 2 do
begin
AStarts[J] := AStarts[J + 1];
AEnds[J] := AEnds[J + 1];
end;
Dec(ACount);
end
else
Inc(I);
end;
function BurnTextIntoSegments(AProject: TProject;
var ASegments: TFlatSegmentArray; const ACacheDir: string;
const AStartTime: Double): Double;
var
I: Integer;
At, SegEnd: Double;
Res: TFlatSegmentArray;
N, I, J, K, RangeCount: Integer;
At, SegEnd, Cursor: Double;
Starts, Ends: TDoubleArray;
Path: string;
PrevBurned: Boolean;
{ Часть исходного куска. AFrom и ATo — время монтажа. }
procedure PushPiece(const ASeg: TFlatSegment; const AFrom, ATo: Double;
ABurn: Boolean; const ASegFrom: Double);
var
Piece: TFlatSegment;
Shift: Double;
L: Integer;
begin
if ATo <= AFrom + 0.0005 then
Exit;
Piece := ASeg;
Shift := AFrom - ASegFrom;
Piece.Duration := ATo - AFrom;
Piece.SrcStart := ASeg.SrcStart + Shift;
for L := 0 to High(Piece.Layers) do
Piece.Layers[L].SrcStart := ASeg.Layers[L].SrcStart + Shift;
{ Часть, начавшаяся не с начала куска, начинается в произвольном
месте потока. Копировать её с этого места нельзя: копия пойдёт от
ближайшего опорного кадра, и картинка сдвинется. Поэтому помечаем
начало точным — сборка перекодирует огрызок до опорного кадра, а
дальше снова копирует. }
if Shift > 0.0005 then
Piece.PreciseIn := True;
if ABurn then
begin
Path := IncludeTrailingPathDelimiter(ACacheDir) +
Format('burn_%.3d_%.2d.ass', [I, K]);
Inc(K);
if WriteAssForRange(AProject, AFrom, ATo, Path) then
begin
{ Кусок, который и так пересобирался, дороже не становится. }
if not (Piece.Transcode or (Length(Piece.Layers) > 0)) then
Result := Result + Piece.Duration;
Piece.SubFile := Path;
Piece.Transcode := True;
end;
end;
if N >= Length(Res) then
SetLength(Res, N + 16);
Res[N] := Piece;
Inc(N);
end;
begin
Result := 0;
if (AProject = nil) or (not HasText(AProject)) then
Exit;
SetLength(Res, Length(ASegments) + 16);
N := 0;
At := AStartTime;
for I := 0 to High(ASegments) do
begin
SegEnd := At + ASegments[I].Duration;
if TextCovers(AProject, At, SegEnd) then
CollectTextRanges(AProject, At, SegEnd, Starts, Ends, RangeCount);
if RangeCount = 0 then
begin
Path := IncludeTrailingPathDelimiter(ACacheDir) +
Format('burn_%.3d.ass', [I]);
if WriteAssForRange(AProject, At, SegEnd, Path) then
begin
{ Кусок, который и так пересобирался, дороже не становится —
считаем только те, что раньше копировались. }
if not (ASegments[I].Transcode or (Length(ASegments[I].Layers) > 0)) then
Result := Result + ASegments[I].Duration;
ASegments[I].SubFile := Path;
ASegments[I].Transcode := True;
end;
if N >= Length(Res) then
SetLength(Res, N + 16);
Res[N] := ASegments[I];
Inc(N);
At := SegEnd;
Continue;
end;
{ Кусок режется на части: до надписи, под надписью, после. Пересобрать
придётся только середину.
Раньше пересобирался весь кусок целиком, и надпись на тридцать
секунд внутри сорокаминутного куска заставляла пересобирать сорок
минут — половину ролика. }
K := 0;
Cursor := At;
PrevBurned := False;
for J := 0 to RangeCount - 1 do
begin
{ Обрезок короче секунды копировать незачем: возни с опорными
кадрами больше, чем выгоды. Отдаём его вжиганию. }
if Starts[J] - Cursor > MinCopyPiece then
begin
PushPiece(ASegments[I], Cursor, Starts[J], False, At);
Cursor := Starts[J];
end;
PushPiece(ASegments[I], Cursor, Ends[J], True, At);
Cursor := Ends[J];
PrevBurned := True;
end;
if SegEnd - Cursor > MinCopyPiece then
PushPiece(ASegments[I], Cursor, SegEnd, False, At)
else if SegEnd > Cursor + 0.0005 then
{ Хвост короче секунды — дожигаем вместе с надписью, чтобы не
плодить огрызки. }
PushPiece(ASegments[I], Cursor, SegEnd, PrevBurned, At);
At := SegEnd;
end;
SetLength(Res, N);
ASegments := Res;
end;
function WriteAssFile(AProject: TProject; const APath: string): Boolean;

63
src/uTimelineCtrl.pas
View file

@ -282,7 +282,9 @@ type
procedure CollectGroupClips(AClip: TClip);
procedure ApplyGroupMove(const ADelta: Double);
{ Сдвинуть клипы влево, закрыв дыру под курсором. }
procedure RippleCloseGap;
{ True — дыра нашлась и схлопнута. False — схлопывать было нечего:
окно скажет об этом, чтобы команда не выглядела сломанной. }
function RippleCloseGap: Boolean;
procedure SelectAll;
{ Номер дорожки под указателем мыши, минус один если ни одной. }
@ -294,6 +296,8 @@ type
{ Куда встанет курсор, если поставить его в это время. Открыто, чтобы
расчёт можно было проверить числами, не гоняя мышь по окну. }
function SnapPlayhead(const ATime: Double): Double;
{ Округление к кадровой сетке проекта: между кадрами времени нет. }
function QuantizeTime(const ATime: Double): Double;
property Project: TProject read FProject write FProject;
{ Усиление формы звука. Меняется по Shift со стрелками. }
@ -1685,6 +1689,27 @@ begin
end;
{ Примагничивание к краям соседних клипов и к курсору воспроизведения. }
{ Округление к кадровой сетке проекта.
Между кадрами времени не существует: клип, поставленный на 23
микросекунды дальше соседа, — это не «почти встык», а дыра, под которую
программа честно закажет чёрную вставку. Поэтому всё, что ставит мышь,
проходит через эту меру.
Частота кадров бывает неизвестна (пустой проект) — тогда не трогаем. }
function TTimelineControl.QuantizeTime(const ATime: Double): Double;
var
Step: Double;
begin
Result := ATime;
if FProject = nil then
Exit;
if (FProject.Master.FpsNum <= 0) or (FProject.Master.FpsDen <= 0) then
Exit;
Step := FProject.Master.FpsDen / FProject.Master.FpsNum;
Result := Round(ATime / Step) * Step;
end;
function TTimelineControl.SnapTime(const ATime: Double; AExclude: TClip): Double;
var
T, C: Integer;
@ -2157,7 +2182,8 @@ begin
taDragClip:
if FDragClip <> nil then
begin
NewStart := SnapTime(XToTime(X) - FDragGrabOffset, FDragClip);
NewStart := QuantizeTime(SnapTime(XToTime(X) - FDragGrabOffset,
FDragClip));
FDragClip.TlStart := Max(0, NewStart);
{ Связка едет целиком: звук должен остаться под своей картинкой. }
ApplyGroupMove(FDragClip.TlStart - FDragOrigStart);
@ -2211,7 +2237,7 @@ begin
taTrimIn:
if FDragClip <> nil then
begin
NewStart := SnapTime(XToTime(X), FDragClip);
NewStart := QuantizeTime(SnapTime(XToTime(X), FDragClip));
{ Правый край стоит на месте, двигается левый: меняются и позиция
на монтаже, и то, с какого места берётся материал. }
Delta := NewStart - FDragOrigStart;
@ -2236,7 +2262,7 @@ begin
taTrimOut:
if FDragClip <> nil then
begin
NewEnd := SnapTime(XToTime(X), FDragClip);
NewEnd := QuantizeTime(SnapTime(XToTime(X), FDragClip));
Delta := NewEnd - (FDragOrigStart + FDragOrigDuration);
MediaLen := MediaDurationOf(FDragClip);
@ -2385,7 +2411,8 @@ var
I: Integer;
begin
for I := 0 to High(FRippleClips) do
FRippleClips[I].TlStart := Max(0, FRippleOrigStarts[I] + ADelta);
FRippleClips[I].TlStart :=
Max(0, QuantizeTime(FRippleOrigStarts[I] + ADelta));
end;
procedure TTimelineControl.MouseUp(Button: TMouseButton; Shift: TShiftState;
@ -2826,9 +2853,9 @@ begin
FProject.Undo;
end;
procedure TTimelineControl.RippleCloseGap;
function TTimelineControl.RippleCloseGap: Boolean;
var
T, C: Integer;
T, C, Source: Integer;
Track: TTrack;
GapStart, GapEnd, Shift: Double;
AnyChange: Boolean;
@ -2856,16 +2883,25 @@ var
end;
begin
Result := False;
if FProject = nil then
Exit;
{ Дыру ищем на той дорожке, где стоит указатель мыши: под курсором
воспроизведения дыры бывают сразу на нескольких, и надо знать, какая
имеется в виду. }
if (FHoverTrack < 0) or (FHoverTrack >= FProject.TrackCount) then
имеется в виду.
Если указатель не над дорожками — а он там и не обязан быть, руки на
клавиатуре, — берём выбранную дорожку. Раньше в этом случае команда
молча не делала ничего, и выглядело это как «горячая клавиша не
работает». }
Source := FHoverTrack;
if (Source < 0) or (Source >= FProject.TrackCount) then
Source := FActiveTrack;
if (Source < 0) or (Source >= FProject.TrackCount) then
Exit;
if not FindGap(FProject.Tracks[FHoverTrack], GapStart, GapEnd) then
if not FindGap(FProject.Tracks[Source], GapStart, GapEnd) then
Exit;
Shift := GapEnd - GapStart;
@ -2883,7 +2919,7 @@ begin
Режим действует и при выключенном автосхлопывании: это осознанная
команда, а не побочный эффект перетаскивания. }
if (FProject.RippleMode = rmCurrentTrack) and (T <> FHoverTrack) then
if (FProject.RippleMode = rmCurrentTrack) and (T <> Source) then
Continue;
Track := FProject.Tracks[T];
@ -2897,7 +2933,10 @@ begin
end;
if AnyChange then
StructureChanged
begin
StructureChanged;
Result := True;
end
else
FProject.Undo;
end;

58
tests/lfmcheck/lfmcheck.lpr
View file

@ -247,6 +247,63 @@ begin
end;
end;
{ Схлопывание дыры без мыши.
Ctrl+Shift+R искал дыру только на дорожке под указателем мыши, а руки в
этот момент на клавиатуре. Со стороны выглядело как «горячая клавиша не
работает»: команда молча ничего не делала. }
procedure CheckRippleWithoutMouse;
var
Proj: TProject;
Info: TMediaInfo;
Media: TMediaItem;
Timeline: TTimelineControl;
begin
WriteLn;
WriteLn('Схлопывание дыры с клавиатуры');
WriteLn;
Info := Default(TMediaInfo);
Info.Valid := True;
Info.Kind := mkVideo;
Info.Duration := 600;
Info.HasVideo := True;
Info.VideoCodec := 'hevc';
Info.Width := 1920;
Info.Height := 1080;
Info.FpsNum := 30;
Info.FpsDen := 1;
Info.PixFmt := 'yuv420p';
Proj := TProject.Create;
Timeline := TTimelineControl.Create(nil);
try
Proj.Clear;
Proj.AddTrack('V1');
Media := Proj.AddMedia('/несуществующий/видео.mp4', Info);
Proj.Master := Info;
{ Дыра с 5 по 12 секунду. }
Proj.AddClip(Proj.Tracks[0], Media, 0, 5, 0);
Proj.AddClip(Proj.Tracks[0], Media, 20, 5, 12);
Timeline.Project := Proj;
Timeline.PixelsPerSecond := 100;
Timeline.ActiveTrack := 0;
Timeline.Playhead := 8;
{ Мышь не над дорожками: так и бывает, когда жмут сочетание клавиш. }
CheckTrue('дыра схлопнута без мыши', Timeline.RippleCloseGap);
CheckTrue('второй клип придвинут к первому',
Abs(Proj.Tracks[0][1].TlStart - 5) < 0.001);
{ Второй раз схлопывать нечего — и об этом надо сказать, а не молчать. }
CheckTrue('повторный вызов честно отвечает «нечего»',
not Timeline.RippleCloseGap);
finally
Timeline.Free;
Proj.Free;
end;
end;
begin
WriteLn('Свойства из файлов форм');
WriteLn;
@ -275,6 +332,7 @@ begin
CheckPlayheadSnap;
CheckSplitKeepsSettings;
CheckRippleWithoutMouse;
WriteLn;
if Failed = 0 then

58
tests/nlvetool.lpr
View file

@ -567,6 +567,7 @@ var
Clip: TClip;
Key: TColorKey;
Tr: TMediaTransform;
I, N: Integer;
TempFile, Err: string;
begin
WriteLn('Проверка уплощения монтажа');
@ -913,6 +914,63 @@ begin
end;
WriteLn;
{ --- 13. Длинная дыра набирается повторами короткой вставки --- }
WriteLn(' 13. Дыра в сорок минут');
Proj := MakeProject(1, Media);
try
Proj.Master := Media.Info;
{ Два клипа, между ними сорок минут пустоты. }
Proj.AddClip(Proj.Tracks[0], Media, 0, 5, 0);
Proj.AddClip(Proj.Tracks[0], Media, 10, 5, 2405);
FlattenStream(Proj, tkVideo, 0, Segs, Missing);
N := 0;
for I := 0 to High(Segs) do
if Segs[I].Kind = skBlack then
Inc(N);
Check(N = 40, 'дыра разложена на сорок минутных кусков: ' + IntToStr(N));
{ Файл нужен ровно один: все куски берут один и тот же. }
TempFile := '';
N := 0;
for I := 0 to High(Missing) do
if Missing[I].TargetPath <> TempFile then
begin
TempFile := Missing[I].TargetPath;
Inc(N);
end;
Check(N = 1, 'а файл заказан один: ' + IntToStr(N));
Check(Pos('black_60000', ExtractFileName(TempFile)) > 0,
'минутный: ' + ExtractFileName(TempFile));
finally
Proj.Free;
end;
WriteLn;
{ --- 14. Зазор в микросекунды — не дыра --- }
WriteLn(' 14. Зазор меньше кадра');
Proj := MakeProject(1, Media);
try
Proj.Master := Media.Info;
{ Так выглядят клипы, сдвинутые встык мышью: между ними остаются
микросекунды. Чёрную вставку туда заказывать нельзя. }
Proj.AddClip(Proj.Tracks[0], Media, 0, 5, 0);
Proj.AddClip(Proj.Tracks[0], Media, 10, 5, 5.000023);
FlattenStream(Proj, tkVideo, 0, Segs, Missing);
DumpSegments(Segs);
N := 0;
for I := 0 to High(Segs) do
if Segs[I].Kind = skBlack then
Inc(N);
Check(N = 0, 'чёрных кусков нет: ' + IntToStr(N));
Check(Length(Missing) = 0, 'и вставок не заказано: ' +
IntToStr(Length(Missing)));
finally
Proj.Free;
end;
WriteLn;
WriteLn;
if FailCount = 0 then
begin