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

Клип встаёт на курсор, монтаж едет следом, сборка ждёт конца правки

Browse source 
Три жалобы из настоящей работы над фильмом, и все про одно: положить
кусок туда, куда нужно, было нельзя.

Файл из списка падал в конец дорожки, стоило месту под ним оказаться
занятым, — а занято оно почти всегда: клип длиной в целый файл упирается
хвостом в то, что правее, даже когда начало легло в пустоту. Теперь
монтаж раздвигается: MakeRoomAt режет все дорожки в точке вставки и
сдвигает всё, что начинается с неё и правее, на длину нового клипа. Звук
и надписи едут вместе с картинкой, иначе синхрон рассыплется.

Точка вставки при этом округляется к кадровой сетке. Без этого вставка
давала наезд в пять миллисекунд: рез внутри раздвижки округляет время
сам, а клип клался на неокруглённый курсор. Отсюда и был «кроссфейд без
видимого перекрытия».

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

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

Проверки числами: раздвижка монтажа и прилипание хвостом. С окном:
insertat.sh, dragscroll.sh, genquiet.sh. Все три прогнаны и на прежней
сборке, где падают: клип в конце дорожки вместо курсора, 0.667 с вместо
4.238 с, сборка через 0.20 с вместо 1.62 с.
This commit is contained in:
4aiman 2026-10-15 23:33:58 +03:00
commit 0fa9bb6130
6 changed files with 1068 additions and 77 deletions
Download patch file Download diff file Expand all files Collapse all files

197
src/uMainForm.pas
View file

@ -102,6 +102,11 @@ type
её забыли или сохранение не дошло до файла. }
FAutoSaveTimer: TTimer;
FPreviewDirty: Boolean;
{ Когда монтаж правили в последний раз. От этой отметки отсчитывается
тишина, после которой можно браться за сборку наложений. }
FLastEditTick: QWord;
{ Сборка уже отложена — чтобы не повторять сообщение на каждый тик. }
FGenDeferred: Boolean;
FUpdatingFromPlayer: Boolean;
FLastLoadedEdl: string;
FLastLoadedAudioEdl: string;
@ -342,6 +347,7 @@ type
{ --- предпросмотр --- }
procedure PrewarmInserts;
procedure SchedulePreview;
function GenerateQuietLeft: Integer;
procedure PreviewTimerTick(Sender: TObject);
{ Есть ли на монтаже файл другого соотношения сторон. Только ради
таких файлов и нужен фильтр в предпросмотре. }
@ -361,6 +367,7 @@ type
{ --- обработчики компонентов --- }
procedure TimelinePlayheadChange(Sender: TObject);
procedure TimelineStructureChange(Sender: TObject);
procedure ReportOverlaps;
procedure TimelineSelectionChange(Sender: TObject);
procedure PlayerLog(Sender: TObject; const APrefix, ALevel, AText: string);
procedure PlayerTimePos(Sender: TObject);
@ -449,6 +456,17 @@ const
предпросмотр играет старую расстановку, а на монтаже уже новая. }
PreviewDebounceMs = 120;
{ Сколько монтаж должен постоять без правок, прежде чем начать считать
наложения и переходы.
Список кусков пересобирается сразу — предпросмотр обязан показывать
то, что на монтаже. А вот сборка наложения силами ffmpeg занимает
минуты, и начинать её, пока человек подбирает место, незачем: он
двинет клип ещё раз, и вся работа уйдёт в корзину. Полторы секунды —
это пауза между двумя правками одного движения, но меньше, чем пауза
человека, который уже решил. }
GenerateQuietMs = 1500;
{ Сколько сообщений о позиции ждать прибытия после перемотки.
Сообщения приходят на каждый кадр, так что это доли секунды. }
MaxSeekWaitTicks = 90;
@ -1913,6 +1931,7 @@ var
Track: TTrack;
Mismatches: TMismatches;
Duration, PlaceAt: Double;
Moved: Integer;
NormPath, Wanted: string;
NeedKind: TTrackKind;
I: Integer;
@ -2031,18 +2050,39 @@ begin
if Duration <= 0 then
Duration := DefaultImageDuration;
{ Ставим туда, куда попросили. Если там занято — в конец дорожки: молча
накладывать клипы друг на друга нельзя, порядок перекрытия должен быть
осознанным. }
PlaceAt := Max(0, ATime);
{ Длина кладётся на кадровую сетку, и округляется вниз.
Раздвижка освобождает целое число кадров, и если длина клипа чуть
больше освобождённого, хвост заезжает на соседа на долю кадра — а
наезд на одной дорожке это переход. Вниз, а не к ближайшему: просить
у файла больше, чем в нём есть, незачем. }
if (FProject.Master.FpsNum > 0) and (FProject.Master.FpsDen > 0) then
Duration := Int(Duration * FProject.Master.FpsNum /
FProject.Master.FpsDen) * FProject.Master.FpsDen /
FProject.Master.FpsNum;
{ Ставим туда, куда попросили.
Если там занято — раздвигаем монтаж: всё от этой точки и правее едет
вправо на длину нового клипа, на всех дорожках сразу. Раньше клип в
таком случае падал в конец дорожки, и это был не редкий случай, а
обычный: клип длиной в целый файл почти всегда упирается хвостом в
то, что правее, даже когда начало легло в свободное место.
Молча наложить клипы друг на друга по-прежнему нельзя: наезд на
одной дорожке — это переход, и заказывать его надо осознанно. }
{ Точка вставки — ровно на кадровой сетке. Курсор стоит где угодно, а
рез внутри раздвижки округляет время к ближайшему кадру. Положить
клип на неокруглённое время значит разойтись с собственным резом на
долю кадра: на монтаже это пять миллисекунд наезда, а наезд на одной
дорожке — заказ на переход, которого никто не просил. }
PlaceAt := FTimeline.QuantizeTime(Max(0, ATime));
FProject.BeginChange;
Moved := 0;
if (Track.ClipAt(PlaceAt) <> nil) or
(Track.ClipAt(PlaceAt + Duration - 0.001) <> nil) then
begin
PlaceAt := Track.EndTime;
Log('На дорожке ' + Track.Name + ' в этом месте занято — поставил в конец.');
end;
Moved := FTimeline.MakeRoomAt(PlaceAt, Duration, False);
FProject.BeginChange;
{ Парой: клип картинки и его звук на соответствующей звуковой дорожке.
Связка держит их вместе, пока её не развяжут по Ctrl+G. }
FProject.AddClipPair(Track, Item, 0, Duration, PlaceAt);
@ -2050,7 +2090,17 @@ begin
SchedulePreview;
UpdateCaption;
UpdateTimeLabel;
SetStatus('Добавлен клип на дорожку ' + Track.Name);
if Moved > 0 then
begin
Log(Format('Место было занято — раздвинул монтаж на %s с, отодвинуто ' +
'%d %s.', [SecondsToStr(Duration), Moved,
Plural(Moved, 'клип', 'клипа', 'клипов')]));
SetStatus(Format('Клип вставлен на дорожку %s, монтаж раздвинут на %s с ' +
'(%d %s)', [Track.Name, SecondsToStr(Duration), Moved,
Plural(Moved, 'клип', 'клипа', 'клипов')]), True);
end
else
SetStatus('Добавлен клип на дорожку ' + Track.Name, True);
Result := True;
end;
@ -2102,13 +2152,16 @@ end;
procedure TMainForm.SchedulePreview;
begin
FPreviewDirty := True;
FLastEditTick := GetTickCount64;
FPreviewTimer.Enabled := False;
FPreviewTimer.Interval := PreviewDebounceMs;
FPreviewTimer.Enabled := True;
end;
procedure TMainForm.PreviewTimerTick(Sender: TObject);
begin
FPreviewTimer.Enabled := False;
FPreviewTimer.Interval := PreviewDebounceMs;
if FPreviewDirty then
begin
FPreviewDirty := False;
@ -2116,6 +2169,24 @@ begin
end;
end;
{ Сколько ещё миллисекунд ждать, прежде чем браться за сборку наложений.
Ноль означает «можно начинать». Пока клип держат мышью, ответ всегда
«ещё подождать»: расстановка в этот момент меняется каждым движением
руки, и собранный переход устареет раньше, чем досчитается. }
function TMainForm.GenerateQuietLeft: Integer;
var
Passed: QWord;
begin
if FTimeline.Dragging then
Exit(GenerateQuietMs);
Passed := GetTickCount64 - FLastEditTick;
if Passed >= GenerateQuietMs then
Result := 0
else
Result := GenerateQuietMs - Integer(Passed);
end;
function TMainForm.PreviewNeedsFitting: Boolean;
var
T, C: Integer;
@ -2175,7 +2246,7 @@ var
Overlays: TPreviewOverlays;
GenMaster: TMediaInfo;
Missing, TrackMissing: TGenRequests;
I, J: Integer;
I, J, Wait: Integer;
TotalLen: Double;
begin
if (FPlayer = nil) or (not FPlayer.Initialized) then
@ -2260,6 +2331,24 @@ begin
if Length(Missing) > 0 then
begin
{ Сборка наложений ждёт конца правки. Список кусков уже пересобран,
монтаж показывает новую расстановку — а минуты работы ffmpeg
начинаются только когда стало тихо. }
Wait := GenerateQuietLeft;
if Wait > 0 then
begin
if not FGenDeferred then
begin
FGenDeferred := True;
SetStatus('Наложения соберу, когда правка закончится.');
end;
FPreviewDirty := True;
FPreviewTimer.Interval := Wait;
FPreviewTimer.Enabled := True;
Exit;
end;
FGenDeferred := False;
FGenerateBusy := True;
SetStatus('Готовлю вставки для предпросмотра...');
{ Вставки — картинки и связки — попадают в ролик наравне со съёмкой,
@ -3731,6 +3820,92 @@ begin
SchedulePreview;
UpdateCaption;
UpdateTimeLabel;
ReportOverlaps;
end;
{ Говорит в строке состояния, что клипы наехали друг на друга.
Наезд двух клипов одной дорожки — это заказ на переход, то есть минуты
работы ffmpeg и другая картинка на стыке. Заказывают его мышью, и
промахнуться легко: при общем плане один пиксель — это секунды. Пока об
этом не говорили вслух, переход появлялся как сюрприз, а человек искал,
почему сборка опять не кончается. }
procedure TMainForm.ReportOverlaps;
var
T, C, Count: Integer;
Track: TTrack;
A, B: TClip;
Over, Worst: Double;
Where, First, What: string;
WorstKind: TTrackKind;
{ Имя клипа для строки состояния. Длинное имя файла режется с головы:
у съёмки с камеры различается хвост, а строка состояния узкая, и
целое имя выталкивает за край окна главное — на сколько секунд
наехали. }
function NameOf(AClip: TClip): string;
var
Item: TMediaItem;
begin
if (AClip <> nil) and (AClip.Kind = ckText) then
Exit('надпись');
Item := nil;
if AClip <> nil then
Item := FProject.FindMedia(AClip.MediaId);
if Item = nil then
Exit('клип');
Result := ExtractFileName(Item.Path);
if Length(Result) > 22 then
Result := '…' + Copy(Result, Length(Result) - 21, 22);
end;
begin
Count := 0;
Worst := 0;
First := '';
Where := '';
WorstKind := tkVideo;
for T := 0 to FProject.TrackCount - 1 do
begin
Track := FProject.Tracks[T];
for C := 0 to Track.Count - 2 do
begin
A := Track[C];
B := Track[C + 1];
{ Полкадра — не наезд, а округление: кадровая сетка не бьётся
нацело, и доли кадра набегают сами. }
Over := A.TlEnd - B.TlStart;
if Over <= 0.001 then
Continue;
Inc(Count);
if Over > Worst then
begin
Worst := Over;
First := NameOf(A) + ' и ' + NameOf(B);
Where := Track.Name;
WorstKind := Track.Kind;
end;
end;
end;
if Count = 0 then
Exit;
{ Наезд на звуковой дорожке переходом не становится: там два клипа
просто звучат вместе. Обещать переход значило бы врать. }
if WorstKind = tkAudio then
What := 'звук здесь смешается'
else
What := 'здесь соберётся переход';
{ Сначала величина и место, потом имена: строка обрывается по ширине
окна, и обрываться должно наименее важное. }
if Count = 1 then
SetStatus(Format('Наезд на %s: %s с, %s (%s)',
[Where, SecondsToStr(Worst), What, First]), True)
else
SetStatus(Format('Наездов: %d, самый большой на %s: %s с, %s (%s)',
[Count, Where, SecondsToStr(Worst), What, First]), True);
end;
procedure TMainForm.TimelineSelectionChange(Sender: TObject);

368
src/uTimelineCtrl.pas
View file

@ -25,7 +25,7 @@ interface
uses
Classes, SysUtils, Controls, Graphics, LCLType, LCLIntf, Forms, Math,
uAppTypes, uProject, uMediaProbe, uKeyframeIndex, uWaveform;
ExtCtrls, uAppTypes, uProject, uMediaProbe, uKeyframeIndex, uWaveform;
type
{ Что сейчас делает мышь. }
@ -170,6 +170,12 @@ type
FOnTrackRename: TTrackRenameEvent;
{ Дорожка, которую тащат за заголовок. }
FDragTrackIndex: Integer;
{ Прокрутка следом за указателем, пока тащат клип или край у самой
кромки окна. Таймер нужен потому, что рука у края останавливается:
без него прокрутка шла бы только пока мышь движется. }
FEdgeTimer: TTimer;
FEdgeX: Integer;
FEdgeY: Integer;
FDragTrackFrom: Integer;
FOnMediaDrop: TMediaDropEvent;
FOnClipTransform: TClipEvent;
@ -244,13 +250,13 @@ type
procedure DrawVolume(ACanvas: TCanvas; AClip: TClip; ATop: Integer;
const ABody: TRect);
function GetDragging: Boolean;
procedure SetWaveGain(const AValue: Double);
procedure SetPlayhead(const AValue: Double);
procedure SetPixelsPerSecond(const AValue: Double);
procedure ClampScroll;
procedure ClampScrollY;
function TracksBottom: Integer;
function SnapTime(const ATime: Double; AExclude: TClip): Double;
function MediaDurationOf(AClip: TClip): Double;
procedure StructureChanged;
{ Помечает край клипа точным, если он не попал на опорный кадр.
@ -260,6 +266,17 @@ type
сделать не то, о чём просили. }
procedure UpdateEdgePrecision(AClip: TClip);
{ Составляет список клипов правее перетаскиваемого. }
{ Перетаскивание клипа в указанную точку. Вынесено из обработчика
движения мыши: то же самое повторяет таймер прокрутки, пока
указатель стоит у края. }
procedure DragClipTo(const AX, AY: Integer);
{ Прокрутка, если указатель у кромки. Возвращает True, если
прокрутили. }
function ScrollByEdge(const AX: Integer): Boolean;
procedure EdgeTimerTick(Sender: TObject);
{ Включает и выключает слежение за кромкой. }
procedure SetEdgeScroll(AOn: Boolean; const AX: Integer = 0;
const AY: Integer = 0);
procedure CollectRippleClips(ATrackIndex: Integer; AExclude: TClip;
const AFromTime: Double);
procedure ApplyRipple(const ADelta: Double);
@ -280,6 +297,9 @@ type
procedure SetSelectionMode(AValue: TSelectionMode);
{ Рез в указанном месте. Возвращает, сколько клипов разрезано. }
function SplitAt(const ATime: Double; APrecise: Boolean): Integer;
{ Рез без снимка для отмены и без сообщения о правке: для тех, кто
режет внутри более крупного действия. }
function SplitAtCore(const ATime: Double; APrecise: Boolean): Integer;
protected
procedure Paint; override;
procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
@ -332,6 +352,28 @@ type
притянется к опорному кадру, и точка съедет на величину до
расстояния между опорными кадрами. }
function SplitAtPlayhead(APrecise: Boolean): Integer;
{ Раздвигает монтаж: освобождает ALength секунд начиная с ATime.
Нужна вставке клипа в место курсора. Клип, накрывающий точку
вставки, разрезается — иначе перед ним осталась бы дыра. Всё, что
начинается с этой точки и правее, едет вправо, на всех дорожках
сразу: звук и надписи обязаны уехать вместе с картинкой, иначе
синхрон рассыплется.
ASnapshot — делать ли снимок для отмены. False означает, что
вызывающий уже сделал свой и раздвижка — часть его действия.
Возвращает, сколько клипов отодвинуто. }
function MakeRoomAt(const ATime, ALength: Double;
ASnapshot: Boolean = True): Integer;
{ Куда притянется время ATime: к нулю, к курсору или к краю соседнего
клипа, если они ближе SnapPixels.
AExclude — клип, который сейчас двигают: сам к себе он не липнет.
ALength — его длина. Задана — кандидатами становятся и положения,
при которых на границу садится хвост клипа, а не голова. }
function SnapTime(const ATime: Double; AExclude: TClip;
const ALength: Double = 0): Double;
procedure DeleteSelected;
{ Связать выделенные клипы или развязать, если они уже связаны.
@ -390,6 +432,11 @@ type
для строки состояния: дыра могла найтись не на той дорожке, где
стоял указатель, и молча двигать чужую дорожку нельзя. }
property LastGapTrack: string read FLastGapTrack;
{ Правка идёт прямо сейчас: клип держат мышью, тянут за край или за
ручку. Окно по этому признаку откладывает тяжёлую сборку — считать
наложение, пока расстановка меняется каждым движением руки, значит
считать впустую. }
property Dragging: Boolean read GetDragging;
{ Округление к кадровой сетке проекта: между кадрами времени нет. }
function QuantizeTime(const ATime: Double): Double;
@ -535,6 +582,12 @@ begin
FPlayheadSnap := True;
FDragTrackIndex := -1;
FDragTrackFrom := -1;
FEdgeTimer := TTimer.Create(Self);
FEdgeTimer.Enabled := False;
{ Шаг мельче кадра: прокрутка должна течь, а не прыгать. }
FEdgeTimer.Interval := 30;
FEdgeTimer.OnTimer := @EdgeTimerTick;
end;
destructor TTimelineControl.Destroy;
@ -1759,6 +1812,14 @@ begin
Invalidate;
end;
{ Прокрутка и протяжка курсора правкой не считаются: монтаж при них не
меняется, и откладывать из-за них нечего. }
function TTimelineControl.GetDragging: Boolean;
begin
Result := FAction in [taDragClip, taTrimIn, taTrimOut, taVolume,
taFadeIn, taFadeOut, taDragTrack];
end;
procedure TTimelineControl.ClampScroll;
var
MaxTime: Double;
@ -1913,7 +1974,8 @@ begin
Result := Round(ATime / Step) * Step;
end;
function TTimelineControl.SnapTime(const ATime: Double; AExclude: TClip): Double;
function TTimelineControl.SnapTime(const ATime: Double; AExclude: TClip;
const ALength: Double): Double;
var
T, C: Integer;
Track: TTrack;
@ -1930,6 +1992,19 @@ var
end;
end;
{ Граница притягивает клип обоими концами. Передвигаемое — начало, но
встать вплотную человек хочет чаще хвостом: сдвинуть кусок влево,
чтобы он кончился ровно там, где начинается следующий. Кандидат на
такое положение — «граница минус длина клипа». Без него клип встаёт
началом в дыру, а хвостом наезжает на соседа, и наезд молча
превращается в переход. }
procedure ConsiderEdge(const ACandidate: Double);
begin
Consider(ACandidate);
if ALength > 0 then
Consider(ACandidate - ALength);
end;
begin
Result := ATime;
if FProject = nil then
@ -1945,7 +2020,7 @@ begin
Best := ATime;
Consider(0);
Consider(FPlayhead);
ConsiderEdge(FPlayhead);
for T := 0 to FProject.TrackCount - 1 do
begin
@ -1960,8 +2035,8 @@ begin
клип цепляться за собственное следствие. }
if IsRippling(Clip) then
Continue;
Consider(Clip.TlStart);
Consider(Clip.TlEnd);
ConsiderEdge(Clip.TlStart);
ConsiderEdge(Clip.TlEnd);
end;
end;
@ -2366,6 +2441,11 @@ begin
Exit;
end;
{ Пока тащат клип или край, следим за кромкой окна: у края монтаж
едет следом сам, даже если рука остановилась. }
SetEdgeScroll(FAction in [taDragClip, taTrimIn, taTrimOut, taRubberBand],
X, Y);
case FAction of
taPan:
begin
@ -2454,59 +2534,7 @@ begin
end;
taDragClip:
if FDragClip <> nil then
begin
NewStart := QuantizeTime(SnapTime(XToTime(X) - FDragGrabOffset,
FDragClip));
FDragClip.TlStart := Max(0, NewStart);
{ Связка едет целиком: звук должен остаться под своей картинкой. }
ApplyGroupMove(FDragClip.TlStart - FDragOrigStart);
{ Всё, что правее, едет на ту же величину. }
if Length(FRippleClips) > 0 then
ApplyRipple(FDragClip.TlStart - FDragOrigStart);
{ Утащили ниже последней дорожки — заводим новую, как в Vegas.
За одно перетаскивание не больше одной: иначе движение мыши
вниз наплодило бы их десяток. Вид новой дорожки — по клипу:
картинку на звуковую дорожку класть незачем. }
if (Idx < 0) and (FProject <> nil) and (Y > TracksBottom) and
(not FTrackAddedDuringDrag) then
begin
case TProject.TrackKindFor(FDragClip.Kind) of
tkAudio: FProject.AddTrackOfKind(FProject.UniqueTrackName('A'), tkAudio);
tkText: FProject.AddTrackOfKind(FProject.UniqueTrackName('Т'), tkText);
else
FProject.AddTrack(FProject.UniqueTrackName('V'));
end;
FTrackAddedDuringDrag := True;
Idx := FProject.TrackCount - 1;
if Assigned(FOnTrackAdded) then
FOnTrackAdded(Self);
end;
{ Перенос на другую дорожку: клип следует за указателем по
вертикали. Именно перенос, а не копирование.
На дорожку чужого вида клип не пускаем. Уплощение обходит
дорожки по видам, и клип, попавший не на свою, пропадает и из
сборки, и из предпросмотра — молча: на монтаже он нарисован, а
в ролике его нет. Проверено на живом проекте, где фотография
оказалась на текстовой дорожке. }
if (Idx >= 0) and (FProject <> nil) then
begin
TargetTrack := FProject.Tracks[Idx];
if (TargetTrack <> FDragTrack) and
(TargetTrack.Kind = TProject.TrackKindFor(FDragClip.Kind)) then
begin
FDragTrack.Extract(FDragClip);
TargetTrack.Add(FDragClip);
FDragTrack := TargetTrack;
end;
end;
FDragTrack.Sort;
Invalidate;
end;
DragClipTo(X, Y);
taTrimIn:
if FDragClip <> nil then
@ -2689,6 +2717,144 @@ begin
Max(0, QuantizeTime(FRippleOrigStarts[I] + ADelta));
end;
procedure TTimelineControl.DragClipTo(const AX, AY: Integer);
var
NewStart: Double;
Idx: Integer;
TargetTrack: TTrack;
X, Y: Integer;
begin
X := AX;
Y := AY;
Idx := TrackIndexAt(Y);
if FDragClip <> nil then
begin
NewStart := QuantizeTime(SnapTime(XToTime(X) - FDragGrabOffset,
FDragClip, FDragClip.Duration));
FDragClip.TlStart := Max(0, NewStart);
{ Связка едет целиком: звук должен остаться под своей картинкой. }
ApplyGroupMove(FDragClip.TlStart - FDragOrigStart);
{ Всё, что правее, едет на ту же величину. }
if Length(FRippleClips) > 0 then
ApplyRipple(FDragClip.TlStart - FDragOrigStart);
{ Утащили ниже последней дорожки — заводим новую, как в Vegas.
За одно перетаскивание не больше одной: иначе движение мыши
вниз наплодило бы их десяток. Вид новой дорожки — по клипу:
картинку на звуковую дорожку класть незачем. }
if (Idx < 0) and (FProject <> nil) and (Y > TracksBottom) and
(not FTrackAddedDuringDrag) then
begin
case TProject.TrackKindFor(FDragClip.Kind) of
tkAudio: FProject.AddTrackOfKind(FProject.UniqueTrackName('A'), tkAudio);
tkText: FProject.AddTrackOfKind(FProject.UniqueTrackName('Т'), tkText);
else
FProject.AddTrack(FProject.UniqueTrackName('V'));
end;
FTrackAddedDuringDrag := True;
Idx := FProject.TrackCount - 1;
if Assigned(FOnTrackAdded) then
FOnTrackAdded(Self);
end;
{ Перенос на другую дорожку: клип следует за указателем по
вертикали. Именно перенос, а не копирование.
На дорожку чужого вида клип не пускаем. Уплощение обходит
дорожки по видам, и клип, попавший не на свою, пропадает и из
сборки, и из предпросмотра — молча: на монтаже он нарисован, а
в ролике его нет. Проверено на живом проекте, где фотография
оказалась на текстовой дорожке. }
if (Idx >= 0) and (FProject <> nil) then
begin
TargetTrack := FProject.Tracks[Idx];
if (TargetTrack <> FDragTrack) and
(TargetTrack.Kind = TProject.TrackKindFor(FDragClip.Kind)) then
begin
FDragTrack.Extract(FDragClip);
TargetTrack.Add(FDragClip);
FDragTrack := TargetTrack;
end;
end;
FDragTrack.Sort;
Invalidate;
end;
end;
{ Прокрутка за кромкой окна.
Тянут клип к правому краю — монтаж едет следом, иначе при большом
увеличении кусок не вытащить дальше того, что видно. Скорость зависит
от того, насколько глубоко указатель в кромке: у самого края быстро, на
её границе еле-еле. Так прокруткой можно управлять, не отпуская клип.
Вне кромки не делается ничего: пока человек возит клип посередине
окна, монтаж обязан стоять. }
function TTimelineControl.ScrollByEdge(const AX: Integer): Boolean;
const
{ Ширина чувствительной полосы и предел скорости. }
EdgeMargin = 48;
MaxStepPixels = 24;
var
Depth, Step, Before: Double;
begin
Result := False;
if (FProject = nil) or (FPixelsPerSecond <= 0) then
Exit;
Depth := 0;
if AX < FHeaderWidth + EdgeMargin then
Depth := -(FHeaderWidth + EdgeMargin - AX)
else if AX > ClientWidth - EdgeMargin then
Depth := AX - (ClientWidth - EdgeMargin);
if Depth = 0 then
Exit;
{ Глубже кромки скорость не растёт: указатель легко уходит за окно на
сотни точек, и без предела монтаж улетал бы рывком. }
Step := Max(-EdgeMargin, Min(EdgeMargin, Depth)) / EdgeMargin;
Before := FScrollOffset;
FScrollOffset := FScrollOffset + Step * MaxStepPixels / FPixelsPerSecond;
ClampScroll;
Result := Abs(FScrollOffset - Before) > 1E-9;
end;
procedure TTimelineControl.EdgeTimerTick(Sender: TObject);
begin
if not (FAction in [taDragClip, taTrimIn, taTrimOut, taRubberBand]) then
begin
SetEdgeScroll(False);
Exit;
end;
if not ScrollByEdge(FEdgeX) then
Exit;
{ Монтаж уехал, а указатель стоит — значит под ним теперь другое время,
и клип должен последовать за ним. }
case FAction of
taDragClip: DragClipTo(FEdgeX, FEdgeY);
taRubberBand:
begin
FBandToTime := XToTime(Max(FHeaderWidth, Min(ClientWidth, FEdgeX)));
Invalidate;
end;
else
{ У краёв клипа своё движение, но пересчитывается оно там же, где и
от мыши: повторяем событие с теми же координатами. }
MouseMove([], FEdgeX, FEdgeY);
end;
end;
procedure TTimelineControl.SetEdgeScroll(AOn: Boolean; const AX: Integer;
const AY: Integer);
begin
FEdgeX := AX;
FEdgeY := AY;
if FEdgeTimer.Enabled <> AOn then
FEdgeTimer.Enabled := AOn;
end;
procedure TTimelineControl.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
@ -2769,6 +2935,8 @@ begin
Exit;
end;
SetEdgeScroll(False);
WasEditing := FAction in [taDragClip, taTrimIn, taTrimOut, taVolume,
taFadeIn, taFadeOut];
WasTrimIn := FAction = taTrimIn;
@ -2869,6 +3037,81 @@ end;
больше полкадра. }
function TTimelineControl.SplitAt(const ATime: Double;
APrecise: Boolean): Integer;
begin
Result := 0;
if FProject = nil then
Exit;
FProject.BeginChange;
Result := SplitAtCore(ATime, APrecise);
if Result > 0 then
StructureChanged
else
{ Ничего не разрезали — снимок отмены не нужен, откатываем его. }
FProject.Undo;
end;
function TTimelineControl.MakeRoomAt(const ATime, ALength: Double;
ASnapshot: Boolean): Integer;
var
T, C: Integer;
Track: TTrack;
Clip: TClip;
At, Half, Shift: Double;
begin
Result := 0;
if (FProject = nil) or (ALength <= 0) then
Exit;
At := QuantizeTime(ATime);
{ Сдвиг округляется один раз, и дальше складывается с началами как
есть. Округляй мы каждое начало по отдельности — клипы, стоявшие
встык, разъехались бы на доли кадра: каждое слагаемое село бы на свой
ближайший кадр. Проверено числами: встык стоявшие 20.000 и 30.000
превращались в 20.003 и 25.008, и между ними появлялась дыра. }
Shift := QuantizeTime(ALength);
if Shift <= 0 then
Exit;
if ASnapshot then
FProject.BeginChange;
{ Сперва рез, потом сдвиг. В обратном порядке клип, накрывающий точку
вставки, уехал бы целиком, и перед ним осталась бы дыра в его
собственную длину. }
SplitAtCore(At, False);
{ Полкадра допуска: клип, начинающийся ровно в точке вставки, двигать
надо. Сравнение с точностью до доли кадра отнесло бы его то к одной
стороне, то к другой — в зависимости от округления. }
Half := 0.001;
if (FProject.Master.FpsNum > 0) and (FProject.Master.FpsDen > 0) then
Half := FProject.Master.FpsDen / FProject.Master.FpsNum / 2;
for T := 0 to FProject.TrackCount - 1 do
begin
Track := FProject.Tracks[T];
for C := 0 to Track.Count - 1 do
begin
Clip := Track[C];
if Clip.TlStart < At - Half then
Continue;
Clip.TlStart := Clip.TlStart + Shift;
Inc(Result);
end;
Track.Sort;
end;
if Result > 0 then
FProject.Modified := True;
end;
{ Сам рез, без снимка для отмены и без сообщения о правке.
Отдельно от SplitAt он нужен раздвижке монтажа: она режет, двигает и
кладёт клип — и всё это одно действие, с одним снимком и одним
сообщением в конце. }
function TTimelineControl.SplitAtCore(const ATime: Double;
APrecise: Boolean): Integer;
var
T: Integer;
Track: TTrack;
@ -2884,7 +3127,6 @@ begin
Exit;
At := QuantizeTime(ATime);
FProject.BeginChange;
NewGroups := TStringList.Create;
try
@ -2960,12 +3202,6 @@ begin
finally
NewGroups.Free;
end;
if Result > 0 then
StructureChanged
else
{ Ничего не разрезали — снимок отмены не нужен, откатываем его. }
FProject.Undo;
end;
{ Режим выделения: рамкой по клипам или промежутком по времени.

143
tests/dragscroll.sh Executable file
View file

@ -0,0 +1,143 @@
#!/bin/sh
# Монтаж едет следом, пока тащишь клип у кромки окна.
#
# При большом увеличении видно секунды, а двигать кусок надо на минуты.
# Если монтаж не прокручивается, клип упирается в край окна и дальше не
# идёт: приходится отпускать, прокручивать, брать снова — и так десятки
# раз.
#
# Проверяется так: монтаж из одного клипа, сильное увеличение, клип
# тащится к правому краю и там удерживается на месте. Рука стоит, значит
# двигать может только прокрутка. Результат читается из сохранённого
# проекта, а не с картинки.
#
# Запуск (экран :99 поднят):
# tests/dragscroll.sh [<путь к nlve>]
set -e
cd "$(dirname "$0")/.."
BIN=${1:-$PWD/nlve}
DISP=${NLVE_DISPLAY:-:99}
SRC=$PWD/test/поток/пара.nlve
PROJ=$PWD/test/поток/прокрутка.nlve
[ -f "$SRC" ] || { echo "нет монтажа $SRC"; exit 2; }
# Невидимый экран поднят через xvfb-run, у него свой файл доступа, а в
# окружении обычно лежит файл рабочего экрана. С чужим файлом xdotool не
# видит ни одного окна, и проверка «проходит» вслепую, ничего не проверив.
export DISPLAY=$DISP
reachable() { timeout 5 xdotool getdisplaygeometry >/dev/null 2>&1; }
if ! reachable; then
for p in $(pgrep -x Xvfb); do
A=$(tr '\0' '\n' < /proc/$p/cmdline | grep -A1 -x -- -auth | tail -1)
[ -f "$A" ] || continue
XAUTHORITY=$A; export XAUTHORITY
reachable && break
done
fi
reachable ||
{ echo "нет доступа к экрану $DISP: подними его (xvfb-run) и повтори"; exit 2; }
# Монтаж из одного клипа: второй убран, чтобы перетаскивание ни на кого
# не наезжало и не заказывало переход.
python3 - "$SRC" "$PROJ" <<'PY'
import json, sys
d = json.load(open(sys.argv[1]))
keep = None
for t in d['tracks']:
for c in t['clips']:
if c['kind'] == 'video' and c['tl_start'] < 0.001:
keep = c.get('group')
for t in d['tracks']:
t['clips'] = [c for c in t['clips'] if c.get('group') == keep]
json.dump(d, open(sys.argv[2], 'w'), ensure_ascii=False)
PY
for p in $(pgrep -x nlve); do
tr '\0' '\n' < /proc/$p/environ 2>/dev/null | grep -qx "DISPLAY=$DISP" && kill $p
done
sleep 1
rm -rf test/поток/профиль-прокрутка
mkdir -p test/поток/профиль-прокрутка
rm -f "$PROJ.autosave"
SP=$PWD/test/поток/профиль-прокрутка
XDG_CONFIG_HOME=$SP XDG_CACHE_HOME=$SP XDG_DATA_HOME=$SP DISPLAY=$DISP \
setsid "$BIN" "$PROJ" >/dev/null 2>&1 < /dev/null &
sleep 14
X="timeout 8 xdotool"
# Окно ищем по имени монтажа и проверяем, что оно на экране. По одному
# «nlve» находятся и обломки прошлых запусков: они невидимы, нажатия в
# них уходят в никуда, и проверка молча показывает «ничего не двинулось».
WID=
for w in $($X search --name "прокрутка.nlve" 2>/dev/null); do
xwininfo -id "$w" 2>/dev/null | grep -q IsViewable && { WID=$w; break; }
done
[ -n "$WID" ] || { echo "живое окно редактора не найдено"; exit 2; }
# Экран невидимый и узкий: окно должно влезть целиком, иначе правый край
# окажется за границей экрана и указатель до кромки не доедет.
$X windowmove "$WID" 0 0 windowsize "$WID" 1270 990
sleep 2
start() {
$X key ctrl+s
sleep 2
python3 -c "
import json
d = json.load(open('$PROJ'))
for t in d['tracks']:
for c in t['clips']:
if c['kind'] == 'video':
print('%.3f' % c['tl_start']); raise SystemExit
print('0')
"
}
echo " начало клипа до правок: $(start) с"
ROW=${NLVE_ROW:-505} # высота видеодорожки в окне
GRAB=${NLVE_GRAB:-650} # точка захвата внутри клипа (клип начинается с 588)
EDGE=1255 # кромка у правого края окна
# Увеличение: шесть щелчков колесом с Ctrl, опора в точке захвата, чтобы
# клип из-под указателя не уехал.
I=0
while [ $I -lt 6 ]; do
$X mousemove $GRAB $ROW
$X keydown ctrl click 4 keyup ctrl
sleep 0.3
I=$((I + 1))
done
sleep 1
# Берём клип и тащим к правому краю, где и держим: рука стоит, едет
# только прокрутка.
$X mousemove $GRAB $ROW mousedown 1
sleep 0.3
$X mousemove 800 $ROW
sleep 0.3
$X mousemove $EDGE $ROW
sleep 6
$X mouseup 1
sleep 2
MOVED=$(start)
echo " начало клипа после перетаскивания с удержанием: $MOVED с"
for p in $(pgrep -x nlve); do
tr '\0' '\n' < /proc/$p/environ 2>/dev/null | grep -qx "DISPLAY=$DISP" && kill $p
done
rm -f "$PROJ.autosave"
python3 -c "
moved = $MOVED
# После шести щелчков колесом в окне видно около полутора секунд монтажа.
# Указатель доезжает до кромки и встаёт, поэтому без прокрутки клип
# уезжает на эти полторы секунды и больше никуда. С прокруткой за шесть
# секунд удержания набегает втрое больше. Порог стоит между измеренными
# величинами: 1.1 с на сборке без прокрутки, 3+ с с прокруткой.
if moved < 2.5:
print(' ПЛОХО: клип уехал всего на %.3f с — монтаж не прокручивался' % moved)
raise SystemExit(1)
print(' ok: клип уехал на %.3f с, дальше видимой части' % moved)
"

117
tests/genquiet.sh Executable file
View file

@ -0,0 +1,117 @@
#!/bin/sh
# Тяжёлая сборка начинается не сразу, а когда правка закончилась.
#
# Наезд двух клипов на одной дорожке — это заказ на переход, и считается
# он минутами. Пока человек подбирает место, заказ меняется каждым
# движением руки, и начатая работа уходит в корзину. Поэтому список
# кусков пересобирается сразу (монтаж обязан показывать правду), а вот
# ffmpeg запускается, когда монтаж постоял тихо.
#
# Проверяется так: клип тащится на соседа, создавая наезд. С момента,
# когда кнопку отпустили, считается время до первой команды ffmpeg в
# журнале. Оно обязано быть близко к заданной тишине, но работа всё-таки
# обязана начаться — отложить не значит забыть.
#
# Журнал только читается: усечь его значит снести запись чужой работы.
#
# Запуск (экран :99 поднят):
# tests/genquiet.sh [<путь к nlve>]
set -e
cd "$(dirname "$0")/.."
BIN=${1:-$PWD/nlve}
DISP=${NLVE_DISPLAY:-:99}
SRC=$PWD/test/поток/пара.nlve
PROJ=$PWD/test/поток/тишина.nlve
LOG=$(dirname "$BIN")/nlve.log
[ -f "$SRC" ] || { echo "нет монтажа $SRC"; exit 2; }
export DISPLAY=$DISP
reachable() { timeout 5 xdotool getdisplaygeometry >/dev/null 2>&1; }
if ! reachable; then
for p in $(pgrep -x Xvfb); do
A=$(tr '\0' '\n' < /proc/$p/cmdline | grep -A1 -x -- -auth | tail -1)
[ -f "$A" ] || continue
XAUTHORITY=$A; export XAUTHORITY
reachable && break
done
fi
reachable ||
{ echo "нет доступа к экрану $DISP: подними его (xvfb-run) и повтори"; exit 2; }
cp "$SRC" "$PROJ"
for p in $(pgrep -x nlve); do
tr '\0' '\n' < /proc/$p/environ 2>/dev/null | grep -qx "DISPLAY=$DISP" && kill $p
done
sleep 1
SP=$PWD/test/поток/профиль-тишина
rm -rf "$SP"; mkdir -p "$SP"
rm -rf "$PROJ-cache"
rm -f "$PROJ.autosave"
XDG_CONFIG_HOME=$SP XDG_CACHE_HOME=$SP XDG_DATA_HOME=$SP \
setsid "$BIN" "$PROJ" >/dev/null 2>&1 < /dev/null &
sleep 14
X="timeout 8 xdotool"
WID=
for w in $($X search --name "тишина.nlve" 2>/dev/null); do
xwininfo -id "$w" 2>/dev/null | grep -q IsViewable && { WID=$w; break; }
done
[ -n "$WID" ] || { echo "живое окно редактора не найдено"; exit 2; }
$X windowmove "$WID" 0 0 windowsize "$WID" 1270 990
sleep 3
ROW=${NLVE_ROW:-505}
# Сколько команд ffmpeg в журнале сейчас. Считаем строки, а не чистим
# файл: журнал общий, и усечение уносит чужую работу.
runs() { grep -c '^> .*ffmpeg' "$LOG" 2>/dev/null || echo 0; }
BEFORE=$(runs)
echo " команд в журнале до правки: $BEFORE"
# Тащим первый клип вправо на соседа: наезд примерно в секунду.
$X mousemove 650 $ROW mousedown 1
sleep 0.3
$X mousemove 670 $ROW
sleep 0.3
$X mousemove 683 $ROW
sleep 0.3
$X mouseup 1
# С этой точки отсчёт. Опрашиваем журнал почаще, чтобы поймать момент
# запуска, а не ждать наугад.
T0=$(date +%s.%N)
WAITED=0
while [ "$WAITED" -lt 60 ]; do
N=$(runs)
[ "$N" -gt "$BEFORE" ] && break
sleep 0.2
WAITED=$((WAITED + 1))
done
T1=$(date +%s.%N)
AFTER=$(runs)
for p in $(pgrep -x nlve); do
tr '\0' '\n' < /proc/$p/environ 2>/dev/null | grep -qx "DISPLAY=$DISP" && kill $p
done
pkill -f "тишина.nlve-cache" 2>/dev/null || true
rm -f "$PROJ.autosave"
python3 -c "
задержка = $T1 - $T0
было, стало = $BEFORE, $AFTER
print(' команд после правки: %d, пауза до запуска: %.2f с' % (стало, задержка))
if стало <= было:
print(' ПЛОХО: сборка не началась вовсе — отложить не значит забыть')
raise SystemExit(1)
# Задано полторы секунды тишины. Нижняя граница с запасом на разброс
# опроса, верхняя — чтобы отложенное не превратилось в забытое.
if задержка < 1.2:
print(' ПЛОХО: сборка началась через %.2f с — правку не дождались'
% задержка)
raise SystemExit(1)
if задержка > 6:
print(' ПЛОХО: сборка началась только через %.2f с' % задержка)
raise SystemExit(1)
print(' ok: сборка дождалась конца правки и всё-таки началась')
"

158
tests/insertat.sh Executable file
View file

@ -0,0 +1,158 @@
#!/bin/sh
# Файл из списка встаёт на курсор, а не в конец дорожки.
#
# Раньше клип падал в самый конец, стоило месту под ним оказаться
# занятым, — а оно занято почти всегда: клип длиной в целый файл упирается
# хвостом в то, что правее, даже когда начало легло в свободное место.
# Потом человек тащил его на нужное время и получал наезд, то есть заказ
# на сборку перехода.
#
# Проверяется так: курсор ставится посреди первого клипа, файл из списка
# добавляется на ту же дорожку. Клип обязан встать на курсор, монтаж —
# раздвинуться ровно на его длину, наездов и дыр появиться не должно.
# Всё читается из сохранённого проекта, а не с картинки.
#
# Запуск (экран :99 поднят):
# tests/insertat.sh [<путь к nlve>]
set -e
cd "$(dirname "$0")/.."
BIN=${1:-$PWD/nlve}
DISP=${NLVE_DISPLAY:-:99}
SRC=$PWD/test/поток/пара.nlve
PROJ=$PWD/test/поток/вставка.nlve
[ -f "$SRC" ] || { echo "нет монтажа $SRC"; exit 2; }
# Невидимый экран поднят через xvfb-run, у него свой файл доступа, а в
# окружении обычно лежит файл рабочего экрана. С чужим файлом xdotool не
# видит ни одного окна, и проверка «проходит» вслепую, ничего не проверив.
export DISPLAY=$DISP
reachable() { timeout 5 xdotool getdisplaygeometry >/dev/null 2>&1; }
if ! reachable; then
for p in $(pgrep -x Xvfb); do
A=$(tr '\0' '\n' < /proc/$p/cmdline | grep -A1 -x -- -auth | tail -1)
[ -f "$A" ] || continue
XAUTHORITY=$A; export XAUTHORITY
reachable && break
done
fi
reachable ||
{ echo "нет доступа к экрану $DISP: подними его (xvfb-run) и повтори"; exit 2; }
cp "$SRC" "$PROJ"
for p in $(pgrep -x nlve); do
tr '\0' '\n' < /proc/$p/environ 2>/dev/null | grep -qx "DISPLAY=$DISP" && kill $p
done
sleep 1
SP=$PWD/test/поток/профиль-вставка
rm -rf "$SP"; mkdir -p "$SP"
rm -f "$PROJ.autosave"
XDG_CONFIG_HOME=$SP XDG_CACHE_HOME=$SP XDG_DATA_HOME=$SP \
setsid "$BIN" "$PROJ" >/dev/null 2>&1 < /dev/null &
sleep 14
X="timeout 8 xdotool"
# Окно ищем по имени монтажа и проверяем, что оно на экране: по одному
# «nlve» находятся и обломки прошлых запусков, нажатия в них уходят в
# никуда, и проверка молча показывает «ничего не произошло».
WID=
for w in $($X search --name "вставка.nlve" 2>/dev/null); do
xwininfo -id "$w" 2>/dev/null | grep -q IsViewable && { WID=$w; break; }
done
[ -n "$WID" ] || { echo "живое окно редактора не найдено"; exit 2; }
$X windowmove "$WID" 0 0 windowsize "$WID" 1270 990
sleep 2
$X mousemove 700 466 click 1 # курсор воспроизведения — посреди первого клипа
sleep 1
$X mousemove 200 512 click 1 # выбрать файл в списке проекта
sleep 1
# Меню списка: «Добавить на дорожку» — первый пункт, в подменю первой
# стоит V1, она же и нужна.
$X click 3
sleep 1.5
$X key Down; sleep 0.5
$X key Right; sleep 0.5
$X key Return; sleep 2
$X key ctrl+s
sleep 2
for p in $(pgrep -x nlve); do
tr '\0' '\n' < /proc/$p/environ 2>/dev/null | grep -qx "DISPLAY=$DISP" && kill $p
done
rm -f "$PROJ.autosave"
python3 - "$SRC" "$PROJ" <<'PY'
import json, sys
def clips(path, track):
d = json.load(open(path))
for t in d['tracks']:
if t['name'] == track:
return sorted(t['clips'], key=lambda c: c['tl_start'])
return []
было = clips(sys.argv[1], 'V1')
стало = clips(sys.argv[2], 'V1')
звук = clips(sys.argv[2], 'A1')
плохо = 0
медиа = {c['media'] for c in было}
новые = [c for c in стало if c['media'] not in медиа]
if len(новые) != 1:
print(' ПЛОХО: вставленный клип не найден (новых клипов %d)' % len(новые))
raise SystemExit(1)
новый = новые[0]
конец_было = max(c['tl_start'] + c['duration'] for c in было)
print(' вставленный клип: старт %.3f с, длина %.3f с' %
(новый['tl_start'], новый['duration']))
if новый['tl_start'] > конец_было - 0.001:
print(' ПЛОХО: клип упал в конец дорожки (%.3f с), а не на курсор'
% новый['tl_start'])
плохо = 1
elif новый['tl_start'] < 0.5:
print(' ПЛОХО: клип встал в начало, курсор был посреди первого клипа')
плохо = 1
else:
print(' ok: клип встал на курсор, внутри материала')
# Соседи отъехали ровно на длину вставки: монтаж раздвинулся, а не
# затёрся и не разъехался.
сдвиг = новый['duration']
последний_было = было[-1]
последний_стало = стало[-1]
ожидалось = последний_было['tl_start'] + сдвиг
if abs(последний_стало['tl_start'] - ожидалось) > 0.001:
print(' ПЛОХО: последний клип на %.3f с, ожидалось %.3f с'
% (последний_стало['tl_start'], ожидалось))
плохо = 1
else:
print(' ok: монтаж раздвинут ровно на длину вставки (%.3f с)' % сдвиг)
# Наезд на одной дорожке — это заказ на переход. Его тут быть не должно.
for имя, список in (('V1', стало), ('A1', звук)):
for a, b in zip(список, список[1:]):
зазор = b['tl_start'] - (a['tl_start'] + a['duration'])
if зазор < -0.001:
print(' ПЛОХО: наезд на %s в %.3f с (%.3f с)'
% (имя, b['tl_start'], -зазор))
плохо = 1
elif зазор > 0.001:
print(' ПЛОХО: дыра на %s в %.3f с (%.3f с)'
% (имя, a['tl_start'] + a['duration'], зазор))
плохо = 1
if not плохо:
print(' ok: ни наездов, ни дыр')
# Звук обязан уехать вместе с картинкой, иначе синхрон рассыплется.
if [round(c['tl_start'], 3) for c in звук] != [round(c['tl_start'], 3) for c in стало]:
print(' ПЛОХО: звук разошёлся с картинкой')
print(' картинка: %s' % ['%.3f' % c['tl_start'] for c in стало])
print(' звук: %s' % ['%.3f' % c['tl_start'] for c in звук])
плохо = 1
else:
print(' ok: звук уехал вместе с картинкой')
raise SystemExit(плохо)
PY

162
tests/lfmcheck/lfmcheck.lpr
View file

@ -637,6 +637,166 @@ end;
Раньше курсор оставался там, где был, а рез мог попасть на долю кадра.
Теперь рез кладётся на кадровую сетку, а курсор встаёт ровно на место
реза — с ним и работают дальше. }
{ Раздвижка монтажа под вставку.
Клип из списка файлов встаёт туда, где стоит курсор, а не в конец
дорожки. Место под ним освобождается: клип, накрывающий точку вставки,
режется, и всё от этой точки правее едет вправо на длину нового — на
всех дорожках сразу, иначе звук отстанет от картинки. }
procedure CheckMakeRoom;
var
Proj: TProject;
Info: TMediaInfo;
Media: TMediaItem;
Timeline: TTimelineControl;
Moved, I: Integer;
Gaps, Overlaps: Integer;
Step, At, Shift: Double;
Track: TTrack;
begin
WriteLn;
WriteLn('Раздвижка монтажа под вставку');
WriteLn;
Info := TestInfo;
Info.FpsNum := 60000;
Info.FpsDen := 1001;
Proj := TProject.Create;
Timeline := TTimelineControl.Create(nil);
try
Proj.Clear;
Proj.AddTrack('V1');
Proj.AddTrackOfKind('A1', tkAudio);
Media := Proj.AddMedia('/несуществующий/видео.mp4', Info);
Proj.Master := Info;
{ Три клипа встык на картинке и столько же на звуке: 0..10, 10..20,
20..30. }
for I := 0 to 2 do
begin
Proj.AddClip(Proj.Tracks[0], Media, 0, 10, I * 10);
Proj.AddClip(Proj.Tracks[1], Media, 0, 10, I * 10);
end;
Timeline.Project := Proj;
{ Вставляем пять секунд посреди второго клипа.
Ожидаемое считается по той же кадровой сетке, а не круглыми
числами: при 60000/1001 ни 15, ни 5 на кадр не попадают, и точка
реза с величиной сдвига садятся на ближайшие кадры. }
Step := Info.FpsDen / Info.FpsNum;
At := Round(15 / Step) * Step;
Shift := Round(5 / Step) * Step;
Moved := Timeline.MakeRoomAt(15, 5);
CheckTrue('что-то отодвинуто: ' + IntToStr(Moved), Moved >= 4);
CheckTrue('второй клип разошёлся надвое: клипов стало ' +
IntToStr(Proj.Tracks[0].Count), Proj.Tracks[0].Count = 4);
CheckTrue('звук разошёлся так же', Proj.Tracks[1].Count = 4);
{ Голова второго клипа осталась на месте, хвост уехал ровно на пять. }
CheckTrue('голова на месте: ' + SecondsToStr(Proj.Tracks[0][1].TlStart),
Abs(Proj.Tracks[0][1].TlStart - 10) < 0.001);
CheckTrue('хвост отъехал на длину вставки: ' +
SecondsToStr(Proj.Tracks[0][2].TlStart),
Abs(Proj.Tracks[0][2].TlStart - (At + Shift)) < 0.001);
CheckTrue('третий клип отъехал на столько же: ' +
SecondsToStr(Proj.Tracks[0][3].TlStart),
Abs(Proj.Tracks[0][3].TlStart - (20 + Shift)) < 0.001);
CheckTrue('звук уехал вместе с картинкой',
Abs(Proj.Tracks[1][2].TlStart - (At + Shift)) < 0.001);
CheckTrue('освобождено ровно столько, сколько просили: ' +
SecondsToStr(Proj.Tracks[0][2].TlStart - Proj.Tracks[0][1].TlEnd),
Abs((Proj.Tracks[0][2].TlStart - Proj.Tracks[0][1].TlEnd) - Shift)
< 0.001);
{ В освобождённом месте никого нет, и больше нигде не появилось ни
дыр, ни наездов. }
CheckTrue('место освобождено', Proj.Tracks[0].ClipAt(At + 1) = nil);
Gaps := 0;
Overlaps := 0;
for I := 0 to Proj.TrackCount - 1 do
begin
Track := Proj.Tracks[I];
for Moved := 0 to Track.Count - 2 do
if Track[Moved].TlEnd > Track[Moved + 1].TlStart + 0.001 then
Inc(Overlaps)
else if (Track[Moved].TlEnd < Track[Moved + 1].TlStart - 0.001) and
(Abs(Track[Moved].TlEnd - At) > 0.001) then
Inc(Gaps);
end;
CheckTrue('наездов не появилось', Overlaps = 0);
CheckTrue('лишних дыр не появилось', Gaps = 0);
{ Вставка в свободное место за концом монтажа ничего не двигает. }
Moved := Timeline.MakeRoomAt(100, 5);
CheckTrue('за концом монтажа двигать нечего', Moved = 0);
finally
Timeline.Free;
Proj.Free;
end;
end;
{ Клип притягивается к границе и хвостом, а не только головой.
Подводят кусок к началу соседа слева: голова встаёт в свободное место,
а хвост при этом накрывает соседа. Наезд на одной дорожке — это заказ
на переход, то есть минуты сборки из-за промаха на полпикселя. }
procedure CheckSnapTail;
var
Proj: TProject;
Info: TMediaInfo;
Media: TMediaItem;
Timeline: TTimelineControl;
Mover: TClip;
Got: Double;
begin
WriteLn;
WriteLn('Прилипание хвостом');
WriteLn;
Info := TestInfo;
Info.FpsNum := 60000;
Info.FpsDen := 1001;
Proj := TProject.Create;
Timeline := TTimelineControl.Create(nil);
try
Proj.Clear;
Proj.AddTrack('V1');
Media := Proj.AddMedia('/несуществующий/видео.mp4', Info);
Proj.Master := Info;
{ Сосед занимает 20..30, двигаемый длиной 4 стоит пока в сторонке. }
Proj.AddClip(Proj.Tracks[0], Media, 0, 10, 20);
Mover := Proj.AddClip(Proj.Tracks[0], Media, 0, 4, 50);
Timeline.Project := Proj;
Timeline.PixelsPerSecond := 10; { допуск прилипания — 1.2 с }
{ Голова метит в 15.7, хвост при этом пришёлся бы на 19.7 — почти
встык с соседом. Правильный ответ: 16, тогда хвост ровно на 20. }
Got := Timeline.SnapTime(15.7, Mover, Mover.Duration);
CheckTrue('хвост сел на начало соседа: ' + SecondsToStr(Got),
Abs(Got - 16) < 0.001);
{ Голова у границы по-прежнему липнет головой: там ближе она. }
Got := Timeline.SnapTime(19.8, Mover, Mover.Duration);
CheckTrue('голова села на начало соседа: ' + SecondsToStr(Got),
Abs(Got - 20) < 0.001);
{ Без длины поведение прежнее: хвост не рассматривается. }
Got := Timeline.SnapTime(15.7, Mover);
CheckTrue('без длины притяжения хвостом нет: ' + SecondsToStr(Got),
Abs(Got - 15.7) < 0.001);
{ Хвост липнет и к концу соседа: клип встаёт вплотную справа. }
Got := Timeline.SnapTime(25.8, Mover, Mover.Duration);
CheckTrue('хвост сел на конец соседа: ' + SecondsToStr(Got),
Abs(Got - 26) < 0.001);
finally
Timeline.Free;
Proj.Free;
end;
end;
procedure CheckSplitAndPlayhead;
var
Proj: TProject;
@ -994,6 +1154,8 @@ begin
CheckRubberBand;
CheckFrameGridRepair;
CheckSplitAndPlayhead;
CheckMakeRoom;
CheckSnapTail;
CheckSplitAllTracks;
CheckGapTolerance;
CheckSourceRect;