{
  uTransform — как вписать кадр исходника в кадр проекта.

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

  Все размеры считаются числами здесь, а не выражениями внутри фильтра
  ffmpeg. Выражения там пишутся через экранированные запятые и читаются
  тяжело, а проверить посчитанные числа можно глазами прямо в журнале.

  Преобразование хранится у файла, а не у клипа: оно описывает, как этот
  материал вообще ложится в проект, и одинаково для всех его кусков.
}
unit uTransform;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, uAppTypes;

type
  { Как соотносятся кадр исходника и кадр проекта. }
  TFitMode = (
    fmFit,      // вписать целиком, по краям поля
    fmFill,     // заполнить кадр, лишнее обрезать
    fmStretch   // растянуть, пропорции исказятся
  );

  TMediaTransform = record
    Fit: TFitMode;
    { Поворот по часовой стрелке: 0, 90, 180 или 270. }
    Rotation: Integer;
    FlipH: Boolean;
    FlipV: Boolean;
    { Дополнительное увеличение поверх выбранного режима. Единица —
      без увеличения. }
    Zoom: Double;
    { Смещение кадра в долях от размера кадра проекта. Ноль — по центру. }
    OffsetX: Double;
    OffsetY: Double;
  end;

function DefaultTransform: TMediaTransform;

{ Нужно ли вообще что-то делать: совпадающий по размеру кадр без поворота
  и смещений трогать незачем. }
function TransformIsIdentity(const AT: TMediaTransform;
  ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer): Boolean;

{ Цепочка фильтров ffmpeg. Пустая строка означает «ничего делать не надо». }
function TransformFilter(const AT: TMediaTransform;
  ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer): string;

{ Цепочка для предпросмотра: вписать любой кадр в кадр проекта.

  От TransformFilter отличается двумя вещами. Во-первых, размеры исходника
  здесь неизвестны — цепочка одна на весь предпросмотр, а куски в нём из
  разных файлов, поэтому вместо посчитанных чисел идут выражения самого
  ffmpeg. Во-вторых, она знает только вписывание целиком: заполнение с
  обрезкой, поворот и смещение задаются для каждого файла отдельно, а
  фильтр общий, и выбрать между ними он не может.

  Отсюда честное ограничение: предпросмотр показывает кадр проекта верно,
  но собственную настройку кадрирования файла не учитывает. Её видно в
  окне кадрирования и в готовом ролике. }
{ То же самое, но для наложения в плеере: цепочка без обкладывания
  полями и отдельно точка, куда встанет получившаяся картинка.

  Поля и наложение — две записи одного и того же. Сборка обкладывает
  картинку полями до кадра проекта, потому что кусок должен быть
  самостоятельным файлом. Плееру поля не нужны и вредны: чёрное поле
  закрыло бы нижнее видео. Ему нужны те же самые координаты, но как место
  наложения. Считаются они одним и тем же кодом — иначе окно показывало
  бы одно, а сборка давала другое. }
function OverlayFilter(const AT: TMediaTransform;
  ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer;
  out AX, AY, AWidth, AHeight: Integer): string;

{ Какая часть исходника видна в кадре проекта — прямоугольник в точках
  самого исходника.

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

  False — прямоугольником не описать: при растяжении берётся весь кадр и
  сжимается неравномерно. }
function TransformSourceRect(const AT: TMediaTransform;
  ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer;
  out ARect: TRect): Boolean;

{ Можно ли показать это преобразование обрезкой на выводе плеера.

  Обрезка умеет только выбрать кусок кадра. Поворот у mpv задаётся
  отдельным свойством и потому разрешён, а отражение — нет: свойства для
  него нет, и такой клип по-прежнему показывается как есть. }
function TransformFitsOutputCrop(const AT: TMediaTransform): Boolean;

{ Фильтр цветового ключа: этот цвет становится прозрачным.

  Один на всех: и сборка, и предпросмотр должны выбивать одинаково, иначе
  окно обещает одно, а готовый ролик даёт другое. Цвет записывается как
  0xRRGGBB — порядок обратный тому, в каком он хранится у нас. }
function ColorKeyFilter(AColor: TRgb; ASimilarity, ABlend: Integer): string;

{ Фильтр приглушения по альфа-каналу. Пусто, если приглушать нечего. }
function OpacityFilter(const AOpacity: Double): string;

function PreviewFitFilter(ADstWidth, ADstHeight: Integer): string;

function FitModeToStr(AMode: TFitMode): string;
function StrToFitMode(const AValue: string): TFitMode;
function FitModeCaption(AMode: TFitMode): string;

implementation

uses
  Math;

function DefaultTransform: TMediaTransform;
begin
  Result.Fit := fmFit;
  Result.Rotation := 0;
  Result.FlipH := False;
  Result.FlipV := False;
  Result.Zoom := 1;
  Result.OffsetX := 0;
  Result.OffsetY := 0;
end;

function FitModeToStr(AMode: TFitMode): string;
begin
  case AMode of
    fmFill: Result := 'fill';
    fmStretch: Result := 'stretch';
  else
    Result := 'fit';
  end;
end;

function StrToFitMode(const AValue: string): TFitMode;
begin
  if AValue = 'fill' then
    Result := fmFill
  else if AValue = 'stretch' then
    Result := fmStretch
  else
    Result := fmFit;
end;

function FitModeCaption(AMode: TFitMode): string;
begin
  case AMode of
    fmFill: Result := 'Заполнить кадр (лишнее обрезается)';
    fmStretch: Result := 'Растянуть (пропорции исказятся)';
  else
    Result := 'Вписать целиком (по краям поля)';
  end;
end;

function TransformIsIdentity(const AT: TMediaTransform;
  ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer): Boolean;
begin
  Result := (AT.Rotation mod 360 = 0) and (not AT.FlipH) and (not AT.FlipV) and
    (Abs(AT.Zoom - 1) < 0.001) and (Abs(AT.OffsetX) < 0.001) and
    (Abs(AT.OffsetY) < 0.001) and
    (ASrcWidth = ADstWidth) and (ASrcHeight = ADstHeight);
end;

function TransformSourceRect(const AT: TMediaTransform;
  ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer;
  out ARect: TRect): Boolean;
var
  KFit, KFill, K: Double;
  SW, SH, CW, CH, CX, CY: Double;
begin
  ARect := Rect(0, 0, ASrcWidth, ASrcHeight);
  Result := False;
  if (ASrcWidth <= 0) or (ASrcHeight <= 0) or
     (ADstWidth <= 0) or (ADstHeight <= 0) then
    Exit;
  { Растяжение рамкой не описывается: берётся весь кадр и жмётся
    неравномерно. }
  if AT.Fit = fmStretch then
    Exit;

  KFit := Min(ADstWidth / ASrcWidth, ADstHeight / ASrcHeight);
  KFill := Max(ADstWidth / ASrcWidth, ADstHeight / ASrcHeight);
  if AT.Fit = fmFill then
    K := KFill
  else
    K := KFit;
  if AT.Zoom > 0 then
    K := K * AT.Zoom;
  if K <= 0 then
    Exit;

  { Кадр, растянутый до рабочего масштаба, и та его часть, что помещается
    в кадр проекта. Смещение задаётся в долях кадра проекта и прижимается
    к краям: выйти за пределы картинки нельзя. }
  SW := ASrcWidth * K;
  SH := ASrcHeight * K;
  CW := Min(SW, ADstWidth);
  CH := Min(SH, ADstHeight);
  CX := (SW - CW) / 2 + AT.OffsetX * ADstWidth;
  CY := (SH - CH) / 2 + AT.OffsetY * ADstHeight;
  CX := Max(0, Min(SW - CW, CX));
  CY := Max(0, Min(SH - CH, CY));

  ARect := Rect(Round(CX / K), Round(CY / K),
    Round((CX + CW) / K), Round((CY + CH) / K));
  Result := True;
end;

function TransformFitsOutputCrop(const AT: TMediaTransform): Boolean;
begin
  Result := (not AT.FlipH) and (not AT.FlipV) and (AT.Fit <> fmStretch);
end;

{ Дробное число через точку: у ffmpeg разделитель всегда точка, а в
  русской локали Format вставил бы запятую и развалил бы всю цепочку. }
function FilterNum(const AValue: Double): string;
begin
  Result := SecondsToStr(AValue);
end;

function ColorKeyFilter(AColor: TRgb; ASimilarity, ABlend: Integer): string;
begin
  Result := Format('colorkey=0x%.2x%.2x%.2x:%s:%s',
    [AColor and $FF, (AColor shr 8) and $FF, (AColor shr 16) and $FF,
     FilterNum(ASimilarity / 100), FilterNum(ABlend / 100)]);
end;

function OpacityFilter(const AOpacity: Double): string;
begin
  if AOpacity >= 0.999 then
    Result := ''
  else
    Result := 'colorchannelmixer=aa=' + FilterNum(Max(0, AOpacity));
end;

function PreviewFitFilter(ADstWidth, ADstHeight: Integer): string;
var
  W, H: string;
begin
  Result := '';
  if (ADstWidth < 2) or (ADstHeight < 2) then
    Exit;
  W := IntToStr(ADstWidth);
  H := IntToStr(ADstHeight);

  { force_original_aspect_ratio=decrease вписывает кадр целиком, не искажая
    пропорции; pad добавляет поля до размера проекта; setsar=1 убирает
    неквадратный пиксель, иначе mpv растянет уже готовый кадр обратно. }
  Result :=
    'scale=' + W + ':' + H + ':force_original_aspect_ratio=decrease,' +
    'pad=' + W + ':' + H + ':(ow-iw)/2:(oh-ih)/2,' +
    'setsar=1';
end;

{ Кодировщики требуют чётных сторон: цветность в yuv420p хранится вдвое
  прореженной, и нечётный размер ей некуда деть. }
function MakeEven(AValue: Integer): Integer;
begin
  Result := AValue;
  if Odd(Result) then
    Inc(Result);
  if Result < 2 then
    Result := 2;
end;

{ Общая часть: цепочка до обкладывания полями и место, куда встанет
  получившаяся картинка в кадре проекта. }
function BuildTransform(const AT: TMediaTransform;
  ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer;
  out AX, AY, AWidth, AHeight: Integer): string;
var
  Chain: string;
  K, KFit, KFill: Double;
  SW, SH: Integer;
  CW, CH, CX, CY: Integer;
  PW, PH, PX, PY: Integer;
  Rot: Integer;

  procedure Add(const AFilter: string);
  begin
    if Chain <> '' then
      Chain := Chain + ',';
    Chain := Chain + AFilter;
  end;

begin
  Result := '';
  if (ASrcWidth <= 0) or (ASrcHeight <= 0) or
     (ADstWidth <= 0) or (ADstHeight <= 0) then
    Exit;

  Chain := '';

  { Порядок действий: сначала выбирается кусок кадра, и только потом он
    поворачивается и отражается.

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

  { --- Масштаб --- }
  if AT.Fit = fmStretch then
  begin
    SW := MakeEven(ADstWidth);
    SH := MakeEven(ADstHeight);
  end
  else
  begin
    KFit := Min(ADstWidth / ASrcWidth, ADstHeight / ASrcHeight);
    KFill := Max(ADstWidth / ASrcWidth, ADstHeight / ASrcHeight);
    if AT.Fit = fmFill then
      K := KFill
    else
      K := KFit;
    if AT.Zoom > 0 then
      K := K * AT.Zoom;
    SW := MakeEven(Round(ASrcWidth * K));
    SH := MakeEven(Round(ASrcHeight * K));
  end;
  Add(Format('scale=%d:%d', [SW, SH]));

  { --- Обрезка того, что вылезло за кадр --- }
  CW := Min(SW, MakeEven(ADstWidth));
  CH := Min(SH, MakeEven(ADstHeight));
  if (CW < SW) or (CH < SH) then
  begin
    { Смещение задаётся в долях кадра проекта и прижимается к границам:
      выйти за пределы картинки нельзя, ffmpeg на это ругается. }
    CX := Round((SW - CW) / 2 + AT.OffsetX * ADstWidth);
    CY := Round((SH - CH) / 2 + AT.OffsetY * ADstHeight);
    CX := Max(0, Min(SW - CW, CX));
    CY := Max(0, Min(SH - CH, CY));
    Add(Format('crop=%d:%d:%d:%d', [CW, CH, CX, CY]));
  end;

  { --- Поворот и отражение оставшегося куска --- }
  Rot := ((AT.Rotation mod 360) + 360) mod 360;
  case Rot of
    90:
      begin
        { transpose=1 — поворот на 90 по часовой стрелке. }
        Add('transpose=1');
        PW := CH; PH := CW;
      end;
    180:
      begin
        { Два поворота подряд дешевле и точнее, чем поворот на
          произвольный угол: последний пересчитывает каждый пиксель. }
        Add('transpose=1,transpose=1');
        PW := CW; PH := CH;
      end;
    270:
      begin
        Add('transpose=2');
        PW := CH; PH := CW;
      end;
  else
    PW := CW; PH := CH;
  end;
  if AT.FlipH then
    Add('hflip');
  if AT.FlipV then
    Add('vflip');

  { --- Приведение к кадру проекта --- }

  { После поворота на 90 кусок лежит поперёк и в кадр проекта уже не
    вписывается. Вписываем целиком, с полями. }
  if (PW > ADstWidth) or (PH > ADstHeight) then
  begin
    K := Min(ADstWidth / PW, ADstHeight / PH);
    PW := MakeEven(Round(PW * K));
    PH := MakeEven(Round(PH * K));
    Add(Format('scale=%d:%d', [PW, PH]));
  end;

  { Смещение двигает картинку и там, где её не обрезали. Когда картинка
    больше кадра, двигать можно лишь окно, через которое на неё смотрят,
    — это делает crop выше. Когда она меньше, двигать надо её саму по
    полю, иначе уменьшенный кадр навсегда прибит к середине и в угол его
    не отправить. Обе стороны считают смещение в долях кадра проекта, так
    что число значит одно и то же. }
  PX := (ADstWidth - PW) div 2 + Round(AT.OffsetX * ADstWidth);
  PY := (ADstHeight - PH) div 2 + Round(AT.OffsetY * ADstHeight);
  PX := Max(0, Min(Max(0, ADstWidth - PW), PX));
  PY := Max(0, Min(Max(0, ADstHeight - PH), PY));

  AX := PX;
  AY := PY;
  AWidth := PW;
  AHeight := PH;
  Result := Chain;
end;

function TransformFilter(const AT: TMediaTransform;
  ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer): string;
var
  X, Y, W, H: Integer;
begin
  Result := BuildTransform(AT, ASrcWidth, ASrcHeight, ADstWidth, ADstHeight,
    X, Y, W, H);
  if Result = '' then
    Exit;

  if (W < ADstWidth) or (H < ADstHeight) then
    Result := Result + Format(',pad=%d:%d:%d:%d', [ADstWidth, ADstHeight, X, Y]);

  { Пиксель считаем квадратным: иначе плеер растянет кадр по своему
    разумению, и результат разойдётся с тем, что видно в предпросмотре. }
  Result := Result + ',setsar=1';
end;

function OverlayFilter(const AT: TMediaTransform;
  ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer;
  out AX, AY, AWidth, AHeight: Integer): string;
begin
  Result := BuildTransform(AT, ASrcWidth, ASrcHeight, ADstWidth, ADstHeight,
    AX, AY, AWidth, AHeight);
  if Result <> '' then
    Result := Result + ',setsar=1';
end;

end.