4aiman
939184fce7
Дыра в сорок минут требовала двухчасового чёрного файла: лестница готовых длин доходила до восьми часов, и NVENC кодировал такое минутами. Отсюда «Делаю чёрную вставку 1 из 3», которое не кончается. Теперь длины две, 15 и 60 секунд, длинная дыра набирается повторами минутного файла, а само чёрное кодируется мегабитом вместо полусотни. Промежуток короче половины кадра дырой больше не считается: между клипами, сдвинутыми встык мышью, оставались микросекунды. Мышь при этом кладёт клипы на кадровую сетку — между кадрами времени не существует. Правка монтажа прекращает генерацию, ставшую ненужной: раньше закрытая дыра не отменяла уже начатую работу. Ctrl+Shift+R работает без мыши: дыра ищется на активной дорожке, если указатель не над дорожками, и команда отвечает в строке состояния, а не молчит. Вжигание текста режет кусок на части и пересобирает только середину. Надпись в тридцать секунд внутри сорокаминутного куска стоила сорока минут пересборки. Часть после надписи помечается точным резом, иначе копия пошла бы от опорного кадра и картинка сдвинулась бы. Проверки: flattest 13 и 14, схлопывание без мыши в lfmcheck, сборка с надписью внутри длинного куска — 1.000000 с пересборки вместо 6.
698 lines
25 KiB
ObjectPascal
698 lines
25 KiB
ObjectPascal
{
|
||
uSubtitles — текст поверх картинки.
|
||
|
||
Рисует не эта программа, а libass: он есть и внутри mpv, и внутри
|
||
ffmpeg, поэтому предпросмотр и готовый ролик показывают одно и то же.
|
||
Наше дело — собрать для него файл ASS.
|
||
|
||
Почему переносы считаем сами. libass умеет переносить, но тогда
|
||
неизвестно, сколько выйдет строк, и подобрать размер под отведённую
|
||
полосу нечем. Поэтому меряем и переносим здесь, а в файл отдаём готовые
|
||
переводы строк: что померили, то и нарисуется.
|
||
|
||
Чем меряем. Тем же шрифтом, что уйдёт в libass, через холст LCL — за
|
||
обоими стоит FreeType, и ширины сходятся. Небольшой запас всё равно
|
||
берём: настройки сглаживания у них разные.
|
||
|
||
Замер, на котором держится подбор размера (DejaVu Sans, кадр 1280x720):
|
||
шаг строк почти равен размеру шрифта, высота блока из N строк ≈
|
||
размер × (N − 0.16). В полосу 20% высоты влезает три строки размером до
|
||
50, четыре до 37, пять до 30.
|
||
}
|
||
unit uSubtitles;
|
||
|
||
{$mode objfpc}{$H+}
|
||
|
||
interface
|
||
|
||
uses
|
||
Classes, SysUtils, uAppTypes, uProject, uFlatten;
|
||
|
||
type
|
||
{ Как померить ширину строки. Возвращает ширину в точках кадра. }
|
||
TTextMeasure = function(const AText: string; const AStyle: TTextStyle;
|
||
ASize: Integer): Integer;
|
||
|
||
var
|
||
{ Замерщик ширины текста.
|
||
|
||
Подключается снаружи: точный замер требует холста, а холст —
|
||
работающего оконного набора. Служебной программе без экрана он
|
||
недоступен, и она обходится оценкой (см. EstimateWidth) — для
|
||
проверки самого файла ASS этого хватает.
|
||
|
||
Окно ставит сюда замер тем же шрифтом, каким libass будет рисовать. }
|
||
TextMeasure: TTextMeasure = nil;
|
||
|
||
{ Собирает ASS из всех текстовых клипов проекта.
|
||
|
||
Возвращает пустую строку, если текста нет вовсе — тогда и файл писать
|
||
незачем. }
|
||
function BuildAss(AProject: TProject): string;
|
||
|
||
{ Пишет ASS в файл. False — писать было нечего или не вышло. }
|
||
function WriteAssFile(AProject: TProject; const APath: string): Boolean;
|
||
|
||
{ Есть ли в проекте хоть один текстовый клип. }
|
||
function HasText(AProject: TProject): Boolean;
|
||
|
||
{ Подбор размера и переносов — для окна редактора: оно показывает, во что
|
||
превратится надпись, ещё до сборки разметки. Тот же код, что и в самой
|
||
сборке, поэтому расхождения быть не может. }
|
||
function FitTextForPreview(const AText: string; const AStyle: TTextStyle;
|
||
AFrameWidth, AFrameHeight: Integer; ALines: TStringList): Integer;
|
||
|
||
{ Занят ли текстом этот отрезок монтажа. Нужно сборке: вжигать текст
|
||
приходится только в те куски, которые он покрывает. }
|
||
function TextCovers(AProject: TProject; const AFrom, ATo: Double): Boolean;
|
||
|
||
{ Разметка для одного куска монтажа: события сдвинуты к его началу и
|
||
обрезаны по его длине.
|
||
|
||
Нужно вжиганию. Фильтр subtitles рисует по времени того файла, который
|
||
ему дали, а кусок начинается со своего нуля — общая разметка легла бы
|
||
не туда. }
|
||
function WriteAssForRange(AProject: TProject; const AFrom, ATo: Double;
|
||
const APath: string): Boolean;
|
||
|
||
{ Готовит куски к вжиганию: тем, которые задевает текст, ставит признак
|
||
пересборки и подкладывает свою разметку.
|
||
|
||
Возвращает, сколько секунд придётся пересобрать сверх того, что и так
|
||
пересобиралось: человеку это говорят до начала.
|
||
|
||
AStartTime — время монтажа, которому соответствует начало списка.
|
||
Нужен, когда собирают не весь ролик, а отмеченный участок: иначе текст
|
||
брался бы с начала монтажа и лёг бы не на те куски. }
|
||
function BurnTextIntoSegments(AProject: TProject;
|
||
var ASegments: TFlatSegmentArray; const ACacheDir: string;
|
||
const AStartTime: Double = 0): Double;
|
||
|
||
implementation
|
||
|
||
uses
|
||
Math, LazUTF8;
|
||
|
||
const
|
||
{ Короче этого копируемые обрезки не делаем: возни с опорными кадрами
|
||
больше, чем выгоды от копирования секунды. }
|
||
MinCopyPiece = 1.0;
|
||
{ Запас по ширине: наши мерки и мерки libass расходятся на проценты. }
|
||
WidthSafety = 0.95;
|
||
{ Поля от краёв кадра в долях ширины и высоты. }
|
||
MarginShare = 0.05;
|
||
{ Ниже этого размер не опускаем: дальше текст всё равно не прочесть,
|
||
и лучше показать его крупным с выходом за полосу, чем нечитаемым. }
|
||
MinFontSize = 14;
|
||
|
||
{ Время в записи ASS: часы:минуты:секунды.сотые. }
|
||
function AssTime(const ASeconds: Double): string;
|
||
var
|
||
T: Double;
|
||
H, M: Integer;
|
||
S: Double;
|
||
begin
|
||
T := Max(0, ASeconds);
|
||
H := Trunc(T) div 3600;
|
||
M := (Trunc(T) mod 3600) div 60;
|
||
S := T - H * 3600 - M * 60;
|
||
{ Дробную часть добиваем нулём вручную: %05.2f у Паскаля дополняет
|
||
пробелом, а ASS с пробелом внутри времени не читается. }
|
||
Result := Format('%d:%.2d:%.2d.%.2d',
|
||
[H, M, Trunc(S), Round(Frac(S) * 100)]);
|
||
end;
|
||
|
||
{ Цвет в записи ASS: &HAABBGGRR. Порядок обратный привычному, а первым
|
||
идёт не прозрачность, а её отсутствие — ноль значит «непрозрачно». }
|
||
function AssColor(AColor: TRgb; ATransparent: Boolean = False): string;
|
||
var
|
||
Alpha: Integer;
|
||
begin
|
||
if ATransparent then
|
||
Alpha := $FF
|
||
else
|
||
Alpha := 0;
|
||
Result := Format('&H%.2X%.2X%.2X%.2X',
|
||
[Alpha, (AColor shr 16) and $FF, (AColor shr 8) and $FF, AColor and $FF]);
|
||
end;
|
||
|
||
{ Внутри строки ASS перевод строки записывается как \N, а фигурные скобки
|
||
начинают команду — их надо обезвредить. }
|
||
function AssEscape(const AText: string): string;
|
||
begin
|
||
Result := StringReplace(AText, '\', '\\', [rfReplaceAll]);
|
||
Result := StringReplace(Result, '{', '(', [rfReplaceAll]);
|
||
Result := StringReplace(Result, '}', ')', [rfReplaceAll]);
|
||
Result := StringReplace(Result, LineEnding, '\N', [rfReplaceAll]);
|
||
Result := StringReplace(Result, #10, '\N', [rfReplaceAll]);
|
||
Result := StringReplace(Result, #13, '\N', [rfReplaceAll]);
|
||
end;
|
||
|
||
{ Оценка ширины, когда точного замера нет.
|
||
|
||
Множитель взят из замера: DejaVu Sans, размер 54, строка из двадцати
|
||
знаков кириллицы заняла 530 точек — это 0.49 размера на знак. Оценка
|
||
грубая, но для проверки самой разметки годится, а окно всегда ставит
|
||
точный замер. }
|
||
function EstimateWidth(const AText: string; ASize: Integer): Integer;
|
||
begin
|
||
Result := Round(UTF8Length(AText) * ASize * 0.49);
|
||
end;
|
||
|
||
function MeasureWidth(const AText: string; const AStyle: TTextStyle;
|
||
ASize: Integer): Integer;
|
||
begin
|
||
if Assigned(TextMeasure) then
|
||
Result := TextMeasure(AText, AStyle, ASize)
|
||
else
|
||
Result := EstimateWidth(AText, ASize);
|
||
end;
|
||
|
||
{ Перенос по словам под заданную ширину. Возвращает число строк, сами
|
||
строки складывает в ALines. }
|
||
function WrapText(const AText: string; const AStyle: TTextStyle;
|
||
ASize, AMaxWidth: Integer; ALines: TStringList): Integer;
|
||
var
|
||
Src: TStringList;
|
||
I: Integer;
|
||
Rest, Word, Line: string;
|
||
Space: Integer;
|
||
begin
|
||
ALines.Clear;
|
||
Src := TStringList.Create;
|
||
try
|
||
{ Свои переводы строк человек ставил не зря — они остаются. }
|
||
Src.Text := AText;
|
||
for I := 0 to Src.Count - 1 do
|
||
begin
|
||
Rest := Src[I];
|
||
if Trim(Rest) = '' then
|
||
begin
|
||
ALines.Add('');
|
||
Continue;
|
||
end;
|
||
|
||
Line := '';
|
||
while Rest <> '' do
|
||
begin
|
||
Space := Pos(' ', Rest);
|
||
if Space = 0 then
|
||
begin
|
||
Word := Rest;
|
||
Rest := '';
|
||
end
|
||
else
|
||
begin
|
||
Word := Copy(Rest, 1, Space - 1);
|
||
Rest := Copy(Rest, Space + 1, Length(Rest));
|
||
end;
|
||
|
||
if Line = '' then
|
||
Line := Word
|
||
else if MeasureWidth(Line + ' ' + Word, AStyle, ASize) <= AMaxWidth then
|
||
Line := Line + ' ' + Word
|
||
else
|
||
begin
|
||
ALines.Add(Line);
|
||
Line := Word;
|
||
end;
|
||
end;
|
||
if Line <> '' then
|
||
ALines.Add(Line);
|
||
end;
|
||
finally
|
||
Src.Free;
|
||
end;
|
||
Result := ALines.Count;
|
||
end;
|
||
|
||
{ Подбор размера и переносов под отведённую полосу.
|
||
|
||
Идём от заданного размера вниз: он же и верхняя граница. Уменьшаем,
|
||
пока блок не влезет по высоте — по ширине перенос справляется сам. }
|
||
function FitText(const AText: string; const AStyle: TTextStyle;
|
||
AFrameWidth, AFrameHeight: Integer; ALines: TStringList): Integer;
|
||
var
|
||
MaxWidth, MaxHeight, Size, BlockHeight: Integer;
|
||
Lo, Hi, Mid, Best, Count: Integer;
|
||
begin
|
||
MaxWidth := Round(AFrameWidth * (1 - MarginShare * 2) * WidthSafety);
|
||
MaxHeight := Round(AFrameHeight * AStyle.MaxHeight);
|
||
Size := AStyle.FontSize;
|
||
if Size < MinFontSize then
|
||
Size := MinFontSize;
|
||
|
||
{ Ищем наибольший размер, при котором блок влезает, делением отрезка
|
||
пополам.
|
||
|
||
Прикидка «уменьшить во столько же раз, во сколько не влезли» даёт
|
||
слишком мелкий шрифт: после переноса строк становится меньше, и
|
||
места остаётся вдоволь. Проверено на длинной надписи — вместо 29
|
||
помещался 40. Десятка кругов хватает на любой разумный размер. }
|
||
Lo := MinFontSize;
|
||
Hi := Size;
|
||
Best := MinFontSize;
|
||
|
||
while Lo <= Hi do
|
||
begin
|
||
Mid := (Lo + Hi) div 2;
|
||
Count := WrapText(AText, AStyle, Mid, MaxWidth, ALines);
|
||
if Count < 1 then
|
||
Count := 1;
|
||
{ Высота блока по замеру: шаг строк равен размеру, последняя строка
|
||
занимает чуть меньше. }
|
||
BlockHeight := Round(Mid * (Count - 0.16));
|
||
if BlockHeight <= MaxHeight then
|
||
begin
|
||
Best := Mid;
|
||
Lo := Mid + 1;
|
||
end
|
||
else
|
||
Hi := Mid - 1;
|
||
end;
|
||
|
||
{ Последний перенос должен соответствовать выбранному размеру: во время
|
||
поиска он мог остаться от неподошедшей примерки. }
|
||
WrapText(AText, AStyle, Best, MaxWidth, ALines);
|
||
Result := Best;
|
||
end;
|
||
|
||
function FitTextForPreview(const AText: string; const AStyle: TTextStyle;
|
||
AFrameWidth, AFrameHeight: Integer; ALines: TStringList): Integer;
|
||
begin
|
||
Result := FitText(AText, AStyle, AFrameWidth, AFrameHeight, ALines);
|
||
end;
|
||
|
||
function HasText(AProject: TProject): Boolean;
|
||
var
|
||
T, C: Integer;
|
||
begin
|
||
Result := False;
|
||
if AProject = nil then
|
||
Exit;
|
||
for T := 0 to AProject.TrackCount - 1 do
|
||
begin
|
||
if AProject.Tracks[T].Kind <> tkText then
|
||
Continue;
|
||
if not AProject.TrackAudible(AProject.Tracks[T]) then
|
||
Continue;
|
||
for C := 0 to AProject.Tracks[T].Count - 1 do
|
||
if Trim(AProject.Tracks[T][C].Text) <> '' then
|
||
Exit(True);
|
||
end;
|
||
end;
|
||
|
||
function TextCovers(AProject: TProject; const AFrom, ATo: Double): Boolean;
|
||
var
|
||
T, C: Integer;
|
||
Clip: TClip;
|
||
begin
|
||
Result := False;
|
||
if AProject = nil then
|
||
Exit;
|
||
for T := 0 to AProject.TrackCount - 1 do
|
||
begin
|
||
if AProject.Tracks[T].Kind <> tkText then
|
||
Continue;
|
||
if not AProject.TrackAudible(AProject.Tracks[T]) then
|
||
Continue;
|
||
for C := 0 to AProject.Tracks[T].Count - 1 do
|
||
begin
|
||
Clip := AProject.Tracks[T][C];
|
||
if Trim(Clip.Text) = '' then
|
||
Continue;
|
||
{ Пересечение отрезков, а не попадание точки: кусок может быть
|
||
длиннее надписи и наоборот. }
|
||
if (Clip.TlStart < ATo - 0.0005) and (Clip.TlEnd > AFrom + 0.0005) then
|
||
Exit(True);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
{ Общая сборка. AFrom и ATo ограничивают выборку; ATo меньше нуля значит
|
||
«до конца монтажа». При ненулевом AFrom времена сдвигаются к нулю — так
|
||
разметка годится для отдельного куска. }
|
||
function BuildAssRange(AProject: TProject; const AFrom, ATo: Double): string;
|
||
var
|
||
Lines: TStringList;
|
||
Styles, Events: TStringList;
|
||
T, C, I, Size: Integer;
|
||
Clip: TClip;
|
||
Track: TTrack;
|
||
Name, Body: string;
|
||
W, H, MarginH, MarginV: Integer;
|
||
StartAt, EndAt: Double;
|
||
begin
|
||
Result := '';
|
||
if (AProject = nil) or (not HasText(AProject)) then
|
||
Exit;
|
||
|
||
W := AProject.Master.Width;
|
||
H := AProject.Master.Height;
|
||
if (W < 2) or (H < 2) then
|
||
begin
|
||
W := 1920;
|
||
H := 1080;
|
||
end;
|
||
MarginH := Round(W * MarginShare);
|
||
MarginV := Round(H * MarginShare);
|
||
|
||
Lines := TStringList.Create;
|
||
Styles := TStringList.Create;
|
||
Events := TStringList.Create;
|
||
try
|
||
for T := 0 to AProject.TrackCount - 1 do
|
||
begin
|
||
Track := AProject.Tracks[T];
|
||
if Track.Kind <> tkText then
|
||
Continue;
|
||
if not AProject.TrackAudible(Track) then
|
||
Continue;
|
||
|
||
for C := 0 to Track.Count - 1 do
|
||
begin
|
||
Clip := Track[C];
|
||
if Trim(Clip.Text) = '' then
|
||
Continue;
|
||
{ Надписи, не попадающие в нужный отрезок, разбирать незачем. }
|
||
if (ATo >= 0) and (Clip.TlStart >= ATo - 0.0005) then
|
||
Continue;
|
||
if Clip.TlEnd <= AFrom + 0.0005 then
|
||
Continue;
|
||
|
||
Size := FitText(Clip.Text, Clip.TextStyle, W, H, Lines);
|
||
|
||
{ У каждого клипа своё оформление, поэтому и свой стиль. Имя
|
||
выводим из номера дорожки и клипа — оно должно быть
|
||
неповторимым и не содержать запятых. }
|
||
Name := Format('s%d_%d', [T, C]);
|
||
Styles.Add(Format(
|
||
'Style: %s,%s,%d,%s,%s,%s,%s,%d,%d,0,0,100,100,0,0,1,%d,%d,%d,' +
|
||
'%d,%d,%d,1',
|
||
[Name, Clip.TextStyle.FontName, Size,
|
||
AssColor(Clip.TextStyle.Color),
|
||
AssColor(Clip.TextStyle.Color),
|
||
AssColor(Clip.TextStyle.OutlineColor),
|
||
AssColor(Clip.TextStyle.ShadowColor,
|
||
Clip.TextStyle.Shadow <= 0),
|
||
Ord(Clip.TextStyle.Bold) * -1, Ord(Clip.TextStyle.Italic) * -1,
|
||
Clip.TextStyle.Outline, Clip.TextStyle.Shadow,
|
||
Ord(Clip.TextStyle.Place),
|
||
MarginH, MarginH, MarginV]));
|
||
|
||
Body := '';
|
||
for I := 0 to Lines.Count - 1 do
|
||
begin
|
||
if Body <> '' then
|
||
Body := Body + '\N';
|
||
Body := Body + AssEscape(Lines[I]);
|
||
end;
|
||
|
||
{ Обрезаем по границам куска и сдвигаем к его началу. }
|
||
StartAt := Max(Clip.TlStart, AFrom) - AFrom;
|
||
EndAt := Clip.TlEnd - AFrom;
|
||
if ATo >= 0 then
|
||
EndAt := Min(EndAt, ATo - AFrom);
|
||
if EndAt <= StartAt then
|
||
Continue;
|
||
|
||
Events.Add(Format('Dialogue: 0,%s,%s,%s,,0,0,0,,%s',
|
||
[AssTime(StartAt), AssTime(EndAt), Name, Body]));
|
||
end;
|
||
end;
|
||
|
||
if Events.Count = 0 then
|
||
Exit;
|
||
|
||
Result :=
|
||
'[Script Info]' + LineEnding +
|
||
'ScriptType: v4.00+' + LineEnding +
|
||
Format('PlayResX: %d', [W]) + LineEnding +
|
||
Format('PlayResY: %d', [H]) + LineEnding +
|
||
{ Переносы мы уже расставили, libass переносить нечего. }
|
||
'WrapStyle: 2' + LineEnding +
|
||
'ScaledBorderAndShadow: yes' + LineEnding +
|
||
'YCbCr Matrix: None' + LineEnding +
|
||
LineEnding +
|
||
'[V4+ Styles]' + LineEnding +
|
||
'Format: Name,Fontname,Fontsize,PrimaryColour,SecondaryColour,' +
|
||
'OutlineColour,BackColour,Bold,Italic,Underline,StrikeOut,ScaleX,' +
|
||
'ScaleY,Spacing,Angle,BorderStyle,Outline,Shadow,Alignment,' +
|
||
'MarginL,MarginR,MarginV,Encoding' + LineEnding +
|
||
Styles.Text +
|
||
LineEnding +
|
||
'[Events]' + LineEnding +
|
||
'Format: Layer,Start,End,Style,Name,MarginL,MarginR,MarginV,' +
|
||
'Effect,Text' + LineEnding +
|
||
Events.Text;
|
||
finally
|
||
Events.Free;
|
||
Styles.Free;
|
||
Lines.Free;
|
||
end;
|
||
end;
|
||
|
||
function BuildAss(AProject: TProject): string;
|
||
begin
|
||
Result := BuildAssRange(AProject, 0, -1);
|
||
end;
|
||
|
||
function WriteText(const AText, APath: string): Boolean;
|
||
var
|
||
Stream: TFileStream;
|
||
begin
|
||
Result := False;
|
||
try
|
||
ForceDirectories(ExtractFilePath(APath));
|
||
Stream := TFileStream.Create(APath, fmCreate);
|
||
try
|
||
if Length(AText) > 0 then
|
||
Stream.WriteBuffer(AText[1], Length(AText));
|
||
finally
|
||
Stream.Free;
|
||
end;
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function WriteAssForRange(AProject: TProject; const AFrom, ATo: Double;
|
||
const APath: string): Boolean;
|
||
var
|
||
Text: string;
|
||
begin
|
||
Text := BuildAssRange(AProject, AFrom, ATo);
|
||
Result := (Text <> '') and WriteText(Text, APath);
|
||
end;
|
||
|
||
{ Отрезки, которые задевает текст, внутри указанного куска. Отрезки
|
||
сливаются, если налезают друг на друга: две надписи подряд — это одна
|
||
пересобираемая часть, а не две. }
|
||
procedure CollectTextRanges(AProject: TProject; const AFrom, ATo: Double;
|
||
out AStarts, AEnds: TDoubleArray; out ACount: Integer);
|
||
var
|
||
T, C, I, J: Integer;
|
||
Clip: TClip;
|
||
S, E, TmpS, TmpE: Double;
|
||
begin
|
||
ACount := 0;
|
||
SetLength(AStarts, 0);
|
||
SetLength(AEnds, 0);
|
||
if AProject = nil then
|
||
Exit;
|
||
|
||
for T := 0 to AProject.TrackCount - 1 do
|
||
begin
|
||
if AProject.Tracks[T].Kind <> tkText then
|
||
Continue;
|
||
if not AProject.TrackAudible(AProject.Tracks[T]) then
|
||
Continue;
|
||
for C := 0 to AProject.Tracks[T].Count - 1 do
|
||
begin
|
||
Clip := AProject.Tracks[T][C];
|
||
if Trim(Clip.Text) = '' then
|
||
Continue;
|
||
S := Max(AFrom, Clip.TlStart);
|
||
E := Min(ATo, Clip.TlEnd);
|
||
if E <= S + 0.0005 then
|
||
Continue;
|
||
SetLength(AStarts, ACount + 1);
|
||
SetLength(AEnds, ACount + 1);
|
||
AStarts[ACount] := S;
|
||
AEnds[ACount] := E;
|
||
Inc(ACount);
|
||
end;
|
||
end;
|
||
|
||
{ Сортировка вставками: надписей в куске единицы. }
|
||
for I := 1 to ACount - 1 do
|
||
begin
|
||
TmpS := AStarts[I];
|
||
TmpE := AEnds[I];
|
||
J := I - 1;
|
||
while (J >= 0) and (AStarts[J] > TmpS) do
|
||
begin
|
||
AStarts[J + 1] := AStarts[J];
|
||
AEnds[J + 1] := AEnds[J];
|
||
Dec(J);
|
||
end;
|
||
AStarts[J + 1] := TmpS;
|
||
AEnds[J + 1] := TmpE;
|
||
end;
|
||
|
||
{ Слияние налезающих. }
|
||
I := 0;
|
||
while I < ACount - 1 do
|
||
if AStarts[I + 1] <= AEnds[I] + MinCopyPiece then
|
||
begin
|
||
AEnds[I] := Max(AEnds[I], AEnds[I + 1]);
|
||
for J := I + 1 to ACount - 2 do
|
||
begin
|
||
AStarts[J] := AStarts[J + 1];
|
||
AEnds[J] := AEnds[J + 1];
|
||
end;
|
||
Dec(ACount);
|
||
end
|
||
else
|
||
Inc(I);
|
||
end;
|
||
|
||
function BurnTextIntoSegments(AProject: TProject;
|
||
var ASegments: TFlatSegmentArray; const ACacheDir: string;
|
||
const AStartTime: Double): Double;
|
||
var
|
||
Res: TFlatSegmentArray;
|
||
N, I, J, K, RangeCount: Integer;
|
||
At, SegEnd, Cursor: Double;
|
||
Starts, Ends: TDoubleArray;
|
||
Path: string;
|
||
PrevBurned: Boolean;
|
||
|
||
{ Часть исходного куска. AFrom и ATo — время монтажа. }
|
||
procedure PushPiece(const ASeg: TFlatSegment; const AFrom, ATo: Double;
|
||
ABurn: Boolean; const ASegFrom: Double);
|
||
var
|
||
Piece: TFlatSegment;
|
||
Shift: Double;
|
||
L: Integer;
|
||
begin
|
||
if ATo <= AFrom + 0.0005 then
|
||
Exit;
|
||
|
||
Piece := ASeg;
|
||
Shift := AFrom - ASegFrom;
|
||
Piece.Duration := ATo - AFrom;
|
||
Piece.SrcStart := ASeg.SrcStart + Shift;
|
||
for L := 0 to High(Piece.Layers) do
|
||
Piece.Layers[L].SrcStart := ASeg.Layers[L].SrcStart + Shift;
|
||
|
||
{ Часть, начавшаяся не с начала куска, начинается в произвольном
|
||
месте потока. Копировать её с этого места нельзя: копия пойдёт от
|
||
ближайшего опорного кадра, и картинка сдвинется. Поэтому помечаем
|
||
начало точным — сборка перекодирует огрызок до опорного кадра, а
|
||
дальше снова копирует. }
|
||
if Shift > 0.0005 then
|
||
Piece.PreciseIn := True;
|
||
|
||
if ABurn then
|
||
begin
|
||
Path := IncludeTrailingPathDelimiter(ACacheDir) +
|
||
Format('burn_%.3d_%.2d.ass', [I, K]);
|
||
Inc(K);
|
||
if WriteAssForRange(AProject, AFrom, ATo, Path) then
|
||
begin
|
||
{ Кусок, который и так пересобирался, дороже не становится. }
|
||
if not (Piece.Transcode or (Length(Piece.Layers) > 0)) then
|
||
Result := Result + Piece.Duration;
|
||
Piece.SubFile := Path;
|
||
Piece.Transcode := True;
|
||
end;
|
||
end;
|
||
|
||
if N >= Length(Res) then
|
||
SetLength(Res, N + 16);
|
||
Res[N] := Piece;
|
||
Inc(N);
|
||
end;
|
||
|
||
begin
|
||
Result := 0;
|
||
if (AProject = nil) or (not HasText(AProject)) then
|
||
Exit;
|
||
|
||
SetLength(Res, Length(ASegments) + 16);
|
||
N := 0;
|
||
At := AStartTime;
|
||
|
||
for I := 0 to High(ASegments) do
|
||
begin
|
||
SegEnd := At + ASegments[I].Duration;
|
||
CollectTextRanges(AProject, At, SegEnd, Starts, Ends, RangeCount);
|
||
|
||
if RangeCount = 0 then
|
||
begin
|
||
if N >= Length(Res) then
|
||
SetLength(Res, N + 16);
|
||
Res[N] := ASegments[I];
|
||
Inc(N);
|
||
At := SegEnd;
|
||
Continue;
|
||
end;
|
||
|
||
{ Кусок режется на части: до надписи, под надписью, после. Пересобрать
|
||
придётся только середину.
|
||
|
||
Раньше пересобирался весь кусок целиком, и надпись на тридцать
|
||
секунд внутри сорокаминутного куска заставляла пересобирать сорок
|
||
минут — половину ролика. }
|
||
K := 0;
|
||
Cursor := At;
|
||
PrevBurned := False;
|
||
for J := 0 to RangeCount - 1 do
|
||
begin
|
||
{ Обрезок короче секунды копировать незачем: возни с опорными
|
||
кадрами больше, чем выгоды. Отдаём его вжиганию. }
|
||
if Starts[J] - Cursor > MinCopyPiece then
|
||
begin
|
||
PushPiece(ASegments[I], Cursor, Starts[J], False, At);
|
||
Cursor := Starts[J];
|
||
end;
|
||
PushPiece(ASegments[I], Cursor, Ends[J], True, At);
|
||
Cursor := Ends[J];
|
||
PrevBurned := True;
|
||
end;
|
||
|
||
if SegEnd - Cursor > MinCopyPiece then
|
||
PushPiece(ASegments[I], Cursor, SegEnd, False, At)
|
||
else if SegEnd > Cursor + 0.0005 then
|
||
{ Хвост короче секунды — дожигаем вместе с надписью, чтобы не
|
||
плодить огрызки. }
|
||
PushPiece(ASegments[I], Cursor, SegEnd, PrevBurned, At);
|
||
|
||
At := SegEnd;
|
||
end;
|
||
|
||
SetLength(Res, N);
|
||
ASegments := Res;
|
||
end;
|
||
|
||
function WriteAssFile(AProject: TProject; const APath: string): Boolean;
|
||
var
|
||
Text: string;
|
||
begin
|
||
Result := False;
|
||
Text := BuildAss(AProject);
|
||
if Text = '' then
|
||
begin
|
||
{ Текста не стало — старый файл убираем, иначе плеер покажет то,
|
||
чего на монтаже уже нет. }
|
||
if FileExists(APath) then
|
||
SysUtils.DeleteFile(APath);
|
||
Exit;
|
||
end;
|
||
|
||
Result := WriteText(Text, APath);
|
||
end;
|
||
|
||
end.
|