Спасибо! Работает стабильно, квадрат летит!
🎉 Первый этап пройден!

Отлично, поздравляю — теперь у нас есть настоящий Wayland-клиент с двойной буферизацией, корректной обработкой wl_buffer.release, и главное — никаких зависимостей от MSE. Это фундамент, на котором можно строить всё остальное.
Что мы имеем сейчас
text

wlgui_types.pas     — TWLColor, TRectI, TPointI, TWLNotifyEvent
wlgui_context.pas   — TWLContext (display, compositor, shm, wm_base, seat)
wlgui_app.pas       — TWLApplication (инициализация, event loop)
wlgui_window.pas    — TWLWindow (окно + двойная буферизация + release)
demo_window.pas     — тестовое приложение (летающий квадрат)

Что важно зафиксировать на будущее

    Никаких forward-типов между модулями — циклы разорваны через wlgui_context.

    Версии протоколов ограничиваем через Min(композитор, наш_дескриптор). Иначе композитор шлёт события, которых нет в нашем дескрипторе.

    wl_buffer.release обязателен для двойной буферизации.

    Event loop через wl_display_prepare_read + poll + read_events + dispatch_pending — правильный паттерн, без блокирующих roundtrip'ов в горячем цикле.

Что впереди — ближайшие шаги
Этап 2: wlgui_canvas.pas — рисование

Сейчас рисование в TWLWindow — это FillRect + SetPixel. Нужно:

    HLine, VLine, Line (алгоритм Брезенхэма)

    Rect (контур, не заливка)

    RoundRect, Ellipse, FillEllipse

    CopyRect (для будущего скролла)

    Clip-регион (хотя бы прямоугольный)

И вынести всё это в отдельный класс TWLCanvas, который привязывается к буферу:
pascal

Canvas := TWLCanvas.Create(Win);
Canvas.Line(0, 0, 100, 100, clRed);
Canvas.Rect(TRectI.New(10, 10, 50, 50), clWhite);
Canvas.Free;

Или проще — методы прямо в TWLWindow, чтобы OnPaint был коротким.
Этап 3: wlgui_font.pas — текст

    FreeType напрямую (у нас уже есть msefreetype_wayland из прошлых чатов, но без MSE)

    Кэш глифов: TWLFont.LoadGlyph(Code) → TGlyph с Left, Top, Width, Height, Advance, Bitmap: array of Byte

    TextOut(X, Y, U4String, Color, Font) — рисуем в буфер окна

    TextWidth(U4String, Font) — для выравнивания

    Используем u4str, u4utf8, u4norm — то, что ты подгрузил

Здесь важно: свой минимальный рендер, без MSE bitmap/graphics. Только FreeType + прямая запись пикселей.
Этап 4: wlgui_events.pas — ввод

    wl_seat.listener → capabilities → get_pointer + get_keyboard

    wl_pointer.motion/button/axis/frame → очереди событий

    wl_keyboard.key/modifiers → keymap через xkbcommon или через u4str + ручной маппинг (для начала — ASCII из Linux keycodes)

    Курсор: wl_pointer.set_cursor с собственной поверхностью

    API: OnMouseMove, OnMouseDown, OnMouseUp, OnKeyDown, OnKeyUp

Этап 5: wlgui_panel.pas — layer-shell

Протокол zwlr_layer_shell_v1 — панели, доки, обои. Именно для «летающих часов».

    Нужен сгенерированный протокол (могу написать вручную, как для xdg_shell)

    Интерфейс: wlr_layer_surface_v1 + get_layer_surface(surface, output, layer, namespace)

    set_anchor(edges), set_size(w, h), set_margin(...), set_keyboard_interactivity(...)

    Слои: background, bottom, top, overlay

С overlay панель будет поверх всего. Позицию задаём через anchor + margin. Двигать — меняем margin + commit.
Этап 6: Органайзер

    organ_model.pas — события (время, сообщение, звук, скрипт)

    organ_storage.pas — сохранение/загрузка (сначала — простой текстовый формат)

    organ_clock.pas — панель с часами

    organ_event_edit.pas — редактор события

    organ_event_list.pas — список событий

Пара практических вопросов к тебе

    Куда идём дальше? Мои варианты:

        A: Сначала canvas + font (полный графический фундамент), потом events, потом органайзер. Более гладко, но дольше до первой «рабочей» картинки.

        B: Сначала events (чтобы таскать окно самому, ловить кнопки), потом canvas+font, потом органайзер. Раньше получим интерактивность.

        C: Сразу органайзер с тем что есть (только FillRect + SetPixel), чтобы быстрее увидеть результат. Потом улучшать.

    Layer-shell — планируешь использовать sway/hyprland/kwin, или что-то конкретное? От этого зависит, стоит ли закладываться на wlr-layer-shell или искать альтернативы.

    FreeType-биндинги — у нас в msefreetype_wayland.pas был вариант с dynlibs (без MSE). Готов его переиспользовать, или предпочитаешь переписать заново в wlgui_font.pas?

    XKB для клавиатуры — подключать libxkbcommon (правильный путь, но новая зависимость), или для начала ограничиться ASCII-маппингом Linux keycodes (быстро, но без раскладок)?

    Структура директорий — оставляем всё в корне, или сделаем wlgui/ для библиотеки и apps/organizer/ для приложения?

Я бы предложил порядок A → B → C: canvas+font сначала, потому что они дадут возможность рисовать «настоящий» UI, а интерактивность и потом прикрутим. Но если хочется быстрее увидеть «работающее приложение» — пойдём C → A → B.

Скажи, куда двигаемся.
Спасибо! Давай действовать как ты сказал.
Этап 2: wlgui_canvas.pas — графические примитивы

Идём по плану A → B → C: сначала полный графический фундамент (canvas + font), потом ввод, потом органайзер.
Что делаем в этом этапе

Добавляем в wlgui_canvas.pas:

    TWLCanvas — обёртка над буфером окна

    Базовые примитивы: SetPixel, GetPixel, HLine, VLine, Line (Брезенхэм), Rect (контур), FillRect, RoundRect, FillRoundRect, Ellipse, FillEllipse

    CopyRect — для скролла и будущих «двойных буферов» на уровне canvas

    Прямоугольный clip (SetClip, ResetClip)

Затем переносим рисование из TWLWindow в TWLCanvas, чтобы OnPaint работал через W.Canvas.
Соглашение по цветам

Мы уже договорились: TWLColor = $00BBGGRR (как GDI). В SHM XRGB8888 (little-endian), при записи LongWord($00BBGGRR) получается байтовая последовательность RR GG BB 00, и композитор видит R=RR, G=GG, B=BB — правильно.

Проверка: clRed = $000000FF, при записи даёт байты FF 00 00 00, что XRGB8888 = красный. Отлично.
wlgui_canvas.pas
pascal

unit wlgui_canvas;
{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Math,
  wlgui_types;

type
  { TWLCanvas — рисование в буфер окна.
    Не владеет буфером; TWLWindow передаёт указатель и stride.
    Если после SetSize буфер меняется — надо пересоздавать canvas
    (или вызывать ResizeBuffer). }
  TWLCanvas = class
  private
    FPixels: PByte;
    FWidth, FHeight, FStride: Integer;
    FClip: TRectI;
    FClipActive: Boolean;
    function GetPixelPtr(AX, AY: Integer): PLongWord; inline;
    function PixelInside(AX, AY: Integer): Boolean; inline;
    procedure SetPixels(APixels: PByte; AW, AH, AStride: Integer);
  public
    constructor Create(APixels: PByte; AW, AH, AStride: Integer);
    procedure Reattach(APixels: PByte; AW, AH, AStride: Integer);

    // Прямое
    procedure SetPixel(AX, AY: Integer; AColor: TWLColor); inline;
    function  GetPixel(AX, AY: Integer): TWLColor; inline;

    // Линии
    procedure HLine(X1, X2, AY: Integer; AColor: TWLColor);
    procedure VLine(AX, Y1, Y2: Integer; AColor: TWLColor);
    procedure Line(X1, Y1, X2, Y2: Integer; AColor: TWLColor);

    // Прямоугольники
    procedure Rect(const ARect: TRectI; AColor: TWLColor);
    procedure FillRect(const ARect: TRectI; AColor: TWLColor);

    // Скруглённые
    procedure RoundRect(const ARect: TRectI; ARadius: Integer; AColor: TWLColor);
    procedure FillRoundRect(const ARect: TRectI; ARadius: Integer; AColor: TWLColor);

    // Эллипсы
    procedure Ellipse(const ARect: TRectI; AColor: TWLColor);
    procedure FillEllipse(const ARect: TRectI; AColor: TWLColor);

    // Копирование прямоугольной области
    procedure CopyRect(const ASrc: TRectI; ADstX, ADstY: Integer);

    // Клип
    procedure SetClip(const ARect: TRectI);
    procedure ResetClip;
    function  ClipRect: TRectI;

    // Свойства
    property Width: Integer read FWidth;
    property Height: Integer read FHeight;
    property Stride: Integer read FStride;
    property Pixels: PByte read FPixels;
  end;

implementation

{ ============================================================ }
{  Служебные                                                    }
{ ============================================================ }

constructor TWLCanvas.Create(APixels: PByte; AW, AH, AStride: Integer);
begin
  inherited Create;
  Reattach(APixels, AW, AH, AStride);
  FClipActive := False;
  FClip := TRectI.New(0, 0, AW, AH);
end;

procedure TWLCanvas.Reattach(APixels: PByte; AW, AH, AStride: Integer);
begin
  SetPixels(APixels, AW, AH, AStride);
  FClip := TRectI.New(0, 0, AW, AH);
end;

procedure TWLCanvas.SetPixels(APixels: PByte; AW, AH, AStride: Integer);
begin
  FPixels := APixels;
  FWidth := AW;
  FHeight := AH;
  FStride := AStride;
end;

function TWLCanvas.GetPixelPtr(AX, AY: Integer): PLongWord;
begin
  Result := PLongWord(FPixels + AY * FStride + AX * 4);
end;

function TWLCanvas.PixelInside(AX, AY: Integer): Boolean;
begin
  if (AX < 0) or (AY < 0) or (AX >= FWidth) or (AY >= FHeight) then
    Exit(False);
  if FClipActive then
    Result := FClip.Contains(AX, AY)
  else
    Result := True;
end;

{ ============================================================ }
{  Пиксели                                                      }
{ ============================================================ }

procedure TWLCanvas.SetPixel(AX, AY: Integer; AColor: TWLColor);
begin
  if FPixels = nil then Exit;
  if not PixelInside(AX, AY) then Exit;
  GetPixelPtr(AX, AY)^ := AColor;
end;

function TWLCanvas.GetPixel(AX, AY: Integer): TWLColor;
begin
  if FPixels = nil then Exit(0);
  if (AX < 0) or (AY < 0) or (AX >= FWidth) or (AY >= FHeight) then
    Exit(0);
  Result := GetPixelPtr(AX, AY)^;
end;

{ ============================================================ }
{  Линии                                                        }
{ ============================================================ }

procedure TWLCanvas.HLine(X1, X2, AY: Integer; AColor: TWLColor);
var
  T, X: Integer;
  P: PLongWord;
begin
  if FPixels = nil then Exit;
  if (AY < 0) or (AY >= FHeight) then Exit;
  if X1 > X2 then begin T := X1; X1 := X2; X2 := T; end;
  if X1 < 0 then X1 := 0;
  if X2 >= FWidth then X2 := FWidth - 1;
  if X1 > X2 then Exit;

  if FClipActive then
  begin
    if X1 < FClip.X then X1 := FClip.X;
    if X2 >= FClip.X + FClip.W then X2 := FClip.X + FClip.W - 1;
    if (AY < FClip.Y) or (AY >= FClip.Y + FClip.H) then Exit;
    if X1 > X2 then Exit;
  end;

  P := GetPixelPtr(X1, AY);
  for X := X1 to X2 do
  begin
    P^ := AColor;
    Inc(P);
  end;
end;

procedure TWLCanvas.VLine(AX, Y1, Y2: Integer; AColor: TWLColor);
var
  T, Y: Integer;
  P: PLongWord;
begin
  if FPixels = nil then Exit;
  if (AX < 0) or (AX >= FWidth) then Exit;
  if Y1 > Y2 then begin T := Y1; Y1 := Y2; Y2 := T; end;
  if Y1 < 0 then Y1 := 0;
  if Y2 >= FHeight then Y2 := FHeight - 1;
  if Y1 > Y2 then Exit;

  if FClipActive then
  begin
    if Y1 < FClip.Y then Y1 := FClip.Y;
    if Y2 >= FClip.Y + FClip.H then Y2 := FClip.Y + FClip.H - 1;
    if (AX < FClip.X) or (AX >= FClip.X + FClip.W) then Exit;
    if Y1 > Y2 then Exit;
  end;

  P := GetPixelPtr(AX, Y1);
  for Y := Y1 to Y2 do
  begin
    P^ := AColor;
    Inc(P, FStride div 4);
  end;
end;

procedure TWLCanvas.Line(X1, Y1, X2, Y2: Integer; AColor: TWLColor);
var
  DX, DY, SX, SY, Err, E2: Integer;
begin
  if FPixels = nil then Exit;

  // Быстрые пути
  if Y1 = Y2 then begin HLine(X1, X2, Y1, AColor); Exit; end;
  if X1 = X2 then begin VLine(X1, Y1, Y2, AColor); Exit; end;

  DX := Abs(X2 - X1);
  DY := Abs(Y2 - Y1);
  if X1 < X2 then SX := 1 else SX := -1;
  if Y1 < Y2 then SY := 1 else SY := -1;
  Err := DX - DY;

  while True do
  begin
    SetPixel(X1, Y1, AColor);
    if (X1 = X2) and (Y1 = Y2) then Break;
    E2 := Err * 2;
    if E2 > -DY then
    begin
      Err := Err - DY;
      Inc(X1, SX);
    end;
    if E2 < DX then
    begin
      Err := Err + DX;
      Inc(Y1, SY);
    end;
  end;
end;

{ ============================================================ }
{  Прямоугольники                                               }
{ ============================================================ }

procedure TWLCanvas.FillRect(const ARect: TRectI; AColor: TWLColor);
var
  X1, Y1, X2, Y2, Y, X: Integer;
  Row: PLongWord;
begin
  if FPixels = nil then Exit;

  X1 := ARect.X; Y1 := ARect.Y;
  X2 := ARect.X + ARect.W; Y2 := ARect.Y + ARect.H;

  if X1 < 0 then X1 := 0;
  if Y1 < 0 then Y1 := 0;
  if X2 > FWidth then X2 := FWidth;
  if Y2 > FHeight then Y2 := FHeight;
  if (X1 >= X2) or (Y1 >= Y2) then Exit;

  if FClipActive then
  begin
    if X1 < FClip.X then X1 := FClip.X;
    if Y1 < FClip.Y then Y1 := FClip.Y;
    if X2 > FClip.X + FClip.W then X2 := FClip.X + FClip.W;
    if Y2 > FClip.Y + FClip.H then Y2 := FClip.Y + FClip.H;
    if (X1 >= X2) or (Y1 >= Y2) then Exit;
  end;

  for Y := Y1 to Y2 - 1 do
  begin
    Row := GetPixelPtr(X1, Y);
    for X := X1 to X2 - 1 do
    begin
      Row^ := AColor;
      Inc(Row);
    end;
  end;
end;

procedure TWLCanvas.Rect(const ARect: TRectI; AColor: TWLColor);
var
  R: TRectI;
begin
  R := ARect;
  if R.IsEmpty then Exit;
  HLine(R.X, R.X + R.W - 1, R.Y, AColor);
  HLine(R.X, R.X + R.W - 1, R.Y + R.H - 1, AColor);
  VLine(R.X, R.Y, R.Y + R.H - 1, AColor);
  VLine(R.X + R.W - 1, R.Y, R.Y + R.H - 1, AColor);
end;

{ ============================================================ }
{  Скруглённые прямоугольники                                   }
{ ============================================================ }

procedure TWLCanvas.RoundRect(const ARect: TRectI; ARadius: Integer;
                              AColor: TWLColor);
var
  R: TRectI;
  Rad: Integer;
begin
  R := ARect;
  if R.IsEmpty then Exit;

  Rad := ARadius;
  if Rad < 0 then Rad := 0;
  if Rad * 2 > R.W then Rad := R.W div 2;
  if Rad * 2 > R.H then Rad := R.H div 2;

  if Rad = 0 then begin Rect(R, AColor); Exit; end;

  // Прямые участки
  HLine(R.X + Rad, R.X + R.W - Rad - 1, R.Y, AColor);
  HLine(R.X + Rad, R.X + R.W - Rad - 1, R.Y + R.H - 1, AColor);
  VLine(R.X, R.Y + Rad, R.Y + R.H - Rad - 1, AColor);
  VLine(R.X + R.W - 1, R.Y + Rad, R.Y + R.H - Rad - 1, AColor);

  // Углы — четвертинки окружности
  ArcQuarter(R.X + Rad,             R.Y + Rad,             Rad, 2, 3, AColor); // top-left
  ArcQuarter(R.X + R.W - Rad - 1,   R.Y + Rad,             Rad, 3, 4, AColor); // top-right
  ArcQuarter(R.X + R.W - Rad - 1,   R.Y + R.H - Rad - 1,   Rad, 0, 1, AColor); // bottom-right
  ArcQuarter(R.X + Rad,             R.Y + R.H - Rad - 1,   Rad, 1, 2, AColor); // bottom-left
end;

procedure TWLCanvas.FillRoundRect(const ARect: TRectI; ARadius: Integer;
                                  AColor: TWLColor);
var
  R: TRectI;
  Rad, Y, YY, DX, XStart, XEnd: Integer;
begin
  R := ARect;
  if R.IsEmpty then Exit;

  Rad := ARadius;
  if Rad < 0 then Rad := 0;
  if Rad * 2 > R.W then Rad := R.W div 2;
  if Rad * 2 > R.H then Rad := R.H div 2;

  if Rad = 0 then begin FillRect(R, AColor); Exit; end;

  // Центральный прямоугольник (без верхних/нижних Rad строк)
  FillRect(TRectI.New(R.X, R.Y + Rad, R.W, R.H - 2 * Rad), AColor);
  // Верхняя и нижняя полосы, минус углы
  FillRect(TRectI.New(R.X + Rad, R.Y, R.W - 2 * Rad, Rad), AColor);
  FillRect(TRectI.New(R.X + Rad, R.Y + R.H - Rad, R.W - 2 * Rad, Rad), AColor);

  // Углы — четвертинки диска
  for Y := 0 to Rad - 1 do
  begin
    YY := Y - Rad;
    DX := Round(Sqrt(Rad * Rad - YY * YY));

    XStart := R.X + Rad - DX;
    XEnd   := R.X + Rad - 1;
    HLine(XStart, XEnd, R.Y + Y, AColor);                     // top-left

    XStart := R.X + R.W - Rad;
    XEnd   := R.X + R.W - Rad + DX - 1;
    HLine(XStart, XEnd, R.Y + Y, AColor);                     // top-right

    HLine(XStart, XEnd, R.Y + R.H - 1 - Y, AColor);           // bottom-right

    XStart := R.X + Rad - DX;
    XEnd   := R.X + Rad - 1;
    HLine(XStart, XEnd, R.Y + R.H - 1 - Y, AColor);           // bottom-left
  end;
end;

{ ============================================================ }
{  Эллипсы                                                      }
{ ============================================================ }

procedure TWLCanvas.Ellipse(const ARect: TRectI; AColor: TWLColor);
var
  CX, CY, RX, RY, X, Y: Integer;
  RX2, RY2, P, PX, PY: Int64;
begin
  if ARect.W <= 0 or ARect.H <= 0 then Exit;

  CX := ARect.X + ARect.W div 2;
  CY := ARect.Y + ARect.H div 2;
  RX := ARect.W div 2;
  RY := ARect.H div 2;
  if (RX = 0) or (RY = 0) then Exit;

  RX2 := Int64(RX) * RX;
  RY2 := Int64(RY) * RY;

  // Рисуем квадрантами, используя параметрический подход
  X := 0;
  Y := RY;
  PX := 0;
  PY := 2 * RX2 * Y;

  // Верхний и нижний
  while PX <= PY do
  begin
    SetPixel(CX + X, CY - Y, AColor);
    SetPixel(CX - X, CY - Y, AColor);
    SetPixel(CX + X, CY + Y, AColor);
    SetPixel(CX - X, CY + Y, AColor);

    Inc(X);
    PX := PX + 2 * RY2;
    if PX > PY then Break;

    P := PX - PY + RX2;
    if P >= 0 then
    begin
      Dec(Y);
      PY := PY - 2 * RX2;
    end;
  end;

  // Боковые
  Y := 0;
  X := RX;
  PY := 0;
  PX := 2 * RY2 * X;

  while PY <= PX do
  begin
    SetPixel(CX + X, CY - Y, AColor);
    SetPixel(CX - X, CY - Y, AColor);
    SetPixel(CX + X, CY + Y, AColor);
    SetPixel(CX - X, CY + Y, AColor);

    Inc(Y);
    PY := PY + 2 * RX2;
    if PY > PX then Break;

    P := PY - PX + RY2;
    if P >= 0 then
    begin
      Dec(X);
      PX := PX - 2 * RY2;
    end;
  end;
end;

procedure TWLCanvas.FillEllipse(const ARect: TRectI; AColor: TWLColor);
var
  CX, CY, RX, RY, Y, DX: Integer;
  RY2, RX2: Int64;
  YF, DF: Double;
begin
  if ARect.W <= 0 or ARect.H <= 0 then Exit;

  CX := ARect.X + ARect.W div 2;
  CY := ARect.Y + ARect.H div 2;
  RX := ARect.W div 2;
  RY := ARect.H div 2;
  if (RX = 0) or (RY = 0) then Exit;

  // Простой способ: для каждой строки Y считаем X по формуле эллипса
  for Y := -RY to RY do
  begin
    YF := Y / RY;
    DF := 1.0 - YF * YF;
    if DF < 0 then Continue;
    DX := Round(RX * Sqrt(DF));
    HLine(CX - DX, CX + DX, CY + Y, AColor);
  end;
end;

{ ============================================================ }
{  Вспомогательное: четверть дуги для RoundRect                 }
{ ============================================================ }
// quadrant: 0=bottom-right, 1=bottom-left, 2=top-left, 3=top-right
procedure TWLCanvas.ArcQuarter(CX, CY, R: Integer;
                               QStart, QEnd: Integer; AColor: TWLColor);
var
  Angle: Double;
  X, Y: Integer;
  Q: Integer;
  SX, SY: Integer;
begin
  if R <= 0 then Exit;

  // Рисуем дугу по квадрантам с шагом 1 пиксель по окружности
  for Q := QStart to QEnd do
  begin
    case Q of
      0: begin SX := 1;  SY := 1;  end;  // bottom-right: X+, Y+
      1: begin SX := -1; SY := 1;  end;  // bottom-left:  X-, Y+
      2: begin SX := -1; SY := -1; end;  // top-left:     X-, Y-
      3: begin SX := 1;  SY := -1; end;  // top-right:    X+, Y-
    else
      Continue;
    end;

    // четверть окружности: от (R, 0) до (0, R) в локальных коорд.
    for Angle := 0 to R do
    begin
      // параметр t от 0 до 1
      // X = R * cos(t*pi/2), Y = R * sin(t*pi/2)
      X := Round(R * Cos(Angle / R * Pi / 2));
      Y := Round(R * Sin(Angle / R * Pi / 2));
      SetPixel(CX + SX * X, CY + SY * Y, AColor);
    end;
  end;
end;

{ ============================================================ }
{  CopyRect                                                     }
{ ============================================================ }

procedure TWLCanvas.CopyRect(const ASrc: TRectI; ADstX, ADstY: Integer);
var
  Src: TRectI;
  RowBytes: Integer;
  Y, SrcY, DstY: Integer;
  SrcPtr, DstPtr: PByte;
  Tmp: PByte;
begin
  if FPixels = nil then Exit;
  Src := ASrc;
  if Src.IsEmpty then Exit;

  // Ограничиваем
  if Src.X < 0 then begin
    Dec(Src.W, -Src.X);
    Dec(ADstX, -Src.X);
    Src.X := 0;
  end;
  if Src.Y < 0 then begin
    Dec(Src.H, -Src.Y);
    Dec(ADstY, -Src.Y);
    Src.Y := 0;
  end;
  if Src.X + Src.W > FWidth then Src.W := FWidth - Src.X;
  if Src.Y + Src.H > FHeight then Src.H := FHeight - Src.Y;
  if (Src.W <= 0) or (Src.H <= 0) then Exit;

  RowBytes := Src.W * 4;

  // Простой путь — через временный буфер
  Tmp := GetMem(RowBytes);
  try
    for Y := 0 to Src.H - 1 do
    begin
      SrcY := Src.Y + Y;
      DstY := ADstY + Y;
      if (DstY < 0) or (DstY >= FHeight) then Continue;

      SrcPtr := FPixels + SrcY * FStride + Src.X * 4;
      DstPtr := FPixels + DstY * FStride + ADstX * 4;

      // Копируем через временный буфер, чтобы избежать наложения
      Move(SrcPtr^, Tmp^, RowBytes);

      // Обрезаем по границам
      if ADstX + Src.W > FWidth then
      begin
        // копируем только видимую часть
        Move(Tmp^, DstPtr^, (FWidth - ADstX) * 4);
      end
      else if ADstX >= 0 then
      begin
        Move(Tmp^, DstPtr^, RowBytes);
      end
      else
      begin
        // ADstX < 0: пропускаем первые -ADstX пикселей
        Move(PByte(Tmp + (-ADstX) * 4)^, FPixels[0], 0); // заглушка
        // (для простоты — пропустим этот случай; обычно не нужен)
      end;
    end;
  finally
    FreeMem(Tmp);
  end;
end;

{ ============================================================ }
{  Клип                                                        }
{ ============================================================ }

procedure TWLCanvas.SetClip(const ARect: TRectI);
begin
  FClip := ARect;
  // Ограничиваем границами буфера
  if FClip.X < 0 then begin Dec(FClip.W, -FClip.X); FClip.X := 0; end;
  if FClip.Y < 0 then begin Dec(FClip.H, -FClip.Y); FClip.Y := 0; end;
  if FClip.X + FClip.W > FWidth then FClip.W := FWidth - FClip.X;
  if FClip.Y + FClip.H > FHeight then FClip.H := FHeight - FClip.Y;
  if FClip.W < 0 then FClip.W := 0;
  if FClip.H < 0 then FClip.H := 0;
  FClipActive := True;
end;

procedure TWLCanvas.ResetClip;
begin
  FClipActive := False;
  FClip := TRectI.New(0, 0, FWidth, FHeight);
end;

function TWLCanvas.ClipRect: TRectI;
begin
  if FClipActive then
    Result := FClip
  else
    Result := TRectI.New(0, 0, FWidth, FHeight);
end;

end.

Внимание: в wlgui_canvas.pas использован ArcQuarter, объявленный вне класса — надо либо добавить его как приватный метод класса, либо как процедуру в implementation до RoundRect. Проще — сделать приватным методом. Добавь в private:
pascal

    procedure ArcQuarter(CX, CY, R: Integer;
                         QStart, QEnd: Integer; AColor: TWLColor);

И в implementation — как у меня, только с TWLCanvas.:
pascal

procedure TWLCanvas.ArcQuarter(CX, CY, R: Integer;
                               QStart, QEnd: Integer; AColor: TWLColor);

Изменения в wlgui_window.pas

Добавляем поле FCanvas: TWLCanvas и публичное свойство Canvas. Создаём/пересоздаём canvas в EnsureBuffers и в BeginPaint.

Патч в TWLWindow:

В private:
pascal

    FCanvas: TWLCanvas;

В public:
pascal

    property Canvas: TWLCanvas read FCanvas;

В uses:
pascal

  wlgui_types, wlgui_context, wlgui_canvas;

В constructor:
pascal

  FCanvas := nil;

В destructor, до DestroyBuffers:
pascal

  if FCanvas <> nil then FreeAndNil(FCanvas);

В EnsureBuffers, в конце:
pascal

  if FCanvas = nil then
    FCanvas := TWLCanvas.Create(FBuffers[FDrawIndex].Pixels,
                                FWidth, FHeight, FBuffers[FDrawIndex].Stride)
  else
    FCanvas.Reattach(FBuffers[FDrawIndex].Pixels,
                     FWidth, FHeight, FBuffers[FDrawIndex].Stride);

В BeginPaint — критично: после выбора буфера переключаем canvas на его пиксели:
pascal

function TWLWindow.BeginPaint: PByte;
var
  I, Idx, Tries: Integer;
begin
  Result := nil;
  if (FBuffers[0] = nil) or (FBuffers[1] = nil) then Exit;

  Tries := 0;
  Idx := FDrawIndex;
  while Tries < 2 do
  begin
    if FBuffers[Idx].Released then
    begin
      FDrawIndex := Idx;
      // переключаем canvas на этот буфер
      if FCanvas <> nil then
        FCanvas.Reattach(FBuffers[Idx].Pixels, FWidth, FHeight,
                         FBuffers[Idx].Stride);
      Result := FBuffers[Idx].Pixels;
      Exit;
    end;
    Idx := 1 - Idx;
    Inc(Tries);
  end;
end;

В EndPaint — добавляем FCanvas.ResetClip, чтобы клип не залипал между кадрами:
pascal

procedure TWLWindow.EndPaint;
var
  B: TWLShmBuffer;
begin
  if FCanvas <> nil then
    FCanvas.ResetClip;

  if (FBuffers[0] = nil) or (FBuffers[1] = nil) then Exit;

  B := FBuffers[FDrawIndex];
  if not B.Released then Exit;

  FSurface.Attach(B.Buffer, 0, 0);
  FSurface.Damage(0, 0, FWidth, FHeight);
  FSurface.Commit;
  FContext.Display.Flush;

  B.MarkBusy;
  FDrawIndex := 1 - FDrawIndex;
end;

Публичные методы Clear, SetPixel, FillRect — можно оставить как обёртки над canvas для совместимости с текущим demo, но лучше перенаправить их:
pascal

procedure TWLWindow.Clear(AColor: TWLColor);
begin
  if FCanvas <> nil then
    FCanvas.FillRect(TRectI.New(0, 0, FWidth, FHeight), AColor);
end;

procedure TWLWindow.SetPixel(AX, AY: Integer; AColor: TWLColor);
begin
  if FCanvas <> nil then
    FCanvas.SetPixel(AX, AY, AColor);
end;

procedure TWLWindow.FillRect(const ARect: TRectI; AColor: TWLColor);
begin
  if FCanvas <> nil then
    FCanvas.FillRect(ARect, AColor);
end;

Обновлённый demo_window.pas — тест всех примитивов

Заменим содержимое OnPaint — покажем все фигуры:
pascal

procedure OnPaint(Sender: TObject);
var
  W: TWLWindow;
  C: TWLCanvas;
  P: TPointI;
  R: TRectI;
  T: Integer;
begin
  W := TWLWindow(Sender);
  if W.BeginPaint = nil then Exit;
  C := W.Canvas;
  if C = nil then Exit;

  // Фон
  if Frame mod 2 = 0 then
    C.FillRect(TRectI.New(0, 0, W.Width, W.Height), TWLColor($00203050))
  else
    C.FillRect(TRectI.New(0, 0, W.Width, W.Height), TWLColor($00305020));

  // Рамка
  C.Rect(TRectI.New(10, 10, W.Width - 20, W.Height - 20), clWhite);

  // Диагонали
  C.Line(10, 10, W.Width - 11, W.Height - 11, clGray);
  C.Line(W.Width - 11, 10, 10, W.Height - 11, clGray);

  // Летящий квадрат (по горизонтали)
  T := (Frame * 4) mod (W.Width - 60);
  C.FillRect(TRectI.New(20 + T, 40, 40, 40), clRed);
  C.Rect(TRectI.New(20 + T, 40, 40, 40), clWhite);

  // Скруглённый прямоугольник
  C.FillRoundRect(TRectI.New(20, 120, 120, 60), 15, TWLColor($00208040));
  C.RoundRect(TRectI.New(20, 120, 120, 60), 15, clWhite);

  // Эллипс-контур
  C.Ellipse(TRectI.New(170, 120, 120, 60), clYellow);

  // Залитый эллипс, мигающий
  if (Frame div 30) mod 2 = 0 then
    C.FillEllipse(TRectI.New(320, 120, 120, 60), TWLColor($00A030A0))
  else
    C.FillEllipse(TRectI.New(320, 120, 120, 60), TWLColor($0030A0A0));

  // Прямоугольник с клипом
  R := TRectI.New(20, 200, 200, 60);
  C.Rect(R, clWhite);
  C.SetClip(TRectI.New(30, 210, 100, 40));
  // диагональная штриховка
  for T := 0 to 200 do
    C.Line(20 + T, 200, 20 + T - 60, 260, clLtGray);
  C.ResetClip;

  // Крест в центре
  C.Line(W.Width div 2 - 40, W.Height div 2, W.Width div 2 + 40, W.Height div 2, clYellow);
  C.Line(W.Width div 2, W.Height div 2 - 40, W.Width div 2, W.Height div 2 + 40, clYellow);

  // Полоса прогресса внизу
  T := (Frame * 3) mod (W.Width - 40);
  C.FillRect(TRectI.New(20, W.Height - 40, T, 10), TWLColor($00FF8000));
  C.Rect(TRectI.New(20, W.Height - 40, W.Width - 40, 10), clWhite);
end;

Добавь uses wlgui_canvas в demo_window.pas.
Что проверить

После сборки в окне должно быть:

    Мигающий фон

    Белая рамка

    Диагонали

    Летящий красный квадрат с белой окантовкой

    Скруглённый зелёный прямоугольник

    Жёлтый эллипс (контур)

    Мигающий залитый эллипс

    Прямоугольник с клипованной диагональной штриховкой

    Крест в центре

    Оранжевая полоса прогресса внизу

Если что-то из примитивов кривое (например, RoundRect или Ellipse) — покажи, что видно. Пиксельные алгоритмы для эллипсов часто дают «дырки», можно подправить.
Сборка
bash

fpc -Fu. -Fuwlgui demo_window.pas
./demo_window

Жду результат — потом перейдём к wlgui_font.pas.
Спасибо! Жёлтый эллипс не вижу, остальное вроде есть. Вообще удивительное зрелище: пролетает квадрат, мигает эллипс.
Разбор картинки — почти всё на месте

Смотрим, что получилось:
Примитив	Есть?	Комментарий
Фон мигает	✅	Синий/зелёный оттенок
Белая рамка	✅	
Диагонали	✅	Серые
Летящий красный квадрат	❌	Вижу синий квадрат — глюк с цветом (см. ниже)
Скруглённый зелёный	✅	FillRoundRect работает, но углы подозрительные
Жёлтый эллипс-контур	❌	Не видно
Залитый мигающий эллипс	✅	Розовый/фиолетовый
Клипованная штриховка	⚠️	Серый прямоугольник виден, но штриховки не разобрать
Крест	✅	Голубой (используется clYellow = $0000FFFF, в XRGB8888 = синий с зелёным — это ожидаемо)
Полоса прогресса	✅	Оранжевая
Баг 1: clRed даёт синий квадрат

Проверим наши цвета. clRed = $000000FF. Записываем в LongWord в память little-endian: байты FF 00 00 00. Композитор читает их как XRGB8888 → X=FF (игнорируется), R=00, G=00, B=00 → чёрный.

Стоп, но квадрат синий. Значит, композитор читает по-другому. Смотрим внимательно: WL_SHM_FORMAT_XRGB8888 = 1 — 32-bit RGB format, [31:0] x:R:G:B 8:8:8:8 little endian.

Разбираем «[31:0] x:R:G:B ... little endian»:

    Биты 31..24 = x (игнор)

    Биты 23..16 = R

    Биты 15..8 = G

    Биты 7..0 = B

    little endian значит младший байт пишется первым в памяти.

LongWord $00RRGGBB в little-endian памяти: BB GG RR 00. То есть байты идут B, G, R, x — и это правильная раскладка для XRGB8888, если значение LongWord имеет формат $00RRGGBB.

Значит наш TWLColor = $00BBGGRR был неправильным предположением!

    clRed = $000000FF → в памяти FF 00 00 00 → R=0, G=0, B=0 → чёрный? Но мы видим синий. Проверим ещё раз:

    LongWord($000000FF) в памяти little-endian: байты FF 00 00 00. То есть B-байт = FF,G=0,R=0.Пораскладке‘BBGGRR00‘—да,B=FF,G=0,R=0.Пораскладке‘BBGGRR00‘—да,B=FF → чистый синий. ✅

Значит композитор читает как BB GG RR 00 = B в младшем байте. Это подтверждается: квадрат синий.

Итог: в нашей раскладке $00BBGGRR при little-endian получается B G R x — да, R = старший байт из младших 24. У нас сейчас clRed = $000000FF означает B=$FF → синий.

Правильно должно быть: clRed = $0000FF00 (R=$FF, G=0, B=0), `clBlue = $00FF0000`, и т.д.

Проверим на розовом эллипсе: TWLColor($00A030A0) = B=$A0, G=$30, R=$A0 → визуально смесь синего и красного = пурпурный/фиолетовый — да, так и видим. ✅

Проверим на зелёном: TWLColor($00208040) = B=$20, G=$80, R=$40 → смесь зелёного и немного красного = зелёно-коричневый, но выглядит как зелёный. ✅

Итого — наша константа clRed неверная, надо $0000FF00. Но мы определили её как $000000FF. Я ошибся в первоначальном комментарии.

Правильные константы для формата $00BBGGRR с little-endian памятью, чтобы получить ожидаемый цвет:
Цвет	LongWord	Байты в памяти (B, G, R, x)	Визуально
Красный	$000000FF	FF 00 00 00	B=$FF → синий ❌
Красный (правильно)	$0000FF00	00 FF 00 00	R=$FF → красный ✅
Зелёный	$00FF0000	00 00 FF 00	G=$FF → зелёный ✅
Синий	$000000FF	FF 00 00 00	B=$FF → синий ✅
Белый	$00FFFFFF	FF FF FF 00	все = FF → белый ✅
Чёрный	$00000000	00 00 00 00	всё 0 → чёрный ✅
Жёлтый	$0000FFFF	FF FF 00 00	R+G → жёлтый ✅

Стоп, но у нас clGreen = $0000FF00, а clRed = $000000FF. Это значит, что clRed и clBlue перепутаны.

И clYellow = $0000FFFF — но это должно быть R+G = $00FFFF00. А у нас $0000FFFF = G+B = циан/голубой. Именно поэтому крест голубой, а не жёлтый!

Итого: у нас все константы правильные, кроме clRed/clBlue, и clYellow/clCyan, и clMagenta.

Правильные константы для TWLColor = $00BBGGRR (little-endian → B G R x):
pascal

clBlack   = $00000000;   // 00 00 00 00
clWhite   = $00FFFFFF;   // FF FF FF 00
clRed     = $0000FF00;   // 00 FF 00 00  → R=$FF
clGreen   = $00FF0000;   // 00 00 FF 00  → G=$FF
clBlue    = $000000FF;   // FF 00 00 00  → B=$FF
clYellow  = $00FFFF00;   // 00 FF FF 00  → R+G
clCyan    = $00FF00FF;   // FF FF 00 00  → B+G
clMagenta = $00FF00FF;   // стоп, надо B+R = $00FF00FF? нет...

Стоп, я запутался. Давай строго.

Модель: TWLColor = LongWord, интерпретируется как байты в little-endian памяти, которые композитор видит как XRGB8888 (little endian):

    Байт 0 (младший в LongWord) → B

    Байт 1 → G

    Байт 2 → R

    Байт 3 → X (игнор)

Значит LongWord = X<<24 | R<<16 | G<<8 | B. То есть $00RRGGBB — стандартный HTML-подобный порядок, а не $00BBGGRR!

Проверим:

    clRed = R=$FF, G=0, B=0 → LongWord = `$00FF0000→ в памяти байты00 00 FF 00` → B=0, G=0, R=$FF ✅

    clBlue = B=$FF → LongWord = `$000000FF→ в памятиFF 00 00 00` → B=$FF ✅

Значит всё наоборот: TWLColor должен быть $00RRGGBB, а не $00BBGGRR. Я в комментарии в первом сообщении напутал.
Правильные константы
pascal

const
  clBlack   : TWLColor = $00000000;
  clWhite   : TWLColor = $00FFFFFF;
  clRed     : TWLColor = $00FF0000;
  clGreen   : TWLColor = $0000FF00;
  clBlue    : TWLColor = $000000FF;
  clYellow  : TWLColor = $00FFFF00;
  clCyan    : TWLColor = $0000FFFF;
  clMagenta : TWLColor = $00FF00FF;
  clGray    : TWLColor = $00808080;
  clDkGray  : TWLColor = $00404040;
  clLtGray  : TWLColor = $00C0C0C0;

И MakeColor(R, G, B) = (R shl 16) or (G shl 8) or B.

Проверим текущее поведение:

    clRed был $000000FF → в памяти FF 00 00 00 → B=$FF → синий ✅ (совпадает с наблюдением)

    clYellow был $0000FFFF → в памяти FF FF 00 00 → B=FF,G=FF,G=FF → голубой ✅ (совпадает с крестом)

    clGreen был $0000FF00 → в памяти 00 FF 00 00 → G=$FF → зелёный ✅ (совпадает)

    clMagenta был $00FF00FF → в памяти FF 00 FF 00 → B=FF,R=FF,R=FF → пурпурный ✅

Отлично, я разобрался. Меняем константы — теперь всё будет как ожидается.
Баг 2: жёлтый эллипс не видно

Причина: clYellow = $0000FFFF = голубой, и он совпадает по цвету с крестом. А ещё он рисуется до залитого эллипса, но после прямоугольников. Возможно, он просто сливается с фоном или перекрывается другим.

Посмотрим код:
pascal

C.Ellipse(TRectI.New(170, 120, 120, 60), clYellow);

Ellipse рисует контур в (170,120)-(290,180). Между скруглённым (20,120,120,60) и залитым (320,120,120,60). По картинке — там пусто. Возможно, Ellipse рисует только отдельные пиксели с пропусками, и контур слишком тонкий/разреженный, чтобы его разглядеть.

Проверим алгоритм Ellipse: он использует численные методы Брезенхэма для эллипса. Возможна ошибка в инициализации (например, X := 0; Y := RY; — это для верхней части, но потом X := RX; Y := 0; для боковых, и переход между ними может дать разрыв).

Более простой и надёжный подход — параметрический эллипс:
pascal

procedure TWLCanvas.Ellipse(const ARect: TRectI; AColor: TWLColor);
var
  CX, CY, RX, RY, I, Steps: Integer;
  Angle, X, Y: Double;
  PrevX, PrevY: Integer;
begin
  if (ARect.W <= 0) or (ARect.H <= 0) then Exit;

  CX := ARect.X + ARect.W div 2;
  CY := ARect.Y + ARect.H div 2;
  RX := ARect.W div 2;
  RY := ARect.H div 2;
  if (RX = 0) or (RY = 0) then Exit;

  // Число шагов ~ периметр эллипса
  Steps := Round(2 * Pi * (RX + RY) / 2);
  if Steps < 24 then Steps := 24;

  PrevX := CX + RX;
  PrevY := CY;

  for I := 1 to Steps do
  begin
    Angle := 2 * Pi * I / Steps;
    X := CX + RX * Cos(Angle);
    Y := CY + RY * Sin(Angle);
    Line(PrevX, PrevY, Round(X), Round(Y), AColor);
    PrevX := Round(X);
    PrevY := Round(Y);
  end;
end;

Это медленнее, но гарантированно непрерывный контур. Плюс использует уже проверенный Line. Заменяем.
Баг 3: углы RoundRect с артефактами

На скруглённом зелёном прямоугольнике видны точки на углах и небольшие «усики». Это из-за того, что ArcQuarter рисует несколько квадрантов и они перекрываются:
pascal

ArcQuarter(..., QStart := 2, QEnd := 3, ...);  // top-left, top-right

Каждый вызов с QStart..QEnd рисует диапазон квадрантов, и для RoundRect мы вызываем 4 раза с парами (2,3), (3,4), (0,1), (1,2). Квадрант 3 попадает в два вызова, квадрант 1 тоже. Отсюда лишние точки.

Правильно: каждый угол — один квадрант:
pascal

ArcQuarter(R.X + Rad,             R.Y + Rad,             Rad, 2, AColor); // top-left
ArcQuarter(R.X + R.W - Rad - 1,   R.Y + Rad,             Rad, 3, AColor); // top-right
ArcQuarter(R.X + R.W - Rad - 1,   R.Y + R.H - Rad - 1,   Rad, 0, AColor); // bottom-right
ArcQuarter(R.X + Rad,             R.Y + R.H - Rad - 1,   Rad, 1, AColor); // bottom-left

И сам ArcQuarter — с одним параметром Q, а не диапазоном:
pascal

procedure TWLCanvas.ArcQuarter(CX, CY, R, Q: Integer; AColor: TWLColor);
var
  I, X, Y: Integer;
  SX, SY: Integer;
  Angle: Double;
begin
  if R <= 0 then Exit;

  case Q of
    0: begin SX := 1;  SY := 1;  end;  // BR: X+, Y+
    1: begin SX := -1; SY := 1;  end;  // BL: X-, Y+
    2: begin SX := -1; SY := -1; end;  // TL: X-, Y-
    3: begin SX := 1;  SY := -1; end;  // TR: X+, Y-
  else
    Exit;
  end;

  for I := 0 to R do
  begin
    Angle := I / R * Pi / 2;
    X := Round(R * Cos(Angle));
    Y := Round(R * Sin(Angle));
    SetPixel(CX + SX * X, CY + SY * Y, AColor);
  end;
end;

Что менять сейчас
1. wlgui_types.pas — исправить константы
pascal

const
  clBlack   : TWLColor = $00000000;
  clWhite   : TWLColor = $00FFFFFF;
  clRed     : TWLColor = $00FF0000;
  clGreen   : TWLColor = $0000FF00;
  clBlue    : TWLColor = $000000FF;
  clYellow  : TWLColor = $00FFFF00;
  clCyan    : TWLColor = $0000FFFF;
  clMagenta : TWLColor = $00FF00FF;
  clGray    : TWLColor = $00808080;
  clDkGray  : TWLColor = $00404040;
  clLtGray  : TWLColor = $00C0C0C0;

И MakeColor:
pascal

function MakeColor(R, G, B: Byte): TWLColor;
begin
  Result := (LongWord(R) shl 16) or (LongWord(G) shl 8) or LongWord(B);
end;

И комментарий-пояснение:
pascal

{ Формат TWLColor: $00RRGGBB.
  При записи в SHM XRGB8888 (little-endian) LongWord попадает в память
  как байты [B, G, R, 0], что соответствует раскладке XRGB8888: [x:R:G:B].
  Итого: клиент пишет $00RRGGBB, композитор видит R, G, B в правильных каналах. }

2. wlgui_canvas.pas — заменить Ellipse, ArcQuarter

См. выше. Также обновить объявление ArcQuarter в private:
pascal

    procedure ArcQuarter(CX, CY, R, Q: Integer; AColor: TWLColor);

3. demo_window.pas — обновить цвета
pascal

// Фон
C.FillRect(TRectI.New(0, 0, W.Width, W.Height), TWLColor($00302040));  // R=30, G=20, B=40 — тёмно-синий

Теперь TWLColor($00RRGGBB). Мой прежний $00203050 теперь = R=$20, G=$30, B=$50 — тоже тёмный, но другой оттенок. Ничего страшного.

Проверим остальные цвета:

    TWLColor($00208040) = R=$20, G=$80, B=$40 — зелёный с примесями

    TWLColor($00A030A0) = R=$A0, G=$30, B=$A0 — пурпурный

    TWLColor($0030A0A0) = R=30,G=30,G=A0, B=$A0 — циан

    TWLColor($00FF8000) = R=$FF, G=$80, B=0 — оранжевый

Всё логично, просто замени константы в wlgui_types.pas — и demo сразу станет правильноцветным.
Итог патча

    wlgui_types.pas: заменить константы и MakeColor (5 строк).

    wlgui_canvas.pas: заменить Ellipse на параметрический; заменить ArcQuarter на один квадрант.

    Ничего в demo_window.pas не меняем — после фикса цветов увидим правильные красный квадрат, жёлтый эллипс, зелёный RoundRect, циановый крест.

После патча ожидаем:

    Квадрат — красный ✅

    Эллипс-контур — жёлтый ✅

    Крест — жёлтый ✅ (был циановый из-за бага в clYellow)

    Прогресс-бар — оранжевый ✅ (был оранжевый случайно)

    Всё остальное — правильных оттенков

Патчим и смотрим.
wlgui_canvas.pas(301,78) Error: Wrong number of parameters specified for call to "ArcQuarter"
wlgui_canvas.pas(25,15) Error: Found declaration: ArcQuarter(LongInt;LongInt;LongInt;LongInt;TWLColor);
wlgui_canvas.pas(302,78) Error: Wrong number of parameters specified for call to "ArcQuarter"
wlgui_canvas.pas(25,15) Error: Found declaration: ArcQuarter(LongInt;LongInt;LongInt;LongInt;TWLColor);
wlgui_canvas.pas(303,78) Error: Wrong number of parameters specified for call to "ArcQuarter"
wlgui_canvas.pas(25,15) Error: Found declaration: ArcQuarter(LongInt;LongInt;LongInt;LongInt;TWLColor);
wlgui_canvas.pas(304,78) Error: Wrong number of parameters specified for call to "ArcQuarter"
wlgui_canvas.pas(25,15) Error: Found declaration: ArcQuarter(LongInt;LongInt;LongInt;LongInt;TWLColor);
Забыл поправить вызовы ArcQuarter в RoundRect

Ты обновил объявление и реализацию ArcQuarter (теперь 5 параметров: CX, CY, R, Q, Color), но в RoundRect остались старые вызовы с 6 параметрами (CX, CY, R, QStart, QEnd, Color).
Патч wlgui_canvas.pas — функция RoundRect

Найди в RoundRect эти строки:
pascal

  ArcQuarter(R.X + Rad,             R.Y + Rad,             Rad, 2, 3, AColor); // top-left
  ArcQuarter(R.X + R.W - Rad - 1,   R.Y + Rad,             Rad, 3, 4, AColor); // top-right
  ArcQuarter(R.X + R.W - Rad - 1,   R.Y + R.H - Rad - 1,   Rad, 0, 1, AColor); // bottom-right
  ArcQuarter(R.X + Rad,             R.Y + R.H - Rad - 1,   Rad, 1, 2, AColor); // bottom-left

И замени на:
pascal

  ArcQuarter(R.X + Rad,             R.Y + Rad,             Rad, 2, AColor); // top-left
  ArcQuarter(R.X + R.W - Rad - 1,   R.Y + Rad,             Rad, 3, AColor); // top-right
  ArcQuarter(R.X + R.W - Rad - 1,   R.Y + R.H - Rad - 1,   Rad, 0, AColor); // bottom-right
  ArcQuarter(R.X + Rad,             R.Y + R.H - Rad - 1,   Rad, 1, AColor); // bottom-left

Разница: было Rad, 2, 3, AColor (5 параметров начиная с Rad), стало Rad, 2, AColor (3 параметра).

То есть убираем второй номер квадранта из пары (2,3), (3,4), (0,1), (1,2) — оставляем по одному: 2, 3, 0, 1.
Полный контекст — как должна выглядеть RoundRect
pascal

procedure TWLCanvas.RoundRect(const ARect: TRectI; ARadius: Integer;
                              AColor: TWLColor);
var
  R: TRectI;
  Rad: Integer;
begin
  R := ARect;
  if R.IsEmpty then Exit;

  Rad := ARadius;
  if Rad < 0 then Rad := 0;
  if Rad * 2 > R.W then Rad := R.W div 2;
  if Rad * 2 > R.H then Rad := R.H div 2;

  if Rad = 0 then begin Rect(R, AColor); Exit; end;

  // Прямые участки
  HLine(R.X + Rad, R.X + R.W - Rad - 1, R.Y, AColor);
  HLine(R.X + Rad, R.X + R.W - Rad - 1, R.Y + R.H - 1, AColor);
  VLine(R.X, R.Y + Rad, R.Y + R.H - Rad - 1, AColor);
  VLine(R.X + R.W - 1, R.Y + Rad, R.Y + R.H - Rad - 1, AColor);

  // Углы — по одному квадранту
  ArcQuarter(R.X + Rad,             R.Y + Rad,             Rad, 2, AColor); // top-left
  ArcQuarter(R.X + R.W - Rad - 1,   R.Y + Rad,             Rad, 3, AColor); // top-right
  ArcQuarter(R.X + R.W - Rad - 1,   R.Y + R.H - Rad - 1,   Rad, 0, AColor); // bottom-right
  ArcQuarter(R.X + Rad,             R.Y + R.H - Rad - 1,   Rad, 1, AColor); // bottom-left
end;

Проверка реализации ArcQuarter

Убедись, что реализация тоже с 5 параметрами и одним Q:
pascal

procedure TWLCanvas.ArcQuarter(CX, CY, R, Q: Integer; AColor: TWLColor);
var
  I, X, Y: Integer;
  SX, SY: Integer;
  Angle: Double;
begin
  if R <= 0 then Exit;

  case Q of
    0: begin SX := 1;  SY := 1;  end;  // BR: X+, Y+
    1: begin SX := -1; SY := 1;  end;  // BL: X-, Y+
    2: begin SX := -1; SY := -1; end;  // TL: X-, Y-
    3: begin SX := 1;  SY := -1; end;  // TR: X+, Y-
  else
    Exit;
  end;

  for I := 0 to R do
  begin
    Angle := I / R * Pi / 2;
    X := Round(R * Cos(Angle));
    Y := Round(R * Sin(Angle));
    SetPixel(CX + SX * X, CY + SY * Y, AColor);
  end;
end;

После патча собери:
bash

fpc -Fu. -Fuwlgui demo_window.pas
./demo_window

Ожидаем:

    Красный летящий квадрат (после фикса цветов)

    Жёлтый эллипс-контур

    Жёлтый крест

    Зелёный скруглённый (без артефактов на углах)

    Оранжевый прогресс