ewsdr/AlertOverlay.pas

unit AlertOverlay;

{
  Общая плашка-алерт для CPU- и GL-рендеров спектра.

  Единственный источник внешнего вида: BuildAlertImage строит готовый
  RGBA-образ (straight alpha, попиксельная) ОДИН раз — Canvas используется
  только здесь, на собственном маленьком битмапе. Дальше каждый рендер
  использует образ по-своему без пер-кадрового жора CPU:
    - GL: загружает как текстуру (один раз) и рисует квадом;
    - CPU: блендит кэшированный образ в raw-кадр (BlendAlertImage,
      ~10 тыс. пикселей — без Canvas и синков режима доступа Qt6).
}

{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

interface

uses
  Classes, Graphics, Types, Math;

const
  ALERT_PAD = 12;   // отступ плашки от правого/верхнего края спектра

type
  TAlertImage = record
    W, H: Integer;
    RGBA: array of Byte;   // W*H*4, порядок R,G,B,A; straight alpha
  end;

// Построить образ плашки (полупрозрачный красный фон, рамка, акцент-полоса,
// заголовок + деталь). Вызывать один раз и кэшировать результат.
procedure BuildAlertImage(const Title, Detail: string; out Img: TAlertImage);

// Смешать образ в raw-битмап кадра (32bpp, BGRA / ARGB на Darwin) по
// straight-alpha. (X,Y) — левый верхний угол плашки; клиппинг внутри.
procedure BlendAlertImage(const Img: TAlertImage; Base: PByte;
  BPL, RawW, RawH, X, Y: Integer);

implementation

procedure BuildAlertImage(const Title, Detail: string; out Img: TAlertImage);
const
  INNER_X = 12; ACCENT_W = 4; BOX_H = 42;
var
  B: TBitmap;
  TitleW, DetailW, BoxW: Integer;

  procedure FillBuf(X1, Y1, X2, Y2: Integer; R, G, Bl, A: Byte); // [X1..X2)
  var X, Y, I: Integer;
  begin
    for Y := Max(0, Y1) to Min(BOX_H, Y2) - 1 do
    begin
      I := (Y * BoxW + Max(0, X1)) * 4;
      for X := Max(0, X1) to Min(BoxW, X2) - 1 do
      begin
        Img.RGBA[I] := R; Img.RGBA[I+1] := G;
        Img.RGBA[I+2] := Bl; Img.RGBA[I+3] := A;
        Inc(I, 4);
      end;
    end;
  end;

  procedure BlendText(TxtB: TBitmap);
  // Композит текстового слоя (белым на чёрном) в образ: покрытие = max(R,G,B),
  // цвет по строке (заголовок/деталь), сложение по straight-alpha.
  var
    X, Y, I, MaxC: Integer;
    Src: PByte;
    CR, CG, CB: Byte;
    AT, AB, AO: Double;
  begin
    TxtB.BeginUpdate(False);
    try
      for Y := 0 to BOX_H - 1 do
      begin
        Src := PByte(TxtB.ScanLine[Y]);
        I := Y * BoxW * 4;
        for X := 0 to BoxW - 1 do
        begin
{$IFDEF DARWIN}
          MaxC := Max(Src[1], Max(Src[2], Src[3]));
{$ELSE}
          MaxC := Max(Src[0], Max(Src[1], Src[2]));
{$ENDIF}
          if MaxC > 0 then
          begin
            if Y < 24 then begin CR := $FF; CG := $88; CB := $88; end  // $008888FF
            else           begin CR := $E8; CG := $C8; CB := $C8; end; // $00C8C8E8
            AT := MaxC / 255.0;
            AB := Img.RGBA[I+3] / 255.0 * (1.0 - AT);
            AO := AT + AB;
            Img.RGBA[I]   := Round((CR * AT + Img.RGBA[I]   * AB) / AO);
            Img.RGBA[I+1] := Round((CG * AT + Img.RGBA[I+1] * AB) / AO);
            Img.RGBA[I+2] := Round((CB * AT + Img.RGBA[I+2] * AB) / AO);
            Img.RGBA[I+3] := Round(AO * 255.0);
          end;
          Inc(Src, 4);
          Inc(I, 4);
        end;
      end;
    finally
      TxtB.EndUpdate(False);
    end;
  end;

begin
  Img.W := 0; Img.H := 0; Img.RGBA := nil;
  B := TBitmap.Create;
  try
    B.PixelFormat := pf32bit;
    B.SetSize(8, 8);
    B.Canvas.Font.Name := 'Courier New';
    B.Canvas.Font.Style := [fsBold];
    B.Canvas.Font.Size := 9;
    TitleW := B.Canvas.TextWidth(Title);
    B.Canvas.Font.Style := [];
    B.Canvas.Font.Size := 7;
    DetailW := B.Canvas.TextWidth(Detail);
    BoxW := Max(TitleW, DetailW) + INNER_X * 2 + ACCENT_W + 8;

    SetLength(Img.RGBA, BoxW * BOX_H * 4);
    Img.W := BoxW;
    Img.H := BOX_H;
    FillBuf(0, 0, BoxW, BOX_H, $A8, $10, $16, 118);              // фон
    FillBuf(0, 0, BoxW, 1, $C8, $38, $38, 255);                  // рамка
    FillBuf(0, BOX_H - 1, BoxW, BOX_H, $C8, $38, $38, 255);
    FillBuf(0, 0, 1, BOX_H, $C8, $38, $38, 255);
    FillBuf(BoxW - 1, 0, BoxW, BOX_H, $C8, $38, $38, 255);
    FillBuf(7, 7, 7 + ACCENT_W, BOX_H - 7, $F0, $28, $28, 255);  // акцент

    B.SetSize(BoxW, BOX_H);
    B.Canvas.Brush.Color := clBlack;
    B.Canvas.Brush.Style := bsSolid;
    B.Canvas.FillRect(Rect(0, 0, BoxW, BOX_H));
    B.Canvas.Brush.Style := bsClear;
    B.Canvas.Font.Name := 'Courier New';
    B.Canvas.Font.Color := clWhite;
    B.Canvas.Font.Style := [fsBold];
    B.Canvas.Font.Size := 9;
    B.Canvas.TextOut(INNER_X + ACCENT_W + 8, 7, Title);
    B.Canvas.Font.Style := [];
    B.Canvas.Font.Size := 7;
    B.Canvas.TextOut(INNER_X + ACCENT_W + 8, 25, Detail);
    BlendText(B);
  finally
    B.Free;
  end;
end;

procedure BlendAlertImage(const Img: TAlertImage; Base: PByte;
  BPL, RawW, RawH, X, Y: Integer);
var
  SX, SY, DX, DY, I, A, InvA: Integer;
  P: PByte;
begin
  if (Img.W <= 0) or (Base = nil) then Exit;
  for SY := 0 to Img.H - 1 do
  begin
    DY := Y + SY;
    if (DY < 0) or (DY >= RawH) then Continue;
    I := SY * Img.W * 4;
    for SX := 0 to Img.W - 1 do
    begin
      DX := X + SX;
      A := Img.RGBA[I + 3];
      if (DX >= 0) and (DX < RawW) and (A > 0) then
      begin
        InvA := 255 - A;
        P := Base + DY * BPL + DX * 4;
{$IFDEF DARWIN}
        // ARGB: byte0=A, byte1=R, byte2=G, byte3=B
        P[1] := Byte((Img.RGBA[I]   * A + P[1] * InvA) div 255);
        P[2] := Byte((Img.RGBA[I+1] * A + P[2] * InvA) div 255);
        P[3] := Byte((Img.RGBA[I+2] * A + P[3] * InvA) div 255);
        P[0] := $FF;
{$ELSE}
        // BGRA: byte0=B, byte1=G, byte2=R
        P[0] := Byte((Img.RGBA[I+2] * A + P[0] * InvA) div 255);
        P[1] := Byte((Img.RGBA[I+1] * A + P[1] * InvA) div 255);
        P[2] := Byte((Img.RGBA[I]   * A + P[2] * InvA) div 255);
        P[3] := $FF;
{$ENDIF}
      end;
      Inc(I, 4);
    end;
  end;
end;

end.