From 939184fce79a00110b6811cba44507e8815194d3 Mon Sep 17 00:00:00 2001 From: 4aiman Date: Fri, 11 Sep 2026 19:35:26 +0300 Subject: [PATCH] =?UTF-8?q?=D0=A7=D1=91=D1=80=D0=BD=D1=8B=D0=B5=20=D0=B2?= =?UTF-8?q?=D1=81=D1=82=D0=B0=D0=B2=D0=BA=D0=B8=20=D1=81=D1=82=D0=BE=D1=8F?= =?UTF-8?q?=D1=82=20=D0=BA=D0=BE=D0=BF=D0=B5=D0=B9=D0=BA=D0=B8,=20=D1=82?= =?UTF-8?q?=D0=B5=D0=BA=D1=81=D1=82=20=D1=80=D0=B5=D0=B6=D0=B5=D1=82=20?= =?UTF-8?q?=D0=BA=D1=83=D1=81=D0=BE=D0=BA?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Дыра в сорок минут требовала двухчасового чёрного файла: лестница готовых длин доходила до восьми часов, и NVENC кодировал такое минутами. Отсюда «Делаю чёрную вставку 1 из 3», которое не кончается. Теперь длины две, 15 и 60 секунд, длинная дыра набирается повторами минутного файла, а само чёрное кодируется мегабитом вместо полусотни. Промежуток короче половины кадра дырой больше не считается: между клипами, сдвинутыми встык мышью, оставались микросекунды. Мышь при этом кладёт клипы на кадровую сетку — между кадрами времени не существует. Правка монтажа прекращает генерацию, ставшую ненужной: раньше закрытая дыра не отменяла уже начатую работу. Ctrl+Shift+R работает без мыши: дыра ищется на активной дорожке, если указатель не над дорожками, и команда отвечает в строке состояния, а не молчит. Вжигание текста режет кусок на части и пересобирает только середину. Надпись в тридцать секунд внутри сорокаминутного куска стоила сорока минут пересборки. Часть после надписи помечается точным резом, иначе копия пошла бы от опорного кадра и картинка сдвинулась бы. Проверки: flattest 13 и 14, схлопывание без мыши в lfmcheck, сборка с надписью внутри длинного куска — 1.000000 с пересборки вместо 6. --- README.md | 34 +++++++ src/uFfmpegCmd.pas | 10 +- src/uFlatten.pas | 56 ++++++++++- src/uGenerate.pas | 17 ++++ src/uMainForm.pas | 48 ++++++++- src/uSubtitles.pas | 188 +++++++++++++++++++++++++++++++++--- src/uTimelineCtrl.pas | 63 +++++++++--- tests/lfmcheck/lfmcheck.lpr | 58 +++++++++++ tests/nlvetool.lpr | 58 +++++++++++ 9 files changed, 500 insertions(+), 32 deletions(-) diff --git a/README.md b/README.md index ea009dc..520b657 100644 --- a/README.md +++ b/README.md @@ -398,6 +398,21 @@ Linux потом искала по нему `.dll`. каждого слоя считается на каждый отсчёт, и длина результата получается ровно такой, какая нужна. +## Текст режет кусок, а не пересобирает его целиком + +Вжигание надписи не делает весь кусок пересобираемым. Кусок режется на +части: до надписи, под надписью и после. Пересобирается только середина, +остальное копируется. Надпись в тридцать секунд внутри сорокаминутного +куска раньше стоила сорока минут пересборки — половины ролика. + +Часть, которая начинается не с начала куска, помечается точным резом: +копия пошла бы от ближайшего опорного кадра и сдвинула бы картинку. +Сборка перекодирует огрызок до опорного кадра, а дальше снова копирует — +доли секунды вместо минут. + +Обрезки короче секунды не копируются, а дожигаются вместе с надписью: +возни с опорными кадрами там больше, чем выгоды. + ## Качество пересобираемых кусков Куски, которые нельзя скопировать, целятся в наибольший битрейт среди @@ -428,6 +443,25 @@ Linux потом искала по нему `.dll`. Оставить их можно настройкой `keep_parts` в файле настроек: пригодится, когда разбираешься, из чего собрался ролик. +## Дыры и вставки + +Промежуток короче половины кадра проекта дырой не считается: между +клипами, сдвинутыми встык мышью, остаются микросекунды, и заказывать под +них чёрную вставку не нужно. Мышь при этом кладёт клипы на кадровую +сетку — между кадрами времени не существует. + +Готовые вставки делаются двух длин, 15 и 60 секунд. Дыра длиннее минуты +набирается повторами одного и того же минутного файла: и список кусков +предпросмотра, и список склейки повторы принимают. Раньше лестница длин +доходила до восьми часов, и дыра в сорок минут требовала двухчасового +чёрного файла — программа выглядела зависшей. + +Чёрное кодируется отдельным скромным потоком в мегабит: целиться в +битрейт съёмки там нечему. + +Если правка монтажа сделала идущую генерацию ненужной, она прекращается: +программа проверяет, нужна ли ещё та вставка, что делается сейчас. + ## Прерванная сборка Каждый доведённый до конца кусок помечается в списке рядом с самими diff --git a/src/uFfmpegCmd.pas b/src/uFfmpegCmd.pas index c01e39f..8da9507 100644 --- a/src/uFfmpegCmd.pas +++ b/src/uFfmpegCmd.pas @@ -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); diff --git a/src/uFlatten.pas b/src/uFlatten.pas index e97a318..09b5d78 100644 --- a/src/uFlatten.pas +++ b/src/uFlatten.pas @@ -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; diff --git a/src/uGenerate.pas b/src/uGenerate.pas index 75b3fdb..3b74307 100644 --- a/src/uGenerate.pas +++ b/src/uGenerate.pas @@ -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; diff --git a/src/uMainForm.pas b/src/uMainForm.pas index 57b24b6..5cb9cba 100644 --- a/src/uMainForm.pas +++ b/src/uMainForm.pas @@ -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; { К началу самого раннего клипа по всем дорожкам. Если монтаж начинается diff --git a/src/uSubtitles.pas b/src/uSubtitles.pas index 6f10e16..c1cbb77 100644 --- a/src/uSubtitles.pas +++ b/src/uSubtitles.pas @@ -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; diff --git a/src/uTimelineCtrl.pas b/src/uTimelineCtrl.pas index 735cf8b..6a4d650 100644 --- a/src/uTimelineCtrl.pas +++ b/src/uTimelineCtrl.pas @@ -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; diff --git a/tests/lfmcheck/lfmcheck.lpr b/tests/lfmcheck/lfmcheck.lpr index 31ce56f..cfaff79 100644 --- a/tests/lfmcheck/lfmcheck.lpr +++ b/tests/lfmcheck/lfmcheck.lpr @@ -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 diff --git a/tests/nlvetool.lpr b/tests/nlvetool.lpr index b886838..5fabfe1 100644 --- a/tests/nlvetool.lpr +++ b/tests/nlvetool.lpr @@ -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