diff --git a/.gitignore b/.gitignore index 789c22c..77cd272 100644 --- a/.gitignore +++ b/.gitignore @@ -43,6 +43,11 @@ shot*.png # Журнал последнего запуска /nlve.log +# Проверка хода полоски: двоичный файл и промежуточные модули. +/tests/progress/progtest +/tests/progress/*.o +/tests/progress/*.ppu + # Сборка пробников. Сами исходники нужны: они и есть запись замера. /probe/*/units/ /probe/menu/menuprobe diff --git a/build.sh b/build.sh index 7d8b474..6b2082d 100755 --- a/build.sh +++ b/build.sh @@ -22,6 +22,8 @@ HERE=$(cd "$(dirname "$0")" && pwd) FPCUP=${FPCUP:-/home/chaiman/fpcupdeluxe} LAZBUILD="$FPCUP/lazarus/lazbuild" LAZCONF="$FPCUP/config_lazarus" +# Компилятор нужен напрямую для консольных проверок без формы. +FPC="$FPCUP/fpc/bin/x86_64-linux/fpc.sh" # Собранный виджетсет только один — gtk2. Ни qt5, ни gtk3 в этом # тулчейне нет, подставлять их бессмысленно. @@ -120,6 +122,22 @@ run_tests() { echo "проверки не пройдены" >&2 status=1 fi + + # Ход полоски выполнения проверяется отдельной программой: расчёт вынесен + # в uAppTypes именно затем, чтобы его можно было прогнать числами. + note "Проверка хода полоски выполнения" + if "$FPC" -Fu"$HERE/src" -FE"$HERE/tests/progress" \ + -o"$HERE/tests/progress/progtest" \ + "$HERE/tests/progress/progtest.lpr" >/dev/null 2>&1; then + if "$HERE/tests/progress/progtest"; then + : + else + status=1 + fi + else + echo "не собралось" >&2 + status=1 + fi } do_clean() { diff --git a/src/uAppTypes.pas b/src/uAppTypes.pas index 0f0d645..d8b5eb5 100644 --- a/src/uAppTypes.pas +++ b/src/uAppTypes.pas @@ -105,6 +105,20 @@ function TotalDuration(const Segments: TFlatSegmentArray): Double; «куска», для 5 — «кусков». Без этого в интерфейсе появляется «1 кусков». } function Plural(ACount: Integer; const AOne, AFew, AMany: string): string; +{ Как двигается показанная доля выполнения. + + Настоящая доля известна только вехами: файл разобран, вставка готова. + Между вехами не происходит ничего видимого, и полоска, стоящая на месте, + выглядит как зависшая программа. + + Поэтому между вехами она ползёт сама — к следующей вехе, но никогда её + не достигая: каждый шаг покрывает малую долю оставшегося расстояния. + Пока работа идёт как задумано, веха приходит быстро и полоска прыгает к + ней. Затянулась — шаги мельчают, и заполнение само собой замедляется. + + Назад полоска не идёт никогда. } +function AdvanceProgress(AShown, AReal, ANext, AStepShare: Double): Double; + implementation var @@ -155,4 +169,17 @@ begin Result := AMany; end; +function AdvanceProgress(AShown, AReal, ANext, AStepShare: Double): Double; +begin + Result := AShown; + if AReal > Result then + Result := AReal; + if ANext > Result then + Result := Result + (ANext - Result) * AStepShare; + { До самого конца полоска не доходит: конец наступает тогда, когда + работа кончилась, а не когда мы досчитали. } + if Result > 0.999 then + Result := 0.999; +end; + end. diff --git a/src/uFlatten.pas b/src/uFlatten.pas index 4c1e973..541d0a3 100644 --- a/src/uFlatten.pas +++ b/src/uFlatten.pas @@ -60,6 +60,10 @@ type TargetPath: string; { Только для gkLayers: что с чем смешивать. } Layers: TSegmentLayers; + { Место на монтаже, ради которого всё затевается. Нужно только для + показа: пока участок пересобирается, монтаж помечает его полосой. } + TlStart: Double; + TlEnd: Double; end; TGenRequests = array of TGenRequest; @@ -227,13 +231,18 @@ procedure ResolveLayers(AProject: TProject; var ASegments: TFlatSegmentArray; var I: Integer; Req: TGenRequest; + At: Double; begin if AProject = nil then Exit; + At := 0; for I := 0 to High(ASegments) do begin if Length(ASegments[I].Layers) = 0 then + begin + At := At + ASegments[I].Duration; Continue; + end; Req := Default(TGenRequest); Req.Kind := gkLayers; @@ -241,6 +250,9 @@ begin Req.SourcePath := LayersKey(ASegments[I].Layers, ASegments[I].Duration); Req.Layers := ASegments[I].Layers; Req.TargetPath := GeneratedPath(AProject.CacheDir, Req); + Req.TlStart := At; + Req.TlEnd := At + ASegments[I].Duration; + At := Req.TlEnd; if not FileExists(Req.TargetPath) then begin diff --git a/src/uGenerate.pas b/src/uGenerate.pas index 5a52eac..1f16904 100644 --- a/src/uGenerate.pas +++ b/src/uGenerate.pas @@ -53,6 +53,14 @@ type property StageText: string read FStageText; property Fraction: Double read FFraction; + { Сколько всего заказано и сколько уже сделано. Нужно показателю + работы: по ним он знает, докуда ползти до следующей вехи. } + function Total: Integer; + property Done: Integer read FCurrent; + { Место на монтаже, которое считается прямо сейчас. Ноль в обоих — + значит, к монтажу это отношения не имеет. } + function BusyFrom: Double; + function BusyTo: Double; property PendingLog: string read FPendingLog; property Succeeded: Boolean read FSucceeded; property Cancelled: Boolean read FCancelled; @@ -113,6 +121,27 @@ begin Log('ffmpeg: ' + ALine); end; +function TGenerateThread.Total: Integer; +begin + Result := Length(FRequests); +end; + +function TGenerateThread.BusyFrom: Double; +begin + if (FCurrent >= 0) and (FCurrent <= High(FRequests)) then + Result := FRequests[FCurrent].TlStart + else + Result := 0; +end; + +function TGenerateThread.BusyTo: Double; +begin + if (FCurrent >= 0) and (FCurrent <= High(FRequests)) then + Result := FRequests[FCurrent].TlEnd + else + Result := 0; +end; + procedure TGenerateThread.Publish; begin if Length(FRequests) > 0 then diff --git a/src/uMainForm.pas b/src/uMainForm.pas index da805d1..4489ac8 100644 --- a/src/uMainForm.pas +++ b/src/uMainForm.pas @@ -108,6 +108,18 @@ type FJobLabel: TLabel; FJobBar: TThemedProgress; FJobTimer: TTimer; + FLogButton: TThemedButton; + { Показанная доля выполнения. Отдельно от настоящей, потому что растёт + она по своим правилам — см. AdvanceJobBar. } + FJobShown: Double; + { Настоящая доля и доля следующей вехи. Между вехами полоска ползёт + сама, замедляясь. } + FJobReal: Double; + FJobNext: Double; + { Какая именно работа идёт. При смене занятия полоска начинается + заново: иначе новая работа унаследовала бы почти полную полосу от + предыдущей и стояла бы на месте до самого конца. } + FJobKind: Integer; { Уплощённый монтаж, отданный плееру. Хранится, чтобы по времени находить звучащий кусок и брать у него громкость. } FPreviewSegments: TFlatSegmentArray; @@ -197,6 +209,9 @@ type procedure BuildMenu; procedure BuildJobIndicator; procedure JobTimerTick(Sender: TObject); + procedure AdvanceJobBar; + procedure LogButtonClick(Sender: TObject); + procedure ApplyLogVisible(AVisible: Boolean); procedure BuildTimeline; procedure StartPlayer; procedure Log(const AText: string); @@ -446,6 +461,7 @@ begin pnlVideo.Height := FSettings.VideoPanelHeight; FTimeline.TrackHeight := FSettings.TrackHeight; FTimeline.WaveGain := FSettings.WaveGain; + ApplyLogVisible(FSettings.LogVisible); { Режим схлопывания и его состояние переживают перезапуск. } if FSettings.RippleAllTracks then @@ -480,6 +496,7 @@ begin FSettings.WindowHeight := Height; end; FSettings.VideoPanelHeight := pnlVideo.Height; + FSettings.LogVisible := memoLog.Visible; FSettings.RippleAllTracks := FProject.RippleMode = rmAllTracks; FSettings.RippleEnabled := FProject.RippleEnabled; FSettings.WaveGain := FTimeline.WaveGain; @@ -633,6 +650,7 @@ end; procedure TMainForm.BuildJobIndicator; const JobWidth = 330; + LogButtonWidth = 100; begin FJobLabel := TLabel.Create(Self); FJobLabel.Parent := pnlBottom; @@ -651,16 +669,71 @@ begin FJobBar.SetBounds(pnlBottom.ClientWidth - JobWidth - 12, 26, JobWidth, 6); FJobBar.Visible := False; - { Строка состояния ужимается, чтобы её длинные сообщения не залезали - под показатель. } - lblStatus.Width := pnlBottom.ClientWidth - lblStatus.Left - JobWidth - 24; + { Переключатель журнала. Стоит рядом с показателем работы: это две + вещи про одно и то же — что программа делает и что она об этом + рассказала. } + FLogButton := TThemedButton.Create(Self); + FLogButton.Parent := pnlBottom; + FLogButton.Anchors := [akTop, akRight]; + FLogButton.SetBounds(pnlBottom.ClientWidth - JobWidth - LogButtonWidth - 20, + 6, LogButtonWidth, 28); + FLogButton.Caption := 'Журнал'; + FLogButton.Down := True; + FLogButton.OnClick := @LogButtonClick; + FLogButton.ShowHint := True; + FLogButton.Hint := 'Спрятать или показать нижнюю полосу с сообщениями'; + { Строка состояния ужимается, чтобы её длинные сообщения не залезали + под показатель и под кнопку. } + lblStatus.Width := pnlBottom.ClientWidth - lblStatus.Left - JobWidth - + LogButtonWidth - 32; + + { Сто миллисекунд, а не триста: полоска должна ползти, а не дёргаться + ступеньками. } FJobTimer := TTimer.Create(Self); - FJobTimer.Interval := 300; + FJobTimer.Interval := 100; FJobTimer.OnTimer := @JobTimerTick; FJobTimer.Enabled := True; end; +{ Как растёт полоска — см. AdvanceProgress в uAppTypes: там же она и + проверяется числами. } +procedure TMainForm.AdvanceJobBar; +const + { Доля оставшегося до вехи расстояния за один шаг таймера. При ста + миллисекундах на шаг это примерно половина расстояния за секунду. } + StepShare = 0.07; +begin + FJobShown := AdvanceProgress(FJobShown, FJobReal, FJobNext, StepShare); +end; + +procedure TMainForm.LogButtonClick(Sender: TObject); +begin + ApplyLogVisible(not memoLog.Visible); +end; + +procedure TMainForm.ApplyLogVisible(AVisible: Boolean); +begin + memoLog.Visible := AVisible; + if Assigned(FLogButton) then + FLogButton.Down := AVisible; +end; + +{ Как растёт полоска. + + Настоящая доля известна только вехами: файл разобран, вставка готова. + Между вехами не происходит ничего видимого, и полоска, стоящая на месте, + выглядит как зависшая программа. + + Поэтому она ползёт сама — к следующей вехе, но никогда её не достигая: + каждый шаг покрывает малую долю оставшегося расстояния. Пока работа идёт + как задумано, веха приходит быстро и полоска прыгает к ней. Если работа + затянулась, шаги становятся всё мельче, и заполнение само собой + замедляется — ровно то поведение, которого ждут от такой полоски. + + Назад она не идёт никогда: доля, единожды показанная, остаётся. } + + { Опрос по таймеру, а не уведомления из потоков: поток сообщает о готовом файле, а не о ходе внутри файла, и на шестигигабайтном файле между сообщениями проходят десятки секунд. Опрос показывает движение и там. } @@ -670,7 +743,7 @@ var нечувствительны к регистру. } Note: string; Frac: Double; - Total, Done: Integer; + Total, Done, Kind: Integer; begin {$IFDEF LCLWIN32} { Заодно подновляем закраску остатка полосы меню. @@ -682,27 +755,41 @@ begin {$ENDIF} Note := ''; - Frac := 0; + Total := 0; + Done := 0; + Kind := 0; - if Assigned(FPeaksThread) and (not FPeaksFinished) then + { Порядок важен: показываем то, чего человек ждёт прямо сейчас. + + Сборка вставок держит предпросмотр — до её конца монтаж играет + по-старому. Разбор звука и миниатюры не держат ничего, они лишь + дорисовывают то, что уже видно. } + if FGenerateBusy and Assigned(FGenerate) then begin + Kind := 1; + Total := FGenerate.Total; + Done := FGenerate.Done; + Note := FGenerate.StageText; + if Note = '' then + Note := 'Готовлю участки монтажа'; + { Заодно показываем на монтаже, какой именно участок пересобирается. } + FTimeline.SetBusyRange(FGenerate.BusyFrom, FGenerate.BusyTo); + end + else if Assigned(FPeaksThread) and (not FPeaksFinished) then + begin + Kind := 2; Total := FPeaksThread.Total; Done := FPeaksThread.Done; if Total > 0 then - begin - Note := Format('Разбор звука: %d из %d', [Done + 1, Total]); - Frac := Done / Total; - end; + Note := Format('Разбор звука: %d из %d', [Min(Done + 1, Total), Total]); end else if Assigned(FThumbThread) then begin + Kind := 3; Total := FThumbThread.Total; Done := FThumbThread.Done; if (Total > 0) and (Done < Total) then - begin - Note := Format('Миниатюры: %d из %d', [Done + 1, Total]); - Frac := Done / Total; - end; + Note := Format('Миниатюры: %d из %d', [Min(Done + 1, Total), Total]); end; if Note = '' then @@ -712,9 +799,36 @@ begin FJobLabel.Visible := False; FJobBar.Visible := False; end; + { Следующая работа начинается с пустой полоски, а не с того места, где + кончилась прошлая. } + FJobShown := 0; + FJobReal := 0; + FJobNext := 0; + FJobKind := 0; + FTimeline.SetBusyRange(0, 0); Exit; end; + if Kind <> FJobKind then + begin + FJobKind := Kind; + FJobShown := 0; + end; + + if Total > 0 then + begin + FJobReal := Done / Total; + FJobNext := (Done + 1) / Total; + end + else + begin + { Работа без счёта: ползём к концу, никогда его не достигая. } + FJobReal := 0; + FJobNext := 1; + end; + AdvanceJobBar; + Frac := FJobShown; + FJobLabel.Caption := Note; FJobBar.Fraction := Frac; if not FJobLabel.Visible then diff --git a/src/uSettings.pas b/src/uSettings.pas index c8cbb39..4076aa6 100644 --- a/src/uSettings.pas +++ b/src/uSettings.pas @@ -35,6 +35,7 @@ type FTrackHeight: Integer; FWaveGain: Double; FVideoPanelHeight: Integer; + FLogVisible: Boolean; FRecentProjects: TStringList; function FileName: string; public @@ -62,6 +63,9 @@ type { Во сколько раз растянута форма звука на клипах. Только рисунок. } property WaveGain: Double read FWaveGain write FWaveGain; property VideoPanelHeight: Integer read FVideoPanelHeight write FVideoPanelHeight; + { Видна ли нижняя полоса с журналом. По умолчанию видна: пока + программа молодая, её сообщения нужнее, чем лишние строки монтажа. } + property LogVisible: Boolean read FLogVisible write FLogVisible; end; implementation @@ -90,6 +94,7 @@ begin FTrackHeight := DefaultTrackHeight; FWaveGain := DefaultWaveGain; FVideoPanelHeight := DefaultVideoHeight; + FLogVisible := True; end; destructor TSettings.Destroy; @@ -168,6 +173,7 @@ begin FTrackHeight := Obj.Get('track_height', FTrackHeight); FWaveGain := Obj.Get('wave_gain', FWaveGain); FVideoPanelHeight := Obj.Get('video_panel_height', FVideoPanelHeight); + FLogVisible := Obj.Get('log_visible', FLogVisible); Arr := Obj.Find('recent_projects', jtArray) as TJSONArray; FRecentProjects.Clear; @@ -217,6 +223,7 @@ begin Root.Add('track_height', FTrackHeight); Root.Add('wave_gain', FWaveGain); Root.Add('video_panel_height', FVideoPanelHeight); + Root.Add('log_visible', FLogVisible); Arr := TJSONArray.Create; for I := 0 to FRecentProjects.Count - 1 do diff --git a/src/uTimelineCtrl.pas b/src/uTimelineCtrl.pas index bf2ac5a..7ad49e3 100644 --- a/src/uTimelineCtrl.pas +++ b/src/uTimelineCtrl.pas @@ -57,6 +57,8 @@ type TTimelineControl = class(TCustomControl) private + FBusyFrom: Double; + FBusyTo: Double; FProject: TProject; FPixelsPerSecond: Double; FScrollOffset: Double; @@ -151,6 +153,13 @@ type { Полоса перекрытия двух клипов одной дорожки: там сам собой выходит переход, и это надо видеть. } procedure DrawOverlaps(ACanvas: TCanvas; ATrack: TTrack; ATop: Integer); + { Полоса поверх участка, который прямо сейчас пересобирается. } + procedure DrawBusyRange(ACanvas: TCanvas); + public + { Отметить участок монтажа, который сейчас пересобирается. Нули + снимают отметку. } + procedure SetBusyRange(const AFrom, ATo: Double); + private { Кнопка кадрирования в правом нижнем углу видимой части клипа. Именно видимой: у клипа длиной в час настоящий угол почти всегда за краем экрана, и дотянуться до него мышью нельзя. } @@ -341,6 +350,7 @@ const ColorFadeLine = TColor($E0E0E0); // белый: линия затухания ColorFadeFill = TColor($505050); // серый: срезанный угол клипа ColorOverlap = TColor($30C0FF); // оранжевый: полоса перехода + ColorBusy = TColor($30C0FF); // оранжевый: участок в работе ColorHeaderActive = TColor($3A3A3A); // подсветка выбранной дорожки ColorButtonOff = TColor($3A3A3A); ColorMuteOn = TColor($4040D0); // красный: дорожка выключена @@ -613,6 +623,9 @@ begin FBuffer.Canvas.FillRect(0, 0, FBuffer.Width, FBuffer.Height); DrawTracks(FBuffer.Canvas); + { Отметка занятого участка идёт после клипов и до линейки: она должна + лежать поверх клипов, но не наползать на подписи времени. } + DrawBusyRange(FBuffer.Canvas); DrawRuler(FBuffer.Canvas); DrawHeaders(FBuffer.Canvas); DrawPlayhead(FBuffer.Canvas); @@ -1090,6 +1103,57 @@ begin end; end; +procedure TTimelineControl.SetBusyRange(const AFrom, ATo: Double); +begin + if (Abs(AFrom - FBusyFrom) < 0.0005) and (Abs(ATo - FBusyTo) < 0.0005) then + Exit; + FBusyFrom := AFrom; + FBusyTo := ATo; + Invalidate; +end; + +{ Участок, который сейчас пересобирается. + + Помечается косой штриховкой во всю высоту дорожек: сплошная заливка + закрыла бы клипы, а рамка на узком участке была бы неразличима. Штрих + наклонный — так его не спутать ни с курсором воспроизведения, ни с + границами клипов, которые все вертикальные. } +procedure TTimelineControl.DrawBusyRange(ACanvas: TCanvas); +const + Step = 10; +var + L, R, X, Bottom: Integer; +begin + if FBusyTo <= FBusyFrom then + Exit; + + L := TimeToX(FBusyFrom); + R := TimeToX(FBusyTo); + if (R < FHeaderWidth) or (L > ClientWidth) then + Exit; + if L < FHeaderWidth then + L := FHeaderWidth; + if R > ClientWidth then + R := ClientWidth; + { Совсем узкий участок штриховкой не показать — рисуем хотя бы полоску. } + if R - L < 3 then + R := L + 3; + + Bottom := ClientHeight; + ACanvas.Pen.Color := ColorBusy; + ACanvas.Brush.Style := bsClear; + ACanvas.Rectangle(L, FRulerHeight, R, Bottom); + + X := L - (Bottom - FRulerHeight); + while X < R do + begin + ACanvas.Line(Max(L, X), FRulerHeight + Max(0, L - X), + Min(R, X + Bottom - FRulerHeight), FRulerHeight + + Min(Bottom - FRulerHeight, R - X)); + Inc(X, Step); + end; +end; + procedure TTimelineControl.DrawTracks(ACanvas: TCanvas); var T, C, RowTop: Integer; diff --git a/tests/progress/progtest.lpr b/tests/progress/progtest.lpr new file mode 100644 index 0000000..7706b25 --- /dev/null +++ b/tests/progress/progtest.lpr @@ -0,0 +1,110 @@ +{ + Проверка того, как ползёт полоска выполнения. + + Проверяется не картинка, а поведение: назад не идёт, между вехами + замедляется, при затянувшейся работе не упирается в конец. + + Отдельная программа, а не проверка внутри редактора: расчёт вынесен в + uAppTypes именно затем, чтобы его можно было прогнать числами. +} +program progtest; + +{$mode objfpc}{$H+} + +uses + SysUtils, uAppTypes; + +const + Step = 0.07; + +var + Failed: Integer = 0; + +procedure Check(const AName: string; ACondition: Boolean); +begin + if ACondition then + WriteLn(' ok ', AName) + else + begin + WriteLn(' ПЛОХО ', AName); + Inc(Failed); + end; +end; + +{ Сколько шагов таймера пройдёт, пока полоска идёт от одного значения к + другому при неизменных вехах. } +function StepsFrom(AShown, AReal, ANext, ATarget: Double): Integer; +var + V: Double; +begin + Result := 0; + V := AShown; + while (V < ATarget) and (Result < 100000) do + begin + V := AdvanceProgress(V, AReal, ANext, Step); + Inc(Result); + end; +end; + +var + V, Prev: Double; + I, N1, N2: Integer; + +begin + WriteLn('Ход полоски выполнения'); + WriteLn; + + { 1. Назад не идёт никогда, даже если настоящая доля вдруг меньше. + + Сравнение с запасом: константа в исходнике считается в расширенной + точности, а значение хранится как Double, и точное равенство между + ними не выполняется никогда. } + V := AdvanceProgress(0.6, 0.2, 0.25, Step); + Check('назад не идёт', V >= 0.6 - 1E-9); + + { 2. Веха достигнута — прыгаем к ней сразу. } + V := AdvanceProgress(0.1, 0.5, 0.75, Step); + Check('до настоящей доли догоняет сразу', V >= 0.5); + + { 3. Между вехами ползёт, но следующей не достигает. } + V := 0; + for I := 1 to 200 do + V := AdvanceProgress(V, 0, 0.25, Step); + Check('между вехами движется', V > 0.2); + Check('следующую веху не переступает', V < 0.25); + + { 4. Замедление: вторая половина пути до вехи занимает столько же шагов, + сколько первая. Это и значит «чем дольше, тем медленнее». } + N1 := StepsFrom(0, 0, 1, 0.5); + N2 := StepsFrom(0.5, 0, 1, 0.75); + Check('вторая половина пути не быстрее первой', N2 >= N1); + WriteLn(Format(' шагов до половины: %d, до трёх четвертей: %d', + [N1, N1 + N2])); + + { 5. В конец не упирается, сколько ни жди. } + V := 0; + for I := 1 to 100000 do + V := AdvanceProgress(V, 0, 1, Step); + Check('полной не становится без настоящего конца', V <= 0.999); + + { 6. Ход монотонный. } + V := 0; + Prev := -1; + for I := 1 to 500 do + begin + V := AdvanceProgress(V, 0, 1, Step); + if V < Prev then + Break; + Prev := V; + end; + Check('ход монотонный', V >= Prev); + + WriteLn; + if Failed = 0 then + WriteLn('ВЕРДИКТ: все проверки пройдены') + else + begin + WriteLn('ВЕРДИКТ: не пройдено проверок: ', Failed); + Halt(1); + end; +end.