Этап 1: форма звука на клипах
Для каждого файла один раз строится список пиков: сто значений в секунду, каждое есть наибольший модуль отсчёта за свои десять миллисекунд. Рисовать по настоящим отсчётам нельзя — в секунде их 48 тысяч, а в клипе на экране сотни пикселей. Разбор идёт в отдельном потоке и запоминается в кэше проекта. Через временный файл, а не по трубе: запуск внешних программ режет вывод на строки, а тут поток байтов, где перевод строки — такой же отсчёт. Shift со стрелками вверх и вниз растягивает форму по высоте. Звук бывает тихим, и угадывать за человека нужное усиление неправильно. Меняется только рисунок, значение сохраняется между запусками. Проверено: файл «4 с тона, 4 с тишины, 4 с тона» даёт форму в первой и последней трети и пустоту посередине. Полная амплитуда даёт 254 из 255. Разбор записи на 892 с занимает 12.7 с — это чтение 6.3 ГБ с диска, быстрее не выйдет. Первоначальный критерий «меньше двух секунд» в плане был занижен и исправлен по замеру. Заодно снят риск четвёртого этапа: mpv принимает edl:// как внешнюю звуковую дорожку и берёт звук именно из неё. Проверено встречными списками — картинке «тишина, потом тон», звуку «тон, потом тишина».
This commit is contained in:
chaiman
parent
f7fc7a0503
commit
f1ef6e624a
5 changed files with 572 additions and 2 deletions
16
README.md
16
README.md
|
|
@ -62,6 +62,7 @@ Lazarus другой версии, и собранные им модули LCL
|
|||
| Прокрутка по дорожкам | колесо мыши |
|
||||
| Прокрутка по времени | Shift + колесо, средняя кнопка |
|
||||
| Прокрутка журнала вбок | Shift + колесо над журналом |
|
||||
| Растянуть форму звука по высоте | Shift + стрелки вверх и вниз |
|
||||
| Выключить дорожку / оставить только её | кнопки М и С в заголовке |
|
||||
| Громкость клипа | тянуть ручку на клипе вверх-вниз |
|
||||
| Автосхлопывание вкл/выкл | Ctrl+K |
|
||||
|
|
@ -137,6 +138,20 @@ Ctrl+Shift+R, который схлопывает дыру под курсоро
|
|||
В списке файлов слева показывается кадр из каждого файла, его параметры
|
||||
и длительность. Кадры делаются в фоне и запоминаются в кэше проекта.
|
||||
|
||||
На клипах видна форма звука. Считается она по заранее разобранным пикам —
|
||||
сто значений в секунду, каждое есть наибольший модуль отсчёта за свои
|
||||
десять миллисекунд. Рисовать по настоящим отсчётам нельзя: в секунде их
|
||||
48 тысяч, а в клипе на экране сотни пикселей.
|
||||
|
||||
Разбор идёт в фоне и запоминается в кэше проекта. Для записи на 892 с это
|
||||
около 13 секунд — столько занимает чтение шести гигабайт с диска, и
|
||||
быстрее не выйдет; при следующем открытии проекта пики берутся готовыми.
|
||||
|
||||
**Shift со стрелками вверх и вниз растягивает форму по высоте.** Звук
|
||||
бывает тихим, и угадывать за человека, во сколько раз растянуть картинку,
|
||||
неправильно. Усиление меняет только рисунок, самого звука не касается, и
|
||||
запоминается между запусками.
|
||||
|
||||
## Файл не совпадает с проектом
|
||||
|
||||
Проект имеет одно разрешение и один набор кодеков на всё — иначе куски не
|
||||
|
|
@ -433,6 +448,7 @@ Wine с новой библиотекой не грузилось ничего.
|
|||
| `src/uPanCropForm.pas` | Окно кадрирования и поворота |
|
||||
| `src/uProjectInfoForm.pas` | Сведения о проекте и ответ ffprobe |
|
||||
| `src/uThumbs.pas` | Кадры-миниатюры для списка файлов |
|
||||
| `src/uWaveform.pas` | Пики звука для формы волны на клипах |
|
||||
| `src/uTheme.pas` | Цвета окна, своя кнопка, своё окно сообщения |
|
||||
| `src/uLogView.pas` | Журнал: своя отрисовка, свои полосы прокрутки |
|
||||
| `src/uThemedScroll.pas` | Полоса прокрутки и обвязка для таблиц |
|
||||
|
|
|
|||
|
|
@ -27,7 +27,7 @@ uses
|
|||
uAppTypes, uEdl, uMpvLib, uMpvPlayer, uProject, uMediaProbe, uTimelineCtrl,
|
||||
uFlatten, uGenerate, uExport, uProgressForm, uRemuxForm, uMismatchForm,
|
||||
uFfmpegJob, uSettings, uThumbs, uTransform, uPanCropForm,
|
||||
uProjectInfoForm, ImgList, uTheme, uLogView, uDepsForm;
|
||||
uProjectInfoForm, ImgList, uTheme, uLogView, uDepsForm, uWaveform;
|
||||
|
||||
type
|
||||
|
||||
|
|
@ -102,6 +102,7 @@ type
|
|||
|
||||
FThumbs: TImageList;
|
||||
FThumbThread: TThumbThread;
|
||||
FPeaksThread: TPeaksThread;
|
||||
{ Соответствие «путь к файлу -> номер картинки в списке изображений».
|
||||
По пути, а не по номеру в списке проекта: пока миниатюра делается,
|
||||
файлы могут добавиться или пропасть. Номер хранится увеличенным на
|
||||
|
|
@ -149,6 +150,8 @@ type
|
|||
procedure ApplySettings;
|
||||
procedure CollectSettings;
|
||||
procedure StartThumbs;
|
||||
procedure StartPeaks;
|
||||
procedure PeaksReady(Sender: TObject; const ASourcePath: string);
|
||||
procedure ThumbReady(Sender: TObject; const ASourcePath,
|
||||
AThumbPath: string);
|
||||
procedure SeekPlayerTo(const ATime: Double);
|
||||
|
|
@ -357,6 +360,12 @@ begin
|
|||
FThumbThread.WaitFor;
|
||||
FreeAndNil(FThumbThread);
|
||||
end;
|
||||
if Assigned(FPeaksThread) then
|
||||
begin
|
||||
FPeaksThread.Terminate;
|
||||
FPeaksThread.WaitFor;
|
||||
FreeAndNil(FPeaksThread);
|
||||
end;
|
||||
FreeAndNil(FThumbMap);
|
||||
CollectSettings;
|
||||
FSettings.Save;
|
||||
|
|
@ -384,6 +393,7 @@ begin
|
|||
|
||||
pnlVideo.Height := FSettings.VideoPanelHeight;
|
||||
FTimeline.TrackHeight := FSettings.TrackHeight;
|
||||
FTimeline.WaveGain := FSettings.WaveGain;
|
||||
|
||||
{ Режим схлопывания и его состояние переживают перезапуск. }
|
||||
if FSettings.RippleAllTracks then
|
||||
|
|
@ -420,6 +430,7 @@ begin
|
|||
FSettings.VideoPanelHeight := pnlVideo.Height;
|
||||
FSettings.RippleAllTracks := FProject.RippleMode = rmAllTracks;
|
||||
FSettings.RippleEnabled := FProject.RippleEnabled;
|
||||
FSettings.WaveGain := FTimeline.WaveGain;
|
||||
end;
|
||||
|
||||
procedure TMainForm.BuildTimeline;
|
||||
|
|
@ -755,6 +766,7 @@ begin
|
|||
[FProject.PoolCount,
|
||||
Plural(FProject.PoolCount, 'файл', 'файла', 'файлов')]);
|
||||
StartThumbs;
|
||||
StartPeaks;
|
||||
end;
|
||||
|
||||
{ Запускает изготовление недостающих миниатюр.
|
||||
|
|
@ -819,6 +831,54 @@ begin
|
|||
FThumbThread.Start;
|
||||
end;
|
||||
|
||||
{ Разбор звука для формы волны. Отдельная очередь от миниатюр: разбор
|
||||
идёт дольше, и держать миниатюры в ожидании звука незачем. }
|
||||
procedure TMainForm.StartPeaks;
|
||||
var
|
||||
Requests: TPeaksRequests = nil;
|
||||
I, N: Integer;
|
||||
Item: TMediaItem;
|
||||
Dummy: TPeaks;
|
||||
begin
|
||||
if Assigned(FPeaksThread) then
|
||||
begin
|
||||
FPeaksThread.Terminate;
|
||||
FPeaksThread.WaitFor;
|
||||
FreeAndNil(FPeaksThread);
|
||||
end;
|
||||
|
||||
if FProject.PoolCount = 0 then
|
||||
Exit;
|
||||
|
||||
SetLength(Requests, FProject.PoolCount);
|
||||
N := 0;
|
||||
for I := 0 to FProject.PoolCount - 1 do
|
||||
begin
|
||||
Item := FProject.Pool[I];
|
||||
if not Item.Info.HasAudio then
|
||||
Continue;
|
||||
if CachedPeaks(FProject.CacheDir, Item.EffectivePath, Dummy) then
|
||||
Continue;
|
||||
Requests[N].SourcePath := Item.EffectivePath;
|
||||
Requests[N].TargetPath := PeaksPath(FProject.CacheDir, Item.EffectivePath);
|
||||
Inc(N);
|
||||
end;
|
||||
SetLength(Requests, N);
|
||||
if N = 0 then
|
||||
Exit;
|
||||
|
||||
FPeaksThread := TPeaksThread.Create(Requests);
|
||||
FPeaksThread.OnReady := @PeaksReady;
|
||||
FPeaksThread.Start;
|
||||
end;
|
||||
|
||||
procedure TMainForm.PeaksReady(Sender: TObject; const ASourcePath: string);
|
||||
begin
|
||||
{ Запомненную неудачу надо забыть: пики только что появились. }
|
||||
ForgetPeaks;
|
||||
FTimeline.Invalidate;
|
||||
end;
|
||||
|
||||
procedure TMainForm.ThumbReady(Sender: TObject; const ASourcePath,
|
||||
AThumbPath: string);
|
||||
var
|
||||
|
|
|
|||
|
|
@ -33,6 +33,7 @@ type
|
|||
FRippleAllTracks: Boolean;
|
||||
FRippleEnabled: Boolean;
|
||||
FTrackHeight: Integer;
|
||||
FWaveGain: Double;
|
||||
FVideoPanelHeight: Integer;
|
||||
FRecentProjects: TStringList;
|
||||
function FileName: string;
|
||||
|
|
@ -58,6 +59,8 @@ type
|
|||
property RippleAllTracks: Boolean read FRippleAllTracks write FRippleAllTracks;
|
||||
property RippleEnabled: Boolean read FRippleEnabled write FRippleEnabled;
|
||||
property TrackHeight: Integer read FTrackHeight write FTrackHeight;
|
||||
{ Во сколько раз растянута форма звука на клипах. Только рисунок. }
|
||||
property WaveGain: Double read FWaveGain write FWaveGain;
|
||||
property VideoPanelHeight: Integer read FVideoPanelHeight write FVideoPanelHeight;
|
||||
end;
|
||||
|
||||
|
|
@ -70,6 +73,7 @@ const
|
|||
DefaultWidth = 1600;
|
||||
DefaultHeight = 900;
|
||||
DefaultTrackHeight = 64;
|
||||
DefaultWaveGain = 1.0;
|
||||
DefaultVideoHeight = 400;
|
||||
|
||||
{ Больше десятка в меню не помещается по-человечески, да и не нужно. }
|
||||
|
|
@ -84,6 +88,7 @@ begin
|
|||
FWindowWidth := DefaultWidth;
|
||||
FWindowHeight := DefaultHeight;
|
||||
FTrackHeight := DefaultTrackHeight;
|
||||
FWaveGain := DefaultWaveGain;
|
||||
FVideoPanelHeight := DefaultVideoHeight;
|
||||
end;
|
||||
|
||||
|
|
@ -161,6 +166,7 @@ begin
|
|||
FRippleAllTracks := Obj.Get('ripple_all_tracks', FRippleAllTracks);
|
||||
FRippleEnabled := Obj.Get('ripple_enabled', FRippleEnabled);
|
||||
FTrackHeight := Obj.Get('track_height', FTrackHeight);
|
||||
FWaveGain := Obj.Get('wave_gain', FWaveGain);
|
||||
FVideoPanelHeight := Obj.Get('video_panel_height', FVideoPanelHeight);
|
||||
|
||||
Arr := Obj.Find('recent_projects', jtArray) as TJSONArray;
|
||||
|
|
@ -181,6 +187,8 @@ begin
|
|||
FWindowWidth := DefaultWidth;
|
||||
if FWindowHeight < 480 then
|
||||
FWindowHeight := DefaultHeight;
|
||||
if (FWaveGain < 1) or (FWaveGain > 64) then
|
||||
FWaveGain := DefaultWaveGain;
|
||||
if (FTrackHeight < 24) or (FTrackHeight > 300) then
|
||||
FTrackHeight := DefaultTrackHeight;
|
||||
if FVideoPanelHeight < 100 then
|
||||
|
|
@ -207,6 +215,7 @@ begin
|
|||
Root.Add('ripple_all_tracks', FRippleAllTracks);
|
||||
Root.Add('ripple_enabled', FRippleEnabled);
|
||||
Root.Add('track_height', FTrackHeight);
|
||||
Root.Add('wave_gain', FWaveGain);
|
||||
Root.Add('video_panel_height', FVideoPanelHeight);
|
||||
|
||||
Arr := TJSONArray.Create;
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ interface
|
|||
|
||||
uses
|
||||
Classes, SysUtils, Controls, Graphics, LCLType, LCLIntf, Forms, Math,
|
||||
uAppTypes, uProject, uMediaProbe, uKeyframeIndex;
|
||||
uAppTypes, uProject, uMediaProbe, uKeyframeIndex, uWaveform;
|
||||
|
||||
type
|
||||
{ Что сейчас делает мышь. }
|
||||
|
|
@ -94,6 +94,10 @@ type
|
|||
FSnapEnabled: Boolean;
|
||||
FSnapSuspended: Boolean;
|
||||
FDragOrigVolume: Double;
|
||||
{ Во сколько раз растянуть форму звука по высоте. Только рисунок,
|
||||
самого звука не касается: у тихих записей иначе не видно, где
|
||||
тишина, а где нет. }
|
||||
FWaveGain: Double;
|
||||
{ Клипы, которые поедут вслед за перетаскиваемым, и их исходные
|
||||
позиции. Список составляется один раз при нажатии: пересчитывать
|
||||
его на каждое движение мыши нельзя, иначе в него начнут попадать
|
||||
|
|
@ -129,9 +133,11 @@ type
|
|||
procedure DrawClip(ACanvas: TCanvas; AClip: TClip; ATop: Integer);
|
||||
procedure DrawPlayhead(ACanvas: TCanvas);
|
||||
procedure DrawHeaders(ACanvas: TCanvas);
|
||||
procedure DrawWaveform(ACanvas: TCanvas; AClip: TClip; const ABody: TRect);
|
||||
procedure DrawVolume(ACanvas: TCanvas; AClip: TClip; ATop: Integer;
|
||||
const ABody: TRect);
|
||||
|
||||
procedure SetWaveGain(const AValue: Double);
|
||||
procedure SetPlayhead(const AValue: Double);
|
||||
procedure SetPixelsPerSecond(const AValue: Double);
|
||||
procedure ClampScroll;
|
||||
|
|
@ -208,6 +214,8 @@ type
|
|||
property SnapEnabled: Boolean read FSnapEnabled write FSnapEnabled;
|
||||
|
||||
property Project: TProject read FProject write FProject;
|
||||
{ Усиление формы звука. Меняется по Shift со стрелками. }
|
||||
property WaveGain: Double read FWaveGain write SetWaveGain;
|
||||
property Playhead: Double read FPlayhead write SetPlayhead;
|
||||
property PixelsPerSecond: Double read FPixelsPerSecond write SetPixelsPerSecond;
|
||||
property ScrollOffset: Double read FScrollOffset write FScrollOffset;
|
||||
|
|
@ -286,6 +294,7 @@ const
|
|||
ColorPlayhead = TColor($4040FF); // красный: привычный цвет курсора
|
||||
ColorEdgeSnap = TColor($909090); // серый: рез притянут к опорному кадру
|
||||
ColorEdgePrecise = TColor($FFC030); // голубой: рез потребует перекодирования
|
||||
ColorWave = TColor($7A6A55); // приглушённый синий: форма звука
|
||||
ColorVolumeLine = TColor($60E0E0); // жёлтый: линия громкости
|
||||
ColorVolumeHandle = TColor($30C0FF); // оранжевый: ручка громкости
|
||||
ColorHeaderActive = TColor($3A3A3A); // подсветка выбранной дорожки
|
||||
|
|
@ -297,6 +306,7 @@ const
|
|||
|
||||
constructor TTimelineControl.Create(AOwner: TComponent);
|
||||
begin
|
||||
FWaveGain := 1;
|
||||
inherited Create(AOwner);
|
||||
ControlStyle := ControlStyle + [csOpaque];
|
||||
TabStop := True;
|
||||
|
|
@ -661,6 +671,10 @@ begin
|
|||
ACanvas.FillRect(Body.Right - 4, Body.Top + 1, Body.Right - 1, Body.Bottom - 1);
|
||||
end;
|
||||
|
||||
{ Форма звука — фон клипа, поэтому идёт раньше всего остального, что на
|
||||
нём рисуется. }
|
||||
DrawWaveform(ACanvas, AClip, Body);
|
||||
|
||||
{ Громкость рисуется до подписей: иначе её линия перечёркивает название
|
||||
и длительность. }
|
||||
DrawVolume(ACanvas, AClip, ATop, Body);
|
||||
|
|
@ -686,6 +700,78 @@ begin
|
|||
ACanvas.Brush.Style := bsSolid;
|
||||
end;
|
||||
|
||||
{ Форма звука внутри клипа.
|
||||
|
||||
Рисуется по заранее посчитанным пикам, а не по самому звуку: в секунде
|
||||
48 тысяч отсчётов, а в клипе на экране — сотни пикселей.
|
||||
|
||||
Считается только видимая часть: у часового клипа за краем экрана
|
||||
остаётся почти всё, и перебирать его целиком на каждую перерисовку
|
||||
незачем. }
|
||||
procedure TTimelineControl.DrawWaveform(ACanvas: TCanvas; AClip: TClip;
|
||||
const ABody: TRect);
|
||||
var
|
||||
Item: TMediaItem;
|
||||
Peaks: TPeaks;
|
||||
X, MidY, HalfH, H: Integer;
|
||||
SrcTime: Double;
|
||||
Idx, Value: Integer;
|
||||
begin
|
||||
if (FProject = nil) or (AClip.Kind <> ckVideo) then
|
||||
Exit;
|
||||
Item := FProject.FindMedia(AClip.MediaId);
|
||||
if (Item = nil) or (not Item.Info.HasAudio) then
|
||||
Exit;
|
||||
if not CachedPeaks(FProject.CacheDir, Item.EffectivePath, Peaks) then
|
||||
Exit;
|
||||
if (Peaks.Rate <= 0) or (Length(Peaks.Data) = 0) then
|
||||
Exit;
|
||||
|
||||
MidY := (ABody.Top + ABody.Bottom) div 2;
|
||||
HalfH := (ABody.Bottom - ABody.Top) div 2 - 2;
|
||||
if HalfH < 2 then
|
||||
Exit;
|
||||
|
||||
ACanvas.Pen.Color := ColorWave;
|
||||
ACanvas.Pen.Style := psSolid;
|
||||
|
||||
for X := ABody.Left + 1 to ABody.Right - 2 do
|
||||
begin
|
||||
{ От точки на экране — к моменту внутри исходника. }
|
||||
SrcTime := AClip.SrcIn + (XToTime(X) - AClip.TlStart);
|
||||
if SrcTime < 0 then
|
||||
Continue;
|
||||
Idx := Trunc(SrcTime * Peaks.Rate);
|
||||
if (Idx < 0) or (Idx > High(Peaks.Data)) then
|
||||
Continue;
|
||||
|
||||
Value := Round(Peaks.Data[Idx] * FWaveGain);
|
||||
if Value > 255 then
|
||||
Value := 255;
|
||||
H := Value * HalfH div 255;
|
||||
if H < 1 then
|
||||
Continue;
|
||||
ACanvas.Line(X, MidY - H, X, MidY + H);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTimelineControl.SetWaveGain(const AValue: Double);
|
||||
var
|
||||
V: Double;
|
||||
begin
|
||||
V := AValue;
|
||||
{ Ниже единицы опускаться незачем: это уже настоящая амплитуда.
|
||||
Выше шестидесяти четырёх — сплошная заливка, смысла тоже нет. }
|
||||
if V < 1 then
|
||||
V := 1;
|
||||
if V > 64 then
|
||||
V := 64;
|
||||
if Abs(V - FWaveGain) < 0.001 then
|
||||
Exit;
|
||||
FWaveGain := V;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
{ Линия громкости с ручкой посередине видимой части клипа.
|
||||
|
||||
Сделано как в монтажных программах: линия показывает уровень, за ручку
|
||||
|
|
@ -1748,6 +1834,25 @@ procedure TTimelineControl.KeyDown(var Key: Word; Shift: TShiftState);
|
|||
begin
|
||||
inherited KeyDown(Key, Shift);
|
||||
|
||||
{ Shift со стрелками растягивает форму звука по высоте. Угадывать
|
||||
нужное усиление за пользователя неправильно: запись бывает и тихой,
|
||||
и на пределе. }
|
||||
if (ssShift in Shift) and not (ssCtrl in Shift) then
|
||||
case Key of
|
||||
VK_UP:
|
||||
begin
|
||||
WaveGain := FWaveGain * 1.5;
|
||||
Key := 0;
|
||||
Exit;
|
||||
end;
|
||||
VK_DOWN:
|
||||
begin
|
||||
WaveGain := FWaveGain / 1.5;
|
||||
Key := 0;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
case Key of
|
||||
VK_DELETE:
|
||||
begin
|
||||
|
|
|
|||
380
src/uWaveform.pas
Normal file
380
src/uWaveform.pas
Normal file
|
|
@ -0,0 +1,380 @@
|
|||
{
|
||||
uWaveform — форма звука для отрисовки на клипах.
|
||||
|
||||
Что считается. Для каждого файла один раз строится список пиков: сто
|
||||
значений в секунду, каждое — наибольший модуль отсчёта за свои десять
|
||||
миллисекунд. Часовая запись даёт 360 тысяч байт, это ничто.
|
||||
|
||||
Почему не полная звуковая дорожка. Рисовать по настоящим отсчётам
|
||||
нельзя: в секунде их 48 тысяч, а в клипе на экране — сотни пикселей.
|
||||
Пришлось бы каждый раз перечитывать файл целиком.
|
||||
|
||||
Почему через временный файл, а не по трубе. Запуск внешних программ у
|
||||
нас режет вывод на строки, а тут поток байтов, где перевод строки —
|
||||
такой же отсчёт, как любой другой. Временный файл на четырнадцать
|
||||
мегабайт для часовой записи проще и надёжнее, чем отдельный двоичный
|
||||
путь чтения.
|
||||
|
||||
Считается в отдельном потоке: список файлов должен работать, пока звук
|
||||
разбирается.
|
||||
}
|
||||
unit uWaveform;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, uProcRunner;
|
||||
|
||||
const
|
||||
{ Пиков в секунду. Сто — это десять миллисекунд на пик: мельче глазу
|
||||
всё равно не видно, а крупнее уже теряются короткие звуки. }
|
||||
PeaksPerSecond = 100;
|
||||
|
||||
{ Частота, на которой разбирается звук. Восьми килогерц хватает, чтобы
|
||||
отличить тишину от звука, а объём вчетверо меньше исходного. }
|
||||
DecodeRate = 8000;
|
||||
|
||||
type
|
||||
TPeaks = record
|
||||
Valid: Boolean;
|
||||
Rate: Integer;
|
||||
{ Наибольший модуль отсчёта за интервал, приведённый к 0..255. }
|
||||
Data: array of Byte;
|
||||
end;
|
||||
|
||||
{ Путь к файлу пиков в кэше проекта. }
|
||||
function PeaksPath(const ACacheDir, ASourcePath: string): string;
|
||||
|
||||
{ Разбирает звук файла и записывает пики. Долгая операция, вызывать из
|
||||
рабочего потока. }
|
||||
function BuildPeaks(const ASourcePath, ATargetPath: string;
|
||||
ACancel: TProcCancelQuery; out AError: string): Boolean;
|
||||
|
||||
{ Читает готовые пики. }
|
||||
function LoadPeaks(const APath: string; out APeaks: TPeaks): Boolean;
|
||||
|
||||
{ Пики файла с запоминанием в памяти. Если их ещё нет на диске, вернёт
|
||||
False — считать надо отдельно, в потоке. }
|
||||
function CachedPeaks(const ACacheDir, ASourcePath: string;
|
||||
out APeaks: TPeaks): Boolean;
|
||||
|
||||
{ Забыть запомненное. Нужно при закрытии проекта: следующий проект живёт
|
||||
в другом кэше. }
|
||||
procedure ForgetPeaks;
|
||||
|
||||
type
|
||||
TPeaksRequest = record
|
||||
SourcePath: string;
|
||||
TargetPath: string;
|
||||
end;
|
||||
|
||||
TPeaksRequests = array of TPeaksRequest;
|
||||
|
||||
TPeaksReadyEvent = procedure(Sender: TObject;
|
||||
const ASourcePath: string) of object;
|
||||
|
||||
TPeaksThread = class(TThread)
|
||||
private
|
||||
FRequests: TPeaksRequests;
|
||||
FCurrent: Integer;
|
||||
FOnReady: TPeaksReadyEvent;
|
||||
procedure SyncReady;
|
||||
function CancelQuery: Boolean;
|
||||
protected
|
||||
procedure Execute; override;
|
||||
public
|
||||
constructor Create(const ARequests: TPeaksRequests);
|
||||
property OnReady: TPeaksReadyEvent read FOnReady write FOnReady;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
md5, uFfmpegCmd;
|
||||
|
||||
const
|
||||
{ Заголовок файла пиков: подпись и номер вида. Номер понадобится, если
|
||||
когда-нибудь поменяется частота или формат. }
|
||||
PeaksMagic = 'NLVW';
|
||||
PeaksVersion = 1;
|
||||
|
||||
{ Сколько отсчётов приходится на один пик. }
|
||||
SamplesPerPeak = DecodeRate div PeaksPerSecond;
|
||||
|
||||
ReadChunk = 64 * 1024;
|
||||
|
||||
type
|
||||
TPeaksCacheItem = class
|
||||
Peaks: TPeaks;
|
||||
end;
|
||||
|
||||
var
|
||||
{ Запомненные пики: путь к исходнику — объект с данными. }
|
||||
FCache: TStringList = nil;
|
||||
|
||||
function PeaksPath(const ACacheDir, ASourcePath: string): string;
|
||||
begin
|
||||
Result := IncludeTrailingPathDelimiter(ACacheDir) + 'peaks' + PathDelim +
|
||||
MD5Print(MD5String(ASourcePath)) + '.pk';
|
||||
end;
|
||||
|
||||
function BuildPeaks(const ASourcePath, ATargetPath: string;
|
||||
ACancel: TProcCancelQuery; out AError: string): Boolean;
|
||||
var
|
||||
RawPath: string;
|
||||
Res: TProcResult;
|
||||
Src: TFileStream;
|
||||
Dst: TFileStream;
|
||||
Buffer: array[0..ReadChunk - 1] of SmallInt;
|
||||
Got, I, Count: Integer;
|
||||
Acc, Peak: Integer;
|
||||
InPeak: Integer;
|
||||
Peaks: array of Byte;
|
||||
PeakCount: Integer;
|
||||
Rate: Integer;
|
||||
V: SmallInt;
|
||||
|
||||
procedure PushPeak(AValue: Integer);
|
||||
begin
|
||||
if PeakCount >= Length(Peaks) then
|
||||
SetLength(Peaks, Length(Peaks) * 2 + 1024);
|
||||
{ Отсчёт занимает 15 бит со знаком, а в байте помещается 8. Делим на
|
||||
129, а не на 128: иначе полная амплитуда дала бы 256. }
|
||||
Peaks[PeakCount] := AValue div 129;
|
||||
Inc(PeakCount);
|
||||
end;
|
||||
|
||||
begin
|
||||
Result := False;
|
||||
AError := '';
|
||||
Rate := PeaksPerSecond;
|
||||
|
||||
if not ForceDirectories(ExtractFilePath(ATargetPath)) then
|
||||
begin
|
||||
AError := 'Не удалось создать каталог для пиков.';
|
||||
Exit;
|
||||
end;
|
||||
|
||||
RawPath := ATargetPath + '.raw';
|
||||
|
||||
{ Один звуковой поток, одна дорожка, восемь килогерц. Видео отбрасываем
|
||||
целиком: оно здесь только мешает и тратит время. }
|
||||
Res := RunProcess(FfmpegExe,
|
||||
['-hide_banner', '-nostdin', '-loglevel', 'error', '-y',
|
||||
'-i', ASourcePath, '-vn', '-map', '0:a:0',
|
||||
'-ac', '1', '-ar', IntToStr(DecodeRate),
|
||||
'-f', 's16le', RawPath],
|
||||
nil, nil, ACancel);
|
||||
|
||||
if not Res.Started then
|
||||
begin
|
||||
AError := 'Не удалось запустить ffmpeg: ' + Res.ErrorText;
|
||||
Exit;
|
||||
end;
|
||||
if Res.Cancelled then
|
||||
begin
|
||||
SysUtils.DeleteFile(RawPath);
|
||||
Exit;
|
||||
end;
|
||||
if (Res.ExitCode <> 0) or (not FileExists(RawPath)) then
|
||||
begin
|
||||
{ Обычная причина — в файле нет звука. Это не беда, просто рисовать
|
||||
нечего. }
|
||||
AError := 'Звук не разобран (код ' + IntToStr(Res.ExitCode) + ').';
|
||||
SysUtils.DeleteFile(RawPath);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
Peaks := nil;
|
||||
PeakCount := 0;
|
||||
InPeak := 0;
|
||||
Peak := 0;
|
||||
|
||||
try
|
||||
Src := TFileStream.Create(RawPath, fmOpenRead or fmShareDenyNone);
|
||||
try
|
||||
repeat
|
||||
Got := Src.Read(Buffer, SizeOf(Buffer)) div SizeOf(SmallInt);
|
||||
if Got <= 0 then
|
||||
Break;
|
||||
for I := 0 to Got - 1 do
|
||||
begin
|
||||
V := Buffer[I];
|
||||
if V < 0 then
|
||||
Acc := -Integer(V)
|
||||
else
|
||||
Acc := V;
|
||||
if Acc > Peak then
|
||||
Peak := Acc;
|
||||
Inc(InPeak);
|
||||
if InPeak >= SamplesPerPeak then
|
||||
begin
|
||||
PushPeak(Peak);
|
||||
Peak := 0;
|
||||
InPeak := 0;
|
||||
end;
|
||||
end;
|
||||
until False;
|
||||
|
||||
{ Хвост короче полного интервала тоже показываем. }
|
||||
if InPeak > 0 then
|
||||
PushPeak(Peak);
|
||||
finally
|
||||
Src.Free;
|
||||
end;
|
||||
|
||||
Dst := TFileStream.Create(ATargetPath, fmCreate);
|
||||
try
|
||||
Dst.WriteBuffer(PeaksMagic[1], 4);
|
||||
Count := PeaksVersion;
|
||||
Dst.WriteBuffer(Count, SizeOf(Count));
|
||||
Dst.WriteBuffer(Rate, SizeOf(Rate));
|
||||
Dst.WriteBuffer(PeakCount, SizeOf(PeakCount));
|
||||
if PeakCount > 0 then
|
||||
Dst.WriteBuffer(Peaks[0], PeakCount);
|
||||
finally
|
||||
Dst.Free;
|
||||
end;
|
||||
|
||||
Result := True;
|
||||
except
|
||||
on E: Exception do
|
||||
AError := E.Message;
|
||||
end;
|
||||
|
||||
SysUtils.DeleteFile(RawPath);
|
||||
end;
|
||||
|
||||
function LoadPeaks(const APath: string; out APeaks: TPeaks): Boolean;
|
||||
var
|
||||
Src: TFileStream;
|
||||
Sig: array[0..3] of AnsiChar;
|
||||
Version, Rate, Count: Integer;
|
||||
begin
|
||||
Result := False;
|
||||
APeaks := Default(TPeaks);
|
||||
if not FileExists(APath) then
|
||||
Exit;
|
||||
|
||||
try
|
||||
Src := TFileStream.Create(APath, fmOpenRead or fmShareDenyNone);
|
||||
try
|
||||
if Src.Size < 16 then
|
||||
Exit;
|
||||
Src.ReadBuffer(Sig, 4);
|
||||
if (Sig[0] <> 'N') or (Sig[1] <> 'L') or (Sig[2] <> 'V') or
|
||||
(Sig[3] <> 'W') then
|
||||
Exit;
|
||||
Src.ReadBuffer(Version, SizeOf(Version));
|
||||
if Version <> PeaksVersion then
|
||||
Exit;
|
||||
Src.ReadBuffer(Rate, SizeOf(Rate));
|
||||
Src.ReadBuffer(Count, SizeOf(Count));
|
||||
if (Count < 0) or (Count > Src.Size - Src.Position) then
|
||||
Exit;
|
||||
|
||||
SetLength(APeaks.Data, Count);
|
||||
if Count > 0 then
|
||||
Src.ReadBuffer(APeaks.Data[0], Count);
|
||||
APeaks.Rate := Rate;
|
||||
APeaks.Valid := True;
|
||||
Result := True;
|
||||
finally
|
||||
Src.Free;
|
||||
end;
|
||||
except
|
||||
{ Испорченный кэш — не беда: осциллограммы просто не будет. }
|
||||
APeaks := Default(TPeaks);
|
||||
Result := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
function CachedPeaks(const ACacheDir, ASourcePath: string;
|
||||
out APeaks: TPeaks): Boolean;
|
||||
var
|
||||
Idx: Integer;
|
||||
Item: TPeaksCacheItem;
|
||||
Path: string;
|
||||
begin
|
||||
APeaks := Default(TPeaks);
|
||||
if FCache = nil then
|
||||
begin
|
||||
FCache := TStringList.Create;
|
||||
FCache.Sorted := True;
|
||||
FCache.OwnsObjects := True;
|
||||
end;
|
||||
|
||||
Idx := FCache.IndexOf(ASourcePath);
|
||||
if Idx >= 0 then
|
||||
begin
|
||||
APeaks := TPeaksCacheItem(FCache.Objects[Idx]).Peaks;
|
||||
Exit(APeaks.Valid);
|
||||
end;
|
||||
|
||||
Path := PeaksPath(ACacheDir, ASourcePath);
|
||||
Item := TPeaksCacheItem.Create;
|
||||
{ Неудачу тоже запоминаем: иначе при каждой отрисовке мы бы стучались
|
||||
на диск за файлом, которого нет. }
|
||||
LoadPeaks(Path, Item.Peaks);
|
||||
FCache.AddObject(ASourcePath, Item);
|
||||
APeaks := Item.Peaks;
|
||||
Result := APeaks.Valid;
|
||||
end;
|
||||
|
||||
procedure ForgetPeaks;
|
||||
begin
|
||||
FreeAndNil(FCache);
|
||||
end;
|
||||
|
||||
{ TPeaksThread }
|
||||
|
||||
constructor TPeaksThread.Create(const ARequests: TPeaksRequests);
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
inherited Create(True);
|
||||
FreeOnTerminate := False;
|
||||
SetLength(FRequests, Length(ARequests));
|
||||
for I := 0 to High(ARequests) do
|
||||
FRequests[I] := ARequests[I];
|
||||
end;
|
||||
|
||||
function TPeaksThread.CancelQuery: Boolean;
|
||||
begin
|
||||
Result := Terminated;
|
||||
end;
|
||||
|
||||
procedure TPeaksThread.SyncReady;
|
||||
begin
|
||||
if Assigned(FOnReady) and (FCurrent >= 0) and
|
||||
(FCurrent <= High(FRequests)) then
|
||||
FOnReady(Self, FRequests[FCurrent].SourcePath);
|
||||
end;
|
||||
|
||||
procedure TPeaksThread.Execute;
|
||||
var
|
||||
I: Integer;
|
||||
Err: string;
|
||||
begin
|
||||
for I := 0 to High(FRequests) do
|
||||
begin
|
||||
if Terminated then
|
||||
Break;
|
||||
FCurrent := I;
|
||||
if FileExists(FRequests[I].TargetPath) then
|
||||
begin
|
||||
Synchronize(@SyncReady);
|
||||
Continue;
|
||||
end;
|
||||
if BuildPeaks(FRequests[I].SourcePath, FRequests[I].TargetPath,
|
||||
@CancelQuery, Err) then
|
||||
Synchronize(@SyncReady);
|
||||
end;
|
||||
end;
|
||||
|
||||
finalization
|
||||
FreeAndNil(FCache);
|
||||
|
||||
end.
|
||||
Loading…
Add table
Add a link
Reference in a new issue