diff --git a/README.md b/README.md index 9fb31d1..88b5d69 100644 --- a/README.md +++ b/README.md @@ -76,10 +76,11 @@ xdg-mime query default application/x-nlve-project |---|---| | Пуск и пауза | Пробел | | В начало / конец монтажа | Home / End | -| Разрезать по курсору | S | +| Разрезать по курсору (все дорожки) | S | | Разрезать точно (перекодирует стык) | Shift+S | | Удалить выделенное | Delete | | Выделить всё | Ctrl+A | +| Выделить областью | протяжка по пустому месту дорожек | | Схлопнуть дыру под курсором | Ctrl+Shift+R | | Отменить, повторить | Ctrl+Z, Ctrl+Y | | Масштаб таймлайна | Ctrl + колесо мыши | diff --git a/src/uMainForm.pas b/src/uMainForm.pas index cc5d244..33952f8 100644 --- a/src/uMainForm.pas +++ b/src/uMainForm.pas @@ -215,6 +215,8 @@ type плеер туда никогда не доедет, и курсор переставал двигаться совсем. } FSeekWaitTicks: Integer; + { До какого времени ответ на команду держится в строке состояния. } + FStatusHoldUntil: TDateTime; procedure ApplyVolumeAt(const ATime: Double); { Переписывает файл субтитров и отдаёт его плееру. } @@ -290,7 +292,9 @@ type procedure RemindAboutDeps; procedure Log(const AText: string); procedure LogToFile(const AText: string); - procedure SetStatus(const AText: string); + { AAnswer — это ответ на команду человека, а не проходное сообщение: + такой ответ держится в строке несколько секунд. } + procedure SetStatus(const AText: string; AAnswer: Boolean = False); procedure UpdateCaption; procedure UpdateTimeLabel; procedure RefreshPool; @@ -407,6 +411,10 @@ const Сообщения приходят на каждый кадр, так что это доли секунды. } MaxSeekWaitTicks = 90; + { Сколько ответ на команду держится в строке состояния, не давая себя + затереть проходным сообщением. Четыре секунды — успеть прочесть. } + StatusHoldTime = 4 / (24 * 60 * 60); + function FormatTimecode(const Seconds: Double): string; var Total, H, M, S, Ms: Integer; @@ -1366,8 +1374,23 @@ begin LogToFile(AText); end; -procedure TMainForm.SetStatus(const AText: string); +{ Строка состояния — единственное место, где программа отвечает на + команду. Ответ команды нельзя затирать проходным сообщением: пересборка + предпросмотра случается после каждой правки и приходит через долю + секунды после нажатия, так что «Разрезано 3 клипа» человек просто не + успевал прочесть. + + Поэтому у ответа на команду есть небольшой срок, в течение которого + проходные сообщения его не трогают. Другой ответ на команду его + заменяет сразу: свежий ответ важнее прежнего. } +procedure TMainForm.SetStatus(const AText: string; AAnswer: Boolean); begin + if (not AAnswer) and (FStatusHoldUntil > Now) then + Exit; + if AAnswer then + FStatusHoldUntil := Now + StatusHoldTime + else + FStatusHoldUntil := 0; lblStatus.Caption := AText; end; @@ -2390,7 +2413,7 @@ begin SchedulePreview; UpdateCaption; Log(Format('Перенесено на подходящие дорожки: %d.', [N])); - SetStatus(Format('Перенесено клипов: %d.', [N])); + SetStatus(Format('Перенесено клипов: %d.', [N]), True); end; procedure TMainForm.UpdateRippleButton; @@ -2489,10 +2512,10 @@ begin if FSettings.CenterPlayhead then begin FTimeline.ScrollToPlayhead(True); - SetStatus('Курсор держится посередине монтажа.'); + SetStatus('Курсор держится посередине монтажа.', True); end else - SetStatus('Монтаж стоит на месте, курсор идёт по нему.'); + SetStatus('Монтаж стоит на месте, курсор идёт по нему.', True); end; procedure TMainForm.btnCenterClick(Sender: TObject); @@ -2505,9 +2528,9 @@ begin FProject.RippleEnabled := not FProject.RippleEnabled; UpdateRippleButton; if FProject.RippleEnabled then - SetStatus('Автосхлопывание включено: клипы правее едут вместе с перетаскиваемым.') + SetStatus('Автосхлопывание включено: клипы правее едут вместе с перетаскиваемым.', True) else - SetStatus('Автосхлопывание выключено: клипы правее остаются на месте.'); + SetStatus('Автосхлопывание выключено: клипы правее остаются на месте.', True); end; procedure TMainForm.btnRippleClick(Sender: TObject); @@ -2554,9 +2577,9 @@ begin UpdateCaption; if FProject.HasRegion then SetStatus(Format('Участок: %s — %s', - [SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)])) + [SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)]), True) else - SetStatus('Отметки участка сняты: собирается весь монтаж.'); + SetStatus('Отметки участка сняты: собирается весь монтаж.', True); end; procedure TMainForm.BuildTrackMenu; @@ -2608,7 +2631,7 @@ begin FProject.BeginChange; FProject.MoveTrack(FTrackMenuIndex, FTrackMenuIndex - 1); TimelineStructureChange(nil); - SetStatus('Дорожка поднята.'); + SetStatus('Дорожка поднята.', True); end; procedure TMainForm.TrackMenuDown(Sender: TObject); @@ -2618,7 +2641,7 @@ begin FProject.BeginChange; FProject.MoveTrack(FTrackMenuIndex, FTrackMenuIndex + 1); TimelineStructureChange(nil); - SetStatus('Дорожка опущена.'); + SetStatus('Дорожка опущена.', True); end; { Удаление дорожки. С клипами — только с подтверждением: вместе с @@ -2643,7 +2666,7 @@ begin FProject.EnsureUniqueTrackNames; FTimeline.Invalidate; UpdateCaption; - SetStatus('Дорожка названа: ' + FProject.Tracks[ATrackIndex].Name); + SetStatus('Дорожка названа: ' + FProject.Tracks[ATrackIndex].Name, True); end; procedure TMainForm.TrackMenuRename(Sender: TObject); @@ -2673,7 +2696,7 @@ begin FProject.BeginChange; FProject.RemoveTrack(FTrackMenuIndex); TimelineStructureChange(nil); - SetStatus('Дорожка ' + TrackName + ' удалена.'); + SetStatus('Дорожка ' + TrackName + ' удалена.', True); end; { --- Меню библиотеки --- } @@ -2818,7 +2841,7 @@ begin SchedulePreview; UpdateCaption; SetStatus(Format('Убрано %d %s', - [Removed, Plural(Removed, 'клип', 'клипа', 'клипов')])); + [Removed, Plural(Removed, 'клип', 'клипа', 'клипов')]), True); end; { Кадрирование отдельного клипа. Вызывается кнопкой в углу клипа. @@ -2917,7 +2940,7 @@ begin end; UpdateCaption; SchedulePreview; - SetStatus('Кадрирование обновлено: ' + FitModeCaption(T.Fit)); + SetStatus('Кадрирование обновлено: ' + FitModeCaption(T.Fit), True); end; procedure TMainForm.MenuProjectInfo(Sender: TObject); @@ -3169,7 +3192,7 @@ end; procedure TMainForm.TimelineSelectionChange(Sender: TObject); begin SetStatus(Format('Выделено %d %s', [FProject.SelectedCount, - Plural(FProject.SelectedCount, 'клип', 'клипа', 'клипов')])); + Plural(FProject.SelectedCount, 'клип', 'клипа', 'клипов')]), True); end; procedure TMainForm.PlayerLog(Sender: TObject; const APrefix, ALevel, AText: string); @@ -3189,6 +3212,15 @@ begin (FSeekWaitTicks < MaxSeekWaitTicks) then Exit; FSeekPending := False; + { Ждать перестали, а плеер так и не доехал. На паузе это значит, что + курсор надо оставить там, куда его поставил человек: при перезагрузке + списка кусков mpv сбрасывает отсчёт времени («Reset playback due to + audio timestamp reset») и сообщает что угодно, вплоть до конца + монтажа. Раньше курсор туда и улетал после каждой правки — например + после схлопывания дыры, и следующее схлопывание приходилось начинать + с прицеливания мышью заново. } + if FPlayer.Paused and (Abs(FPlayer.TimePos - FSeekTarget) > 0.35) then + Exit; end; { Обновляем курсор только при заметном сдвиге: mpv сообщает позицию на @@ -3441,7 +3473,7 @@ begin FTimeline.Invalidate; SchedulePreview; UpdateCaption; - SetStatus('Отменено.'); + SetStatus('Отменено.', True); end; procedure TMainForm.MenuRedo(Sender: TObject); @@ -3456,18 +3488,36 @@ begin FTimeline.Invalidate; SchedulePreview; UpdateCaption; - SetStatus('Повторено.'); + SetStatus('Повторено.', True); +end; + +{ Рез отчитывается числом. Молчание после нажатия клавиши читается как + «она не работает»: именно так выглядел рез, когда курсор стоял на стыке + или на пустом месте. } +function SplitReport(ACount: Integer): string; +begin + if ACount = 0 then + Result := 'Резать нечего: под курсором нет клипов или он ровно на стыке.' + else + Result := Format('Разрезано %d %s.', [ACount, + Plural(ACount, 'клип', 'клипа', 'клипов')]); end; procedure TMainForm.MenuSplit(Sender: TObject); begin - FTimeline.SplitAtPlayhead(False, True); + SetStatus(SplitReport(FTimeline.SplitAtPlayhead(False)), True); end; procedure TMainForm.MenuSplitPrecise(Sender: TObject); +var + Count: Integer; begin - FTimeline.SplitAtPlayhead(True, True); - SetStatus('Точный рез: стык будет перекодирован при сборке.'); + Count := FTimeline.SplitAtPlayhead(True); + if Count > 0 then + SetStatus(SplitReport(Count) + + ' Точный рез: стык будет перекодирован при сборке.', True) + else + SetStatus(SplitReport(Count), True); end; procedure TMainForm.MenuDelete(Sender: TObject); @@ -3527,9 +3577,9 @@ begin SchedulePreview; UpdateCaption; if Key.Enabled then - SetStatus('Цветовой ключ включён: участок будет пересобран.') + SetStatus('Цветовой ключ включён: участок будет пересобран.', True) else - SetStatus('Цветовой ключ выключен.'); + SetStatus('Цветовой ключ выключен.', True); end; { Отметки участка. @@ -3622,7 +3672,7 @@ begin end; SetStatus(Format('Скопировано %d %s. Вставить: Ctrl+V.', - [Taken.Count, Plural(Taken.Count, 'клип', 'клипа', 'клипов')])); + [Taken.Count, Plural(Taken.Count, 'клип', 'клипа', 'клипов')]), True); finally Taken.Free; end; @@ -3725,7 +3775,7 @@ begin UpdateCaption; SetStatus(Format('Вставлено %d %s.', [FClipboard.Count, - Plural(FClipboard.Count, 'клип', 'клипа', 'клипов')])); + Plural(FClipboard.Count, 'клип', 'клипа', 'клипов')]), True); end; { Первый выделенный клип: с него берут свойства. } @@ -3760,7 +3810,7 @@ begin FLookClip := TClip.Create; FLookClip.Kind := Src.Kind; FLookClip.CopyLookFrom(Src); - SetStatus('Свойства клипа скопированы. Применить: Ctrl+Shift+V.'); + SetStatus('Свойства клипа скопированы. Применить: Ctrl+Shift+V.', True); end; procedure TMainForm.MenuPasteLook(Sender: TObject); @@ -3795,7 +3845,7 @@ begin SchedulePreview; UpdateCaption; SetStatus(Format('Свойства применены к %d %s.', - [N, Plural(N, 'клипу', 'клипам', 'клипам')])); + [N, Plural(N, 'клипу', 'клипам', 'клипам')]), True); end; procedure TMainForm.MenuRegionIn(Sender: TObject); @@ -3806,7 +3856,7 @@ begin FTimeline.Invalidate; UpdateCaption; SetStatus(Format('Участок: %s — %s', - [SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)])); + [SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)]), True); end; procedure TMainForm.MenuRegionOut(Sender: TObject); @@ -3823,7 +3873,7 @@ begin FTimeline.Invalidate; UpdateCaption; SetStatus(Format('Участок: %s — %s', - [SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)])); + [SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)]), True); end; procedure TMainForm.MenuRegionClear(Sender: TObject); @@ -3832,7 +3882,7 @@ begin FProject.RegionEnd := 0; FTimeline.Invalidate; UpdateCaption; - SetStatus('Отметки участка сняты: собирается весь монтаж.'); + SetStatus('Отметки участка сняты: собирается весь монтаж.', True); end; { Границы того, что собираем. Без отметок — весь монтаж. } @@ -3857,11 +3907,13 @@ end; procedure TMainForm.MenuRipple(Sender: TObject); begin - { Команда должна отвечать всегда: молчание читается как «не работает». } + { Команда должна отвечать всегда: молчание читается как «не работает». + Дорожку называем: дыра могла найтись не на той, где стоял указатель, + и сдвиг чужой дорожки должен быть виден. } if FTimeline.RippleCloseGap then - SetStatus('Дыра схлопнута.') + SetStatus('Дыра на дорожке ' + FTimeline.LastGapTrack + ' схлопнута.', True) else - SetStatus('Под курсором дыры нет: схлопывать нечего.'); + SetStatus('Под курсором дыры нет: схлопывать нечего.', True); end; { К началу самого раннего клипа по всем дорожкам. Если монтаж начинается diff --git a/src/uTimelineCtrl.pas b/src/uTimelineCtrl.pas index 6a4d650..dd53de1 100644 --- a/src/uTimelineCtrl.pas +++ b/src/uTimelineCtrl.pas @@ -41,7 +41,8 @@ type taFadeOut, // тянем уход за верхний правый угол taRegionIn, // тянем начало отмеченного участка taRegionOut, // тянем конец отмеченного участка - taDragTrack // тянем дорожку за заголовок, меняя порядок + taDragTrack, // тянем дорожку за заголовок, меняя порядок + taRubberBand // обтягиваем рамкой клипы по пустому месту ); { Что находится под указателем в полосе заголовков дорожек. } @@ -126,6 +127,18 @@ type клипы, которые уже сдвинулись. } FRippleClips: array of TClip; FRippleOrigStarts: array of Double; + { Имя дорожки, где схлопнули дыру в последний раз. } + FLastGapTrack: string; + { Рамка выделения: угол, где нажали, и угол, где мышь сейчас. + + По горизонтали храним время, а не точку экрана: рамку можно тянуть + за край окна, монтаж при этом прокручивается, и запомненная точка + экрана означала бы уже другое место. По вертикали храним отступ от + начала дорожек, а не от верха окна, — по той же причине. } + FBandFromTime: Double; + FBandToTime: Double; + FBandFromY: Integer; + FBandToY: Integer; FGroupClips: array of TClip; FGroupOrigStarts: array of Double; @@ -185,6 +198,7 @@ type procedure DrawOverlaps(ACanvas: TCanvas; ATrack: TTrack; ATop: Integer); { Полоса поверх участка, который прямо сейчас пересобирается. } procedure DrawBusyRange(ACanvas: TCanvas); + procedure DrawRubberBand(ACanvas: TCanvas); { Сдвиг всего, что правее дыры, влево до первого касания. } procedure RippleAfterDelete(const AHoleEnd: Double; const ATracks: TStringList); @@ -224,6 +238,19 @@ type const AFromTime: Double); procedure ApplyRipple(const ADelta: Double); function IsRippling(AClip: TClip): Boolean; + { Ближайшая к ATime дыра на дорожке: конец предыдущего клипа и начало + следующего. Дыра считается найденной, если ATime отстоит от неё не + дальше чем на ATolerance; внутри дыры расстояние нулевое. + + Допуск нужен потому, что курсор прилипает к краям клипов по всем + дорожкам сразу, а края картинки и её звука совпадают не всегда: + курсор, поставленный в дыру, может оказаться на десяток миллисекунд + левее её начала. Требовать точного попадания — значит заставлять + человека целиться. } + function NearestGapOnTrack(ATrackIndex: Integer; + const ATime, ATolerance: Double; out AFrom, ATo: Double): Boolean; + { Допуск прилипания в секундах: те же экранные точки, что у краёв. } + function SnapTolerance: Double; protected procedure Paint; override; procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; @@ -262,13 +289,20 @@ type function TrackIndexAtPoint(const AY: Integer): Integer; function TimeAtPoint(const AX: Integer): Double; - { Разрезать клипы под курсором воспроизведения. + { Разрезать клипы под курсором воспроизведения — на всех дорожках + сразу. Возвращает, сколько клипов разрезано: ноль тоже ответ, и + окно должен о нём сказать, иначе клавиша выглядит сломанной. + + Раньше резалась только дорожка под указателем мыши, и стоило + указателю оказаться над пустым местом, как рез молча не делал + ничего. Дорожка под мышью и дорожка, с которой работают, — разные + вещи, и связывать их не следует. APrecise помечает новые края как требующие точного реза: при сборке огрызок до опорного кадра будет перекодирован. Без этого рез притянется к опорному кадру, и точка съедет на величину до расстояния между опорными кадрами. } - procedure SplitAtPlayhead(APrecise: Boolean; AOnlyCurrentTrack: Boolean); + function SplitAtPlayhead(APrecise: Boolean): Integer; procedure DeleteSelected; { Связать выделенные клипы или развязать, если они уже связаны. @@ -286,6 +320,17 @@ type окно скажет об этом, чтобы команда не выглядела сломанной. } function RippleCloseGap: Boolean; procedure SelectAll; + { Выделить клипы, попавшие в область: дорожки с ATrackFrom по ATrackTo, + время с AFrom по ATo. + + Попавшим считается клип, который областью задет, а не целиком в ней + лежит: обтянуть длинный клип целиком на общем плане невозможно, а + убрать его хотят так же, как короткий. + + AAdd — добавить к уже выделенному (Ctrl), иначе прежнее выделение + заменяется. Открыто наружу ещё и затем, чтобы проверять числами. } + procedure SelectInRange(const AFrom, ATo: Double; + ATrackFrom, ATrackTo: Integer; AAdd: Boolean); { Номер дорожки под указателем мыши, минус один если ни одной. } property HoverTrack: Integer read FHoverTrack; @@ -296,6 +341,10 @@ type { Куда встанет курсор, если поставить его в это время. Открыто, чтобы расчёт можно было проверить числами, не гоняя мышь по окну. } function SnapPlayhead(const ATime: Double): Double; + { Имя дорожки, на которой схлопнули дыру в последний раз. Нужно окну + для строки состояния: дыра могла найтись не на той дорожке, где + стоял указатель, и молча двигать чужую дорожку нельзя. } + property LastGapTrack: string read FLastGapTrack; { Округление к кадровой сетке проекта: между кадрами времени нет. } function QuantizeTime(const ATime: Double): Double; @@ -411,6 +460,7 @@ const ColorFadeFill = TColor($505050); // серый: срезанный угол клипа ColorOverlap = TColor($30C0FF); // оранжевый: полоса перехода ColorBusy = TColor($30C0FF); // оранжевый: участок в работе + ColorBand = TColor($E0E0E0); // белый: рамка выделения ColorHeaderActive = TColor($3A3A3A); // подсветка выбранной дорожки ColorButtonOff = TColor($3A3A3A); ColorMuteOn = TColor($4040D0); // красный: дорожка выключена @@ -705,6 +755,9 @@ begin { Отметка занятого участка идёт после клипов и до линейки: она должна лежать поверх клипов, но не наползать на подписи времени. } DrawBusyRange(FBuffer.Canvas); + { Рамка выделения — поверх клипов, но под линейкой и заголовками: она + про клипы, и наползать на подписи времени ей незачем. } + DrawRubberBand(FBuffer.Canvas); DrawRuler(FBuffer.Canvas); DrawHeaders(FBuffer.Canvas); DrawPlayhead(FBuffer.Canvas); @@ -1323,6 +1376,34 @@ begin Invalidate; end; +{ Рамка выделения. Пунктиром и без заливки: клипы внутри и так + подсвечиваются выделением, а заливка поверх них мешала бы это увидеть. } +procedure TTimelineControl.DrawRubberBand(ACanvas: TCanvas); +var + L, R, T, B: Integer; +begin + if (FAction <> taRubberBand) or (not FMovedWhileDown) then + Exit; + + L := Min(TimeToX(FBandFromTime), TimeToX(FBandToTime)); + R := Max(TimeToX(FBandFromTime), TimeToX(FBandToTime)); + T := Min(FBandFromY, FBandToY) - FScrollY; + B := Max(FBandFromY, FBandToY) - FScrollY; + + L := Max(L, FHeaderWidth); + R := Min(R, ClientWidth); + T := Max(T, FRulerHeight); + B := Min(B, ClientHeight); + if (R <= L) or (B <= T) then + Exit; + + ACanvas.Pen.Color := ColorBand; + ACanvas.Pen.Style := psDot; + ACanvas.Brush.Style := bsClear; + ACanvas.Rectangle(L, T, R, B); + ACanvas.Pen.Style := psSolid; +end; + { Участок, который сейчас пересобирается. Помечается косой штриховкой во всю высоту дорожек: сплошная заливка @@ -1820,6 +1901,54 @@ begin Result := Best; end; +function TTimelineControl.SnapTolerance: Double; +begin + if FPixelsPerSecond > 0 then + Result := SnapPixels / FPixelsPerSecond + else + Result := 0; +end; + +function TTimelineControl.NearestGapOnTrack(ATrackIndex: Integer; + const ATime, ATolerance: Double; out AFrom, ATo: Double): Boolean; +var + Track: TTrack; + I: Integer; + PrevEnd, Dist, BestDist: Double; +begin + Result := False; + AFrom := 0; + ATo := 0; + if (FProject = nil) or (ATrackIndex < 0) or + (ATrackIndex >= FProject.TrackCount) then + Exit; + + Track := FProject.Tracks[ATrackIndex]; + BestDist := ATolerance; + PrevEnd := 0; + for I := 0 to Track.Count - 1 do + begin + if Track[I].TlStart > PrevEnd + 0.0005 then + begin + { Расстояние до отрезка дыры: внутри неё — ноль. } + if ATime < PrevEnd then + Dist := PrevEnd - ATime + else if ATime > Track[I].TlStart then + Dist := ATime - Track[I].TlStart + else + Dist := 0; + if Dist <= BestDist then + begin + BestDist := Dist; + AFrom := PrevEnd; + ATo := Track[I].TlStart; + Result := True; + end; + end; + PrevEnd := Max(PrevEnd, Track[I].TlEnd); + end; +end; + { --- Мышь --- } procedure TTimelineControl.MouseDown(Button: TMouseButton; Shift: TShiftState; @@ -1956,16 +2085,21 @@ begin if Clip = nil then begin - { По пустому месту дорожки — тоже ставим курсор: так удобнее, чем - тянуться к линейке. } - if not (ssCtrl in Shift) then - begin - FProject.ClearSelection; - if Assigned(FOnSelectionChange) then - FOnSelectionChange(Self); - end; - FAction := taScrub; - Playhead := Max(0, SnapPlayhead(XToTime(X))); + { По пустому месту дорожек — рамка выделения. Что с ней делать, + решается при отпускании: не сдвинули мышь — это щелчок, и он, как и + раньше, ставит курсор (тянуться к линейке каждый раз неудобно). + Сдвинули — выделяем всё, что рамка задела. + + Выделение пока не трогаем: снимать его на нажатии значило бы терять + его от случайного щелчка мимо клипа. } + FAction := taRubberBand; + FPressX := X; + FPressY := Y; + FMovedWhileDown := False; + FBandFromTime := XToTime(X); + FBandToTime := FBandFromTime; + FBandFromY := Y + FScrollY; + FBandToY := FBandFromY; Exit; end; @@ -2129,6 +2263,28 @@ begin на стык, соскакивал бы с него от малейшего движения мыши. } Playhead := Max(0, SnapPlayhead(XToTime(X))); + taRubberBand: + begin + if (Abs(X - FPressX) > ClickSlopPixels) or + (Abs(Y - FPressY) > ClickSlopPixels) then + FMovedWhileDown := True; + { Тянут за край окна — прокручиваем следом: иначе рамкой нельзя + захватить больше, чем помещается на экране. Прокрутка идёт на + каждое движение мыши, само по себе время не течёт: пока мышь + стоит, ничего не происходит. } + if FPixelsPerSecond > 0 then + begin + if X < FHeaderWidth then + FScrollOffset := FScrollOffset - (FHeaderWidth - X) / FPixelsPerSecond + else if X > ClientWidth then + FScrollOffset := FScrollOffset + (X - ClientWidth) / FPixelsPerSecond; + ClampScroll; + end; + FBandToTime := XToTime(Max(FHeaderWidth, Min(ClientWidth, X))); + FBandToY := Max(FRulerHeight, Y) + FScrollY; + Invalidate; + end; + taDragTrack: if (FProject <> nil) and (FDragTrackIndex >= 0) then begin @@ -2456,6 +2612,31 @@ begin Exit; end; + { Рамка выделения. Щелчок без движения — это не рамка, а щелчок по + пустому месту: снимаем выделение и ставим курсор, как было всегда. } + if FAction = taRubberBand then + begin + FAction := taNone; + if FMovedWhileDown then + SelectInRange(FBandFromTime, FBandToTime, + (FBandFromY - FRulerHeight) div FTrackHeight, + (FBandToY - FRulerHeight) div FTrackHeight, + ssCtrl in Shift) + else + begin + if (FProject <> nil) and not (ssCtrl in Shift) then + begin + FProject.ClearSelection; + if Assigned(FOnSelectionChange) then + FOnSelectionChange(Self); + end; + Playhead := Max(0, SnapPlayhead(XToTime(X))); + end; + FMovedWhileDown := False; + Invalidate; + Exit; + end; + WasEditing := FAction in [taDragClip, taTrimIn, taTrimOut, taVolume, taFadeIn, taFadeOut]; WasTrimIn := FAction = taTrimIn; @@ -2539,39 +2720,28 @@ end; { --- Правки --- } -procedure TTimelineControl.SplitAtPlayhead(APrecise: Boolean; - AOnlyCurrentTrack: Boolean); +function TTimelineControl.SplitAtPlayhead(APrecise: Boolean): Integer; var T: Integer; Track: TTrack; Clip, Tail: TClip; - AnyChange: Boolean; Offset: Double; - HoverGroup: string; { Старый номер связки — новый. Одна связка при резе становится двумя: голова со своей парой и хвост со своей. } NewGroups: TStringList; Idx: Integer; begin + Result := 0; if FProject = nil then Exit; - AnyChange := False; FProject.BeginChange; NewGroups := TStringList.Create; try - { Связка режется целиком. Резать только картинку, оставив звук цельным, - значит развалить пару: дальше они поедут порознь. } - HoverGroup := ''; - if AOnlyCurrentTrack and (FHoverTrack >= 0) and - (FHoverTrack < FProject.TrackCount) then - begin - Clip := FProject.Tracks[FHoverTrack].ClipAt(FPlayhead); - if Clip <> nil then - HoverGroup := Clip.GroupId; - end; - + { Режем все дорожки, где под курсором есть клип. Связка при этом + остаётся целой сама собой: картинка и её звук лежат под одним и тем + же временем, значит режутся оба. } for T := 0 to FProject.TrackCount - 1 do begin Track := FProject.Tracks[T]; @@ -2579,10 +2749,6 @@ begin if Clip = nil then Continue; - if AOnlyCurrentTrack and (FHoverTrack >= 0) and (T <> FHoverTrack) then - if (HoverGroup = '') or (Clip.GroupId <> HoverGroup) then - Continue; - Offset := FPlayhead - Clip.TlStart; { Рез вплотную к краю ничего не даёт, только плодит клипы нулевой длины. } if (Offset < 0.001) or (Offset > Clip.Duration - 0.001) then @@ -2639,14 +2805,14 @@ begin Clip.Duration := Offset; Track.Add(Tail); - AnyChange := True; + Inc(Result); end; finally NewGroups.Free; end; - if AnyChange then + if Result > 0 then StructureChanged else { Ничего не разрезали — снимок отмены не нужен, откатываем его. } @@ -2857,33 +3023,11 @@ function TTimelineControl.RippleCloseGap: Boolean; var T, C, Source: Integer; Track: TTrack; - GapStart, GapEnd, Shift: Double; + GapStart, GapEnd, Shift, Tolerance: Double; AnyChange: Boolean; - - { Находит дыру под курсором на дорожке: конец предыдущего клипа и - начало следующего. } - function FindGap(ATrack: TTrack; out AFrom, ATo: Double): Boolean; - var - I: Integer; - PrevEnd: Double; - begin - Result := False; - PrevEnd := 0; - for I := 0 to ATrack.Count - 1 do - begin - if ATrack[I].TlStart > PrevEnd + 0.0005 then - if (FPlayhead >= PrevEnd) and (FPlayhead <= ATrack[I].TlStart) then - begin - AFrom := PrevEnd; - ATo := ATrack[I].TlStart; - Exit(True); - end; - PrevEnd := Max(PrevEnd, ATrack[I].TlEnd); - end; - end; - begin Result := False; + FLastGapTrack := ''; if FProject = nil then Exit; @@ -2895,14 +3039,31 @@ begin клавиатуре, — берём выбранную дорожку. Раньше в этом случае команда молча не делала ничего, и выглядело это как «горячая клавиша не работает». } + Tolerance := Max(SnapTolerance, 0.001); + 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[Source], GapStart, GapEnd) then - Exit; + if (Source < 0) or (Source >= FProject.TrackCount) or + (not NearestGapOnTrack(Source, FPlayhead, Tolerance, GapStart, GapEnd)) then + begin + { На своей дорожке дыры нет — ищем на остальных сверху вниз. Указатель + мыши может стоять где угодно, а дыра под курсором обычно одна на весь + монтаж. Какую дорожку схлопнули, окно потом скажет: молча двигать не + ту дорожку, на которую смотрели, нельзя. } + Source := -1; + for T := 0 to FProject.TrackCount - 1 do + if NearestGapOnTrack(T, FPlayhead, Tolerance, GapStart, GapEnd) then + begin + Source := T; + Break; + end; + if Source < 0 then + Exit; + end; + + FLastGapTrack := FProject.Tracks[Source].Name; Shift := GapEnd - GapStart; if Shift <= 0 then @@ -2955,6 +3116,38 @@ begin FOnSelectionChange(Self); end; +procedure TTimelineControl.SelectInRange(const AFrom, ATo: Double; + ATrackFrom, ATrackTo: Integer; AAdd: Boolean); +var + T, C, T1, T2: Integer; + From_, To_: Double; + Clip: TClip; +begin + if FProject = nil then + Exit; + + { Рамку тянут в любую сторону — приводим её к возрастающему виду. } + From_ := Min(AFrom, ATo); + To_ := Max(AFrom, ATo); + T1 := Max(0, Min(ATrackFrom, ATrackTo)); + T2 := Min(FProject.TrackCount - 1, Max(ATrackFrom, ATrackTo)); + + if not AAdd then + FProject.ClearSelection; + + for T := T1 to T2 do + for C := 0 to FProject.Tracks[T].Count - 1 do + begin + Clip := FProject.Tracks[T][C]; + if (Clip.TlEnd > From_) and (Clip.TlStart < To_) then + Clip.Selected := True; + end; + + Invalidate; + if Assigned(FOnSelectionChange) then + FOnSelectionChange(Self); +end; + procedure TTimelineControl.KeyDown(var Key: Word; Shift: TShiftState); begin inherited KeyDown(Key, Shift); diff --git a/tests/lfmcheck/lfmcheck.lpr b/tests/lfmcheck/lfmcheck.lpr index 28290d6..4ea6e2f 100644 --- a/tests/lfmcheck/lfmcheck.lpr +++ b/tests/lfmcheck/lfmcheck.lpr @@ -209,7 +209,7 @@ begin Timeline.Project := Proj; Timeline.PixelsPerSecond := 100; Timeline.Playhead := 4; - Timeline.SplitAtPlayhead(False, False); + Timeline.SplitAtPlayhead(False); CheckTrue('клипов стало два', Proj.Tracks[0].Count = 2); if Proj.Tracks[0].Count <> 2 then @@ -374,6 +374,196 @@ begin end; end; +{ Общая заготовка: проект с одним файлом и заданной сеткой кадров. } +function TestInfo: TMediaInfo; +begin + Result := Default(TMediaInfo); + Result.Valid := True; + Result.Kind := mkVideo; + Result.Duration := 600; + Result.HasVideo := True; + Result.VideoCodec := 'hevc'; + Result.Width := 1920; + Result.Height := 1080; + Result.FpsNum := 30; + Result.FpsDen := 1; + Result.PixFmt := 'yuv420p'; +end; + +{ Выделение областью. + + Проверяется расчётом, а не мышью: сама протяжка проверена на невидимом + экране, а вот что попадает в рамку — числами, иначе первая же правка + захвата пройдёт незамеченной. } +procedure CheckRubberBand; +var + Proj: TProject; + Info: TMediaInfo; + Media: TMediaItem; + Timeline: TTimelineControl; +begin + WriteLn; + WriteLn('Выделение областью'); + WriteLn; + + Info := TestInfo; + Proj := TProject.Create; + Timeline := TTimelineControl.Create(nil); + try + Proj.Clear; + Proj.AddTrack('V1'); + Proj.AddTrack('V2'); + Proj.AddTrack('V3'); + Media := Proj.AddMedia('/несуществующий/видео.mp4', Info); + Proj.Master := Info; + { V1: клип 0..5 и клип 20..25. V2: длинный клип 0..30. + V3: клип 0..5 — дорожка вне рамки. } + Proj.AddClip(Proj.Tracks[0], Media, 0, 5, 0); + Proj.AddClip(Proj.Tracks[0], Media, 100, 5, 20); + Proj.AddClip(Proj.Tracks[1], Media, 0, 30, 0); + Proj.AddClip(Proj.Tracks[2], Media, 0, 5, 0); + + Timeline.Project := Proj; + Timeline.PixelsPerSecond := 100; + + { Рамка по дорожкам 0 и 1, время 2..10. } + Timeline.SelectInRange(2, 10, 0, 1, False); + CheckTrue('задетый клип выделен', Proj.Tracks[0][0].Selected); + CheckTrue('клип за рамкой не выделен', not Proj.Tracks[0][1].Selected); + CheckTrue('длинный клип задет и выделен', Proj.Tracks[1][0].Selected); + CheckTrue('чужая дорожка не тронута', not Proj.Tracks[2][0].Selected); + + { Рамку тянут и справа налево — это та же рамка. } + Timeline.SelectInRange(25, 18, 0, 0, False); + CheckTrue('обратная протяжка выделила второй клип', + Proj.Tracks[0][1].Selected); + CheckTrue('прежнее выделение снято', not Proj.Tracks[0][0].Selected); + + { С Ctrl прежнее выделение остаётся. } + Timeline.SelectInRange(2, 4, 0, 0, True); + CheckTrue('добавление сохранило прежнее', Proj.Tracks[0][1].Selected); + CheckTrue('добавление выделило новое', Proj.Tracks[0][0].Selected); + + { Рамка, не задевшая ничего, просто снимает выделение. } + Timeline.SelectInRange(6, 8, 0, 0, False); + CheckTrue('пустая рамка ничего не выделила', + Proj.SelectedCount = 0); + finally + Timeline.Free; + Proj.Free; + end; +end; + +{ Рез по курсору режет все дорожки. + + Раньше резалась только дорожка под указателем мыши, и стоило указателю + оказаться над пустым местом, как клавиша S молча не делала ничего. } +procedure CheckSplitAllTracks; +var + Proj: TProject; + Info: TMediaInfo; + Media: TMediaItem; + Timeline: TTimelineControl; +begin + WriteLn; + WriteLn('Рез по курсору на всех дорожках'); + WriteLn; + + Info := TestInfo; + Proj := TProject.Create; + Timeline := TTimelineControl.Create(nil); + try + Proj.Clear; + Proj.AddTrack('V1'); + Proj.AddTrack('V2'); + Proj.AddTrack('A1'); + Media := Proj.AddMedia('/несуществующий/видео.mp4', Info); + Proj.Master := Info; + { Клипы 0..10 на первой и третьей дорожках, на второй — 20..30: + под курсором её нет, и резать там нечего. } + Proj.AddClip(Proj.Tracks[0], Media, 0, 10, 0); + Proj.AddClip(Proj.Tracks[1], Media, 0, 10, 20); + Proj.AddClip(Proj.Tracks[2], Media, 0, 10, 0); + + Timeline.Project := Proj; + Timeline.PixelsPerSecond := 100; + Timeline.ActiveTrack := 1; + Timeline.Playhead := 4; + + CheckTrue('разрезаны обе задетые дорожки', + Timeline.SplitAtPlayhead(False) = 2); + CheckTrue('на первой дорожке два клипа', Proj.Tracks[0].Count = 2); + CheckTrue('на звуковой дорожке два клипа', Proj.Tracks[2].Count = 2); + CheckTrue('нетронутая дорожка осталась с одним клипом', + Proj.Tracks[1].Count = 1); + + { Курсор ровно на стыке — резать нечего, и клипов нулевой длины + появиться не должно. } + CheckTrue('на стыке рез отвечает нулём', + Timeline.SplitAtPlayhead(False) = 0); + CheckTrue('лишних клипов не появилось', + (Proj.Tracks[0].Count = 2) and (Proj.Tracks[2].Count = 2)); + finally + Timeline.Free; + Proj.Free; + end; +end; + +{ Схлопывание дыры не требует попадать в тайминг. + + Курсор может стоять не точно на краю дыры: во время воспроизведения он + останавливается там, где успел, а после перезагрузки предпросмотра — + где оказался плеер. Раньше дыра при этом не находилась. } +procedure CheckGapTolerance; +var + Proj: TProject; + Info: TMediaInfo; + Media: TMediaItem; + Timeline: TTimelineControl; +begin + WriteLn; + WriteLn('Схлопывание дыры с допуском'); + WriteLn; + + Info := TestInfo; + Proj := TProject.Create; + Timeline := TTimelineControl.Create(nil); + try + Proj.Clear; + Proj.AddTrack('V1'); + Proj.AddTrack('A1'); + 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); + Proj.AddClip(Proj.Tracks[1], Media, 0, 17, 0); + + Timeline.Project := Proj; + Timeline.PixelsPerSecond := 100; + { Указатель и выбранная дорожка — звуковая, дыры на ней нет. } + Timeline.ActiveTrack := 1; + { Курсор не в дыре, а на четыре сотых раньше её начала. } + Timeline.Playhead := 4.96; + + CheckTrue('дыра найдена, хотя курсор чуть раньше края', + Timeline.RippleCloseGap); + CheckTrue('названа дорожка, где схлопнули', + Timeline.LastGapTrack = 'V1'); + CheckTrue('клип придвинут вплотную', + Abs(Proj.Tracks[0][1].TlStart - 5) < 0.001); + + { Курсор далеко от дыры — ничего не двигаем. } + Proj.Tracks[0][1].TlStart := 12; + Timeline.Playhead := 2; + CheckTrue('далеко от дыры — не схлопываем', + not Timeline.RippleCloseGap); + finally + Timeline.Free; + Proj.Free; + end; +end; + begin WriteLn('Свойства из файлов форм'); WriteLn; @@ -404,6 +594,9 @@ begin CheckSplitKeepsSettings; CheckRippleWithoutMouse; CheckClipCopy; + CheckRubberBand; + CheckSplitAllTracks; + CheckGapTolerance; WriteLn; if Failed = 0 then