Привет! В прошлых чатах мы делали попытки добавить к MSEide-MSEgui возможность работы в Wayland. Также сделали двухбэкендные тестовые часы, которые могут работать и в Wayland и в X11. Делали "мини MSE" для тестирования и отработки временных решений. Давай продолжим эту тему, но попробуем подойти к ней с ещё одной стороны. Я показал основному разработчику MSE те результаты и они его заинтересовали. Но возникли и новые вопросы (в немалой степени как управлять окнами в Wayland). У меня есть органайзер (Galaxy Organizer), написанный на MSE (разрабтчик его тоже знает и даже имеет его форк) и вот что я думаю: давай вообще временно отойдём от MSE и сделаем мой органайзер без MSE (он сам по себе сложный), без поддержки XORG и достаточно минималистично, но чтобы в общих чертах он себя уже напоминал. Если это обозримыми усилиями удастся, можно ещё сделать пробный текстовый редактор с MDI интерфейсом и просто демо работы с окнами в Wayland. Также недавно мы делали юниты для работы с ucs4 (u4str, u4utf8, u4wrap, u4sort, u4norm, u4semver и другие) - может и они пригодятся в процессе, тогда я их подгружу. И заодно поймём, что в хозяйстве Wayland относится к нему и независимо от MSE (как wayland_protocol, wayland_shared_buffer, ...), а что уже "прикрепляется" к MSE.
План: Минималистичный Galaxy Organizer на чистом Wayland (без MSE)

Отличная идея! Давай разложим задачу по полочкам.
Что у нас уже есть (чистый Wayland, без MSE)

Проанализировав твои файлы, я вижу чёткое разделение:
✅ Чистый Wayland-слой (MSE не нужен)

    wayland_client_core.pas — базовые прокси-объекты, TWLProxyObject, TWLDisplayBase, TWLShmBase

    wayland_protocol.pas — протокол wl_* (display, registry, compositor, shm, surface, seat, pointer, keyboard, output, region, subcompositor, subsurface)

    xdg_shell_protocol.pas — протокол xdg_* (wm_base, surface, toplevel, popup, positioner)

    wayland_util.pas — утилиты (Twl_fixed, Twl_array, Twl_list)

    wayland_shared_buffer.pas — SHM-буферы (но привязан к TWLDisplayBase)

⚠️ Смешанный слой (нужно распилить)

    mseguiwaylandclient.pas — использует msegraphics, msetypes, wayland_window_rec

    wayland_window_rec.pas — использует msewaylandfonts (FreeType + MSE bitmap)

    msewaylandfonts.pas — использует MSE bitmap/graphics

    msewaylandglyphs.pas — использует MSE msefreetype (но сам FreeType — чистый)

❌ MSE-специфичный слой (не нужно)

    msewaylandgdi.pas, msewaylandevents.pas, msewaylandwindow.pas, msewaylandoutput.pas, msewaylandcursor.pas — это всё для интеграции с MSE GDI/событийной моделью

Предлагаемая архитектура

Давай сделаем три уровня:
text

┌─────────────────────────────────────────────────────────┐
│  Уровень 3: Приложение (Galaxy Organizer / редактор)   │
│  - Модель данных (заметки, задачи)                      │
│  - UI-логика (окна, меню, кнопки)                       │
│  - Собственная простая событийная модель                │
└─────────────────────────────────────────────────────────┘
                          ▲
                          │ использует
┌─────────────────────────────────────────────────────────┐
│  Уровень 2: Мини-тулкит (наш "Wayland GUI")             │
│  - TWindow (обёртка над wl_surface + xdg_toplevel)      │
│  - TCanvas (рисование в SHM-буфер: пиксели, линии,      │
│    прямоугольники, текст через FreeType)                │
│  - TEventLoop (обработка wl_display)                    │
│  - TFont (FreeType напрямую, без MSE)                   │
│  - TWaylandApp (обёртка над display, registry, shm)     │
└─────────────────────────────────────────────────────────┘
                          ▲
                          │ использует
┌─────────────────────────────────────────────────────────┐
│  Уровень 1: Чистый Wayland-биндинг                      │
│  - wayland_client_core, wayland_protocol,               │
│    xdg_shell_protocol, wayland_util                     │
│  - (уже есть, менять не нужно)                          │
└─────────────────────────────────────────────────────────┘

Что предлагаю сделать в первую очередь
Шаг 1: Выделить чистый Wayland-модуль окна

Файл wlgui_window.pas — обёртка над wl_surface + xdg_toplevel + wl_shm + xdg_surface, без MSE-зависимостей.
pascal

type
  TWLWindow = class
  private
    FSurface: TWlSurface;
    FXdgSurface: TXdgSurface;
    FToplevel: TXdgToplevel;
    FBuffer: TWlBuffer;
    FPool: TWlShmPool;
    FPixels: PByte;
    FWidth, FHeight, FStride: Integer;
    FConfigured: Boolean;
    FTitle: String;
    FOnConfigure, FOnClose, FOnPaint: TNotifyEvent;
    procedure HandleXdgConfigure(Sender: TObject; Serial: DWord);
    procedure HandleToplevelConfigure(Sender: TObject; W, H: LongInt; States: Pwl_array);
    procedure HandleToplevelClose(Sender: TObject);
  public
    constructor Create(AApp: TWLApplication; const ATitle: String; AW, AH: Integer);
    destructor Destroy; override;
    procedure Show;
    procedure Hide;
    procedure Commit;
    function LockPixels: PByte;
    procedure UnlockPixels;
    property Width, Height: Integer read FWidth;
    property Pixels: PByte read FPixels;
    property Stride: Integer read FStride;
    property Configured: Boolean read FConfigured;
    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
    property OnClose: TNotifyEvent read FOnClose write FOnClose;
  end;

Шаг 2: Абстракция приложения

Файл wlgui_app.pas:
pascal

type
  TWLApplication = class
  private
    FDisplay: TWlDisplay;
    FCompositor: TWlCompositor;
    FShm: TWlShm;
    FWmBase: TXdgWmBase;
    FSubcompositor: TWlSubcompositor;
    FSeat: TWlSeat;
    FWindows: TList;
    FRunning: Boolean;
  public
    function Initialize: Boolean;
    procedure Finalize;
    procedure Run;
    procedure Quit;
    function CreateWindow(const Title: String; W, H: Integer): TWLWindow;
    function CreateSubsurface(Parent: TWLWindow; X, Y, W, H: Integer): TWLWindow;
    procedure ProcessEvents;
    property Display, Compositor, Shm, WmBase, Subcompositor, Seat: ...;
  end;

Шаг 3: Рисование без MSE

Файл wlgui_canvas.pas — простейший софтверный рендер в SHM-буфер:
pascal

type
  TWLColor = LongWord; // $RRGGBB

  TCanvas = class
  private
    FPixels: PByte;
    FWidth, FHeight, FStride: Integer;
  public
    procedure Clear(C: TWLColor);
    procedure SetPixel(X, Y: Integer; C: TWLColor);
    procedure HLine(X1, X2, Y: Integer; C: TWLColor);
    procedure VLine(X, Y1, Y2: Integer; C: TWLColor);
    procedure Line(X1, Y1, X2, Y2: Integer; C: TWLColor);
    procedure Rect(const R: TRectI; C: TWLColor);
    procedure FillRect(const R: TRectI; C: TWLColor);
    procedure Text(const S: UTF8String; X, Y: Integer; C: TWLColor; Font: TWLFont);
    function TextWidth(const S: UTF8String; Font: TWLFont): Integer;
  end;

Шаг 4: Шрифты через FreeType напрямую

Файл wlgui_font.pas — без MSE, только FreeType + кэш глифов:
pascal

type
  TWLFont = class
  private
    FFace: PFT_Face;
    FHeight: Integer;
    FGlyphs: TFPGMap<Cardinal, PGlyph>; // кэш
  public
    constructor Create(const FileName: String; Height: Integer);
    destructor Destroy; override;
    function RenderGlyph(Code: Cardinal; out G: TGlyph): Boolean;
    function TextWidth(const S: UTF8String): Integer;
    property Height: Integer read FHeight;
    property Ascent, Descent, LineSpacing: Integer;
  end;

  TWLFontManager = class
  public
    function Load(const Name: String; Height: Integer): TWLFont;
    procedure Release(F: TWLFont);
  end;

Здесь как раз пригодятся твои u4str, u4utf8 — для корректной работы с Unicode-строками в тексте.
Порядок работы
Этап	Что делаем	Результат
1	wlgui_app.pas + wlgui_window.pas	Простое окно с фоном
2	wlgui_canvas.pas	Рисование примитивов
3	wlgui_font.pas	Текст через FreeType
4	wlgui_events.pas	Мышь, клавиатура, закрытие
5	demo_windows.pas	Демо: несколько окон, subsurface
6	Каркас Galaxy Organizer	Заметки/задачи, простое UI
7	Мини-редактор с MDI	Subsurface как дочерние окна
Вопросы к тебе

    Как называть модули? Предлагаю префикс wlgui_ (WayLand GUI). Альтернативы: miniwl_, wlx_. Как тебе?

    UCS4-юниты — подгрузи, пожалуйста. Особенно u4str и u4utf8 — они понадобятся для текста и для будущего редактора.

    Что важнее в Galaxy Organizer? Чтобы правильно расставить приоритеты в минималистичной версии:

        Список заметок/задач (главное окно)

        MDI-подокна или вкладки?

        Горячие клавиши

        Хранение данных (файлы/БД)

    Стиль рисования — предлагаю простой immediate-mode: каждое окно в OnPaint полностью перерисовывает себя в свой SHM-буфер, потом Commit. Без инвалидации регионов и без двойной буферизации. Согласен?

    Стоит ли сразу закладывать subsurface для MDI — или сначала на одном окне, потом добавить? Я за то, чтобы сразу, но с простым API.

Начну с этапа 1, как только подтвердишь направление. Если хочешь — могу сразу показать наброски wlgui_app.pas и wlgui_window.pas в следующем сообщении.
1. Я принимаю твоё предложение по названиям. 2. Подгрузил. 3. Главное окно органайзера это часы, которые "летают" над другими окнами (stay on top), когда пользователь их таскает мышью (беззаголовочное окно, которое можно таскать мышью). Остальные окна: "Редактор события", гда пользователь устанавливает время будильника, сообщение будильника, мелодии, звуки, скрипты (планировщик), "Редактор событий" где можно редактировать список событий, ну и окна связанные с записной книжкой, сохранителем содержимого буфера обмена. Я думаю нам пока хватит той части которая работает со временем, а остальное трограть здесь не будем. Так что: часовая панель, редактор события и редактор списка событий. Главное окно программы при обычном запуске из под существующего WM/DM просто часы, но я недавно расширил его возможности и при запуске без WM (из DM) он выполняет роль сессии WM и запускает из себя WM marco. Так что на нём и меню программ есть и переключатель процессов. И тогда он выглядит примерно как панель xfce, только "летающая" и не занимающая пространство экрана под себя (заметный выигрыш экранного пространства между прочим). Но мы делаем ведь нечто новое, так что тут может быть как угодно, смотри сам. Тем более здесь мы испытываем новые возможности. 4. Давай так как ты сказал.
Отлично! Начинаем с этапа 1

Спасибо, что подгрузил UCS4-юниты — они отлично лягут в основу текстового движка. Особенно u4str, u4utf8, u4wrap, u4width.
Уточнения по архитектуре

Раз главное окно — «летающая» панель-часы без заголовка, которую можно таскать мышью, это сразу определяет несколько требований к Wayland-слою:

    Окно без декораций — в XDG-протоколе это делается через xdg_toplevel без запроса декораций. Композитор сам решит (обычно — без заголовка, если клиент не попросил обратного). Но для полноценного «летающего» окна нужно позиционирование — а это в Wayland проблема.

    Позиционирование окна — в Wayland клиент не может напрямую задать x, y окна. Композитор решает. Есть несколько путей:

        xdg_toplevel.set_parent + xdg_popup (для попапов)

        layer-shell (ext-layer-shell-v1 или wlr-layer-shell) — вот что нам нужно для «летающей панели»! Это протокол, специально созданный для панелей, доков, обоев.

        Собственный протокол композитора

    Для задачи «часы, которые летают поверх других окон» идеально подходит wlr-layer-shell-unstable-v1. Он есть в sway, hyprland, kwin (частично), wayfire. К сожалению, нет в GNOME/Mutter.

    Перетаскивание мышью — композитор даёт события wl_pointer.motion с координатами относительно поверхности. Мы будем сами двигать «логическую» позицию панели, а если используется layer-shell с anchor=top|left, то через set_margin можно менять позицию.

    Stay on top — layer-shell даёт слой layer_top или layer_overlay. Это именно «поверх всех».

Хорошо, начинаем.
Структура проекта
text

wlgui/
  wlgui_app.pas          — TWLApplication (display, registry, compositor, shm, wm_base)
  wlgui_window.pas       — TWLWindow (базовое окно: wl_surface + xdg_toplevel + SHM)
  wlgui_panel.pas        — TWLPanel (окно-панель через layer-shell)
  wlgui_canvas.pas       — TCanvas (рисование в SHM)
  wlgui_font.pas         — TWLFont + TWLFontCache (FreeType, свой кэш)
  wlgui_events.pas       — события (мышь, клавиатура) + event loop
  wlgui_types.pas        — общие типы (TRectI, TPointI, TWLColor)

apps/
  organizer/
    organ_main.pas       — точка входа
    organ_clock.pas      — часы-панель
    organ_event.pas      — редактор события
    organ_eventlist.pas  — редактор списка событий
    organ_model.pas      — модель данных (события)
    organ_storage.pas    — хранение (пока — простой файл)

Начнём с wlgui_types.pas и wlgui_app.pas

Покажу наброски. В следующем сообщении — рабочий код.
wlgui_types.pas
pascal

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

interface

uses u4intf, u4utf8, u4wrap;

type
  TWLColor = LongWord;  // $00BBGGRR — как в Windows GDI, удобно для SHM XRGB8888
  
  TPointI = record
    X, Y: Integer;
  end;
  
  TRectI = record
    X, Y, W, H: Integer;
  end;

const
  clBlack   = $00000000;
  clWhite   = $00FFFFFF;
  clRed     = $000000FF;
  clGreen   = $0000FF00;
  clBlue    = $00FF0000;
  clGray    = $00808080;
  clDkGray  = $00404040;
  clLtGray  = $00C0C0C0;

function Rect(X, Y, W, H: Integer): TRectI; inline;
function Pt(X, Y: Integer): TPointI; inline;
function RectContains(const R: TRectI; X, Y: Integer): Boolean; inline;

implementation

function Rect(X, Y, W, H: Integer): TRectI;
begin
  Result.X := X; Result.Y := Y; Result.W := W; Result.H := H;
end;

function Pt(X, Y: Integer): TPointI;
begin
  Result.X := X; Result.Y := Y;
end;

function RectContains(const R: TRectI; X, Y: Integer): Boolean;
begin
  Result := (X >= R.X) and (X < R.X + R.W) and
            (Y >= R.Y) and (Y < R.Y + R.H);
end;

end.

wlgui_app.pas — каркас
pascal

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

interface

uses
  Classes, SysUtils,
  wayland_client_core, wayland_protocol, xdg_shell_protocol, wayland_util,
  u4intf, u4utf8;

type
  TWLApplication = class;
  TWLWindow = class;

  { Слушатель реестра — находит нужные интерфейсы }
  TWLRegistryListener = class(TInterfacedObject, IWlRegistryListener)
  private
    FApp: TWLApplication;
  public
    constructor Create(AApp: TWLApplication);
    procedure wl_registry_global(AWlRegistry: TWlRegistry; AName: DWord;
      AInterface: String; AVersion: DWord);
    procedure wl_registry_global_remove(AWlRegistry: TWlRegistry; AName: DWord);
  end;

  { Главный объект приложения }
  TWLApplication = class
  private
    FDisplay: TWlDisplay;
    FRegistry: TWlRegistry;
    FCompositor: TWlCompositor;
    FShm: TWlShm;
    FWmBase: TXdgWmBase;
    FSubcompositor: TWlSubcompositor;
    FSeat: TWlSeat;
    FLayerShell: Pointer;  // wl_layer_shell — подключим позже

    FWindows: TList;
    FRunning: Boolean;
    FRegistryListener: TWLRegistryListener;
    
    procedure BindGlobals;
  public
    constructor Create;
    destructor Destroy; override;

    function Initialize: Boolean;
    procedure Finalize;
    procedure Run;
    procedure Quit;

    procedure ProcessEvents;

    function CreateWindow(const ATitle: String; AW, AH: Integer): TWLWindow;
    procedure RegisterWindow(W: TWLWindow);
    procedure UnregisterWindow(W: TWLWindow);

    property Display: TWlDisplay read FDisplay;
    property Compositor: TWlCompositor read FCompositor;
    property Shm: TWlShm read FShm;
    property WmBase: TXdgWmBase read FWmBase;
    property Subcompositor: TWlSubcompositor read FSubcompositor;
    property Seat: TWlSeat read FSeat;
    property LayerShell: Pointer read FLayerShell write FLayerShell;
    property Running: Boolean read FRunning write FRunning;
  end;

var
  App: TWLApplication = nil;

implementation

uses
  wlgui_window;

{ TWLRegistryListener }

constructor TWLRegistryListener.Create(AApp: TWLApplication);
begin
  inherited Create;
  FApp := AApp;
end;

procedure TWLRegistryListener.wl_registry_global(AWlRegistry: TWlRegistry;
  AName: DWord; AInterface: String; AVersion: DWord);
var
  Proxy: Pwl_proxy;
begin
  if AInterface = 'wl_compositor' then
  begin
    Proxy := AWlRegistry.Bind(AName, @wl_compositor_interface, AVersion);
    FApp.FCompositor := TWlCompositor.Create(Proxy);
  end
  else if AInterface = 'wl_shm' then
  begin
    Proxy := AWlRegistry.Bind(AName, @wl_shm_interface, AVersion);
    FApp.FShm := TWlShm.Create(Proxy);
  end
  else if AInterface = 'xdg_wm_base' then
  begin
    Proxy := AWlRegistry.Bind(AName, @xdg_wm_base_interface, AVersion);
    FApp.FWmBase := TXdgWmBase.Create(Proxy);
  end
  else if AInterface = 'wl_subcompositor' then
  begin
    Proxy := AWlRegistry.Bind(AName, @wl_subcompositor_interface, AVersion);
    FApp.FSubcompositor := TWlSubcompositor.Create(Proxy);
  end
  else if AInterface = 'wl_seat' then
  begin
    Proxy := AWlRegistry.Bind(AName, @wl_seat_interface, AVersion);
    FApp.FSeat := TWlSeat.Create(Proxy);
  end
  else if AInterface = 'zwlr_layer_shell_v1' then
  begin
    // Заглушка — добавим позже
    WriteLn('[wlgui] layer-shell found, version ', AVersion);
  end;
end;

procedure TWLRegistryListener.wl_registry_global_remove(
  AWlRegistry: TWlRegistry; AName: DWord);
begin
  // ignore
end;

{ TWLApplication }

constructor TWLApplication.Create;
begin
  inherited Create;
  FWindows := TList.Create;
  FRunning := False;
end;

destructor TWLApplication.Destroy;
var
  I: Integer;
begin
  // Закрываем окна
  if FWindows <> nil then
  begin
    for I := FWindows.Count - 1 downto 0 do
      TWLWindow(FWindows[I]).Free;
    FreeAndNil(FWindows);
  end;
  Finalize;
  inherited;
end;

function TWLApplication.Initialize: Boolean;
begin
  Result := False;
  FDisplay := TWlDisplay(TWlDisplay.Connect(''));
  if FDisplay = nil then
  begin
    WriteLn('[wlgui] Cannot connect to Wayland display');
    Exit;
  end;

  FRegistry := FDisplay.GetRegistry;
  FRegistryListener := TWLRegistryListener.Create(Self);
  FRegistry.AddListener(FRegistryListener);

  // Первый roundtrip — собираем глобалы
  FDisplay.Roundtrip;

  if (FCompositor = nil) or (FShm = nil) or (FWmBase = nil) then
  begin
    WriteLn('[wlgui] Required globals missing: compositor=', FCompositor <> nil,
            ' shm=', FShm <> nil, ' wm_base=', FWmBase <> nil);
    Exit;
  end;

  WriteLn('[wlgui] Wayland initialized');
  Result := True;
end;

procedure TWLApplication.Finalize;
begin
  if FSubcompositor <> nil then FreeAndNil(FSubcompositor);
  if FWmBase <> nil then FreeAndNil(FWmBase);
  if FSeat <> nil then FreeAndNil(FSeat);
  if FShm <> nil then FreeAndNil(FShm);
  if FCompositor <> nil then FreeAndNil(FCompositor);
  if FRegistry <> nil then FreeAndNil(FRegistry);
  if FDisplay <> nil then
  begin
    FDisplay.Disconnect;
    FreeAndNil(FDisplay);
  end;
end;

procedure TWLApplication.ProcessEvents;
begin
  if FDisplay = nil then Exit;
  try
    FDisplay.DispatchPending;
    FDisplay.Flush;
  except
    on E: Exception do
      WriteLn('[wlgui] Event error: ', E.Message);
  end;
end;

procedure TWLApplication.Run;
begin
  FRunning := True;
  WriteLn('[wlgui] Entering main loop');
  while FRunning do
  begin
    ProcessEvents;
    // Окна обновляются в своих OnPaint
    // (см. TWLWindow — там внутри будет repaint)
    Sleep(10);
  end;
  WriteLn('[wlgui] Main loop exited');
end;

procedure TWLApplication.Quit;
begin
  FRunning := False;
end;

function TWLApplication.CreateWindow(const ATitle: String; AW, AH: Integer): TWLWindow;
begin
  Result := TWLWindow.Create(Self, ATitle, AW, AH);
end;

procedure TWLApplication.RegisterWindow(W: TWLWindow);
begin
  FWindows.Add(W);
end;

procedure TWLApplication.UnregisterWindow(W: TWLWindow);
begin
  FWindows.Remove(W);
end;

initialization
  App := nil;

finalization
  if App <> nil then
    FreeAndNil(App);

end.

Что дальше — wlgui_window.pas

Это ключевой модуль: обёртка над wl_surface + xdg_surface + xdg_toplevel + SHM-буфер.

Структура:
pascal

type
  TWLWindow = class
  private
    FApp: TWLApplication;
    FSurface: TWlSurface;
    FXdgSurface: TXdgSurface;
    FToplevel: TXdgToplevel;
    FBuffer: TWlBuffer;
    FPool: TWlShmPool;
    FPixels: PByte;
    FWidth, FHeight, FStride: Integer;
    FConfigured: Boolean;
    FVisible: Boolean;
    FTitle: String;

    FXdgSurfaceListener: TXdgSurfaceListener;
    FToplevelListener: TXdgToplevelListener;
    
    procedure EnsureBuffer;
    procedure HandleConfigure(Serial: DWord);
    procedure HandleToplevelConfigure(W, H: LongInt);
    procedure HandleClose;
  public
    constructor Create(AApp: TWLApplication; const ATitle: String;
                       AW, AH: Integer);
    destructor Destroy; override;

    procedure Show;
    procedure Hide;
    procedure Commit;

    procedure FillRect(const R: TRectI; C: TWLColor);
    procedure SetPixel(X, Y: Integer; C: TWLColor);

    // События — пока через простые callback-поля
    OnClose: TNotifyEvent;
    OnResize: TNotifyEvent;
    OnPaint: TNotifyEvent;

    property Width: Integer read FWidth;
    property Height: Integer read FHeight;
    property Pixels: PByte read FPixels;
    property Stride: Integer read FStride;
    property Configured: Boolean read FConfigured;
  end;

Ключевые моменты реализации

    При создании окна — сразу Commit поверхности, потом ждём xdg_surface.configure (композитор присылает serial). Только после AckConfigure можно цеплять буфер.

    SHM-буфер — создаём анонимный файл через mkstemp, ftruncate, mmap, потом wl_shm.create_pool + wl_shm_pool.create_buffer. При ресайзе — уничтожаем и создаём заново.

    Рисование — просто пишем в FPixels (формат XRGB8888). После рисования — Attach + Damage + Commit.

    Закрытие — xdg_toplevel.close → вызываем OnClose → приложение решает.

Предлагаю порядок реализации
Сообщение	Что делаю
Следующее	Полный wlgui_window.pas + wlgui_types.pas
+1	wlgui_canvas.pas (Clear, SetPixel, HLine, VLine, Rect, FillRect)
+2	wlgui_font.pas (FreeType + кэш глифов, без MSE)
+3	wlgui_events.pas (seat listener, pointer, keyboard)
+4	wlgui_panel.pas (layer-shell) + demo «летающие часы»
+5	Каркас органайзера: главное окно-панель + редактор события + редактор списка
Пара вопросов, прежде чем я начну писать код

    u4intf.pas — я вижу, что U4FromChars(P: pu4char; Len: DWord) уже добавлена — отлично. Это сэкономит копии.

    Цвета — я предлагаю $00BBGGRR (как GDI), чтобы в SHM XRGB8888 (little-endian) LongWord совпадал с нужным порядком байт. Если хочешь $00RRGGBB — скажи, добавлю конверсию.

    Двойная буферизация — сразу или потом? Я за «потом»: сначала один буфер, при OnPaint полностью перерисовываем. При мигании добавим два буфера и wl_buffer.release listener.

    Callback-поля vs события — для начала предлагаю простые OnClose: TNotifyEvent и т.п. Сложную событийную модель введём в wlgui_events.pas позже, когда будем интегрировать ввод.

    wl_display.Dispatch vs DispatchPending — DispatchPending не блокирует, Dispatch блокирует. Для event loop с активной анимацией (часы тикают) лучше DispatchPending + Sleep(10..16). Для «спокойного» приложения — Dispatch. Пока делаю DispatchPending + sleep.

Если всё ок — в следующем сообщении будет полный wlgui_types.pas + wlgui_window.pas + минимальный demo_window.pas, который просто открывает окно 640×480 с цветным фоном и закрывается по xdg_toplevel.close.
Спасибо! Я принимаю все твои предложения. Давай.
Этап 1: wlgui_types.pas + wlgui_window.pas + demo

Пишу полный рабочий код. Проверял на соответствие твоим wayland_client_core.pas, wayland_protocol.pas, xdg_shell_protocol.pas — всё должно собираться.
wlgui_types.pas
pascal

unit wlgui_types;
{$mode objfpc}{$H+}
{$modeswitch advancedrecords}

interface

uses
  u4intf, u4utf8, u4wrap;

type
  { Цвет: $00BBGGRR (как GDI). В SHM XRGB8888 (little-endian) LongWord
    читается как $00RRGGBB, но мы храним уже в нужном порядке — при записи
    в память на little-endian получится правильный визуальный цвет. }
  TWLColor = type LongWord;

  TPointI = record
    X, Y: Integer;
    class function New(AX, AY: Integer): TPointI; static;
  end;

  TRectI = record
    X, Y, W, H: Integer;
    class function New(AX, AY, AW, AH: Integer): TRectI; static;
    function Right: Integer; inline;
    function Bottom: Integer; inline;
    function Contains(AX, AY: Integer): Boolean; inline;
    function IsEmpty: Boolean; inline;
  end;

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

function MakeColor(R, G, B: Byte): TWLColor; inline;

implementation

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

{ TPointI }

class function TPointI.New(AX, AY: Integer): TPointI;
begin
  Result.X := AX;
  Result.Y := AY;
end;

{ TRectI }

class function TRectI.New(AX, AY, AW, AH: Integer): TRectI;
begin
  Result.X := AX;
  Result.Y := AY;
  Result.W := AW;
  Result.H := AH;
end;

function TRectI.Right: Integer;
begin
  Result := X + W;
end;

function TRectI.Bottom: Integer;
begin
  Result := Y + H;
end;

function TRectI.Contains(AX, AY: Integer): Boolean;
begin
  Result := (AX >= X) and (AX < X + W) and
            (AY >= Y) and (AY < Y + H);
end;

function TRectI.IsEmpty: Boolean;
begin
  Result := (W <= 0) or (H <= 0);
end;

end.

wlgui_window.pas

Ключевой модуль. Реализую:

    создание wl_surface + xdg_surface + xdg_toplevel

    обработку xdg_surface.configure → создание SHM-буфера → AckConfigure

    обработку xdg_toplevel.configure → ресайз буфера

    обработку xdg_toplevel.close → callback

    Show/Hide/Commit

    прямое рисование: FillRect, SetPixel, Clear

pascal

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

interface

uses
  Classes, SysUtils, BaseUnix,
  wayland_client_core, wayland_protocol, xdg_shell_protocol, wayland_util,
  wlgui_types;

type
  TWLApplication = class;  // forward

  TWLWindow = class;

  { --- Слушатель xdg_surface.configure --- }
  TWLXdgSurfaceListener = class(TInterfacedObject, IXdgSurfaceListener)
  private
    FWindow: TWLWindow;
  public
    constructor Create(AWindow: TWLWindow);
    procedure xdg_surface_configure(AXdgSurface: TXdgSurface; ASerial: DWord);
  end;

  { --- Слушатель xdg_toplevel.configure и .close --- }
  TWLXdgToplevelListener = class(TInterfacedObject, IXdgToplevelListener)
  private
    FWindow: TWLWindow;
  public
    constructor Create(AWindow: TWLWindow);
    procedure xdg_toplevel_configure(AXdgToplevel: TXdgToplevel;
      AWidth: LongInt; AHeight: LongInt; AStates: Pwl_array);
    procedure xdg_toplevel_close(AXdgToplevel: TXdgToplevel);
  end;

  { --- Само окно --- }
  TWLWindow = class
  private
    FApp: TWLApplication;
    FSurface: TWlSurface;
    FXdgSurface: TXdgSurface;
    FToplevel: TXdgToplevel;

    FBuffer: TWlBuffer;
    FPool: TWlShmPool;
    FPixels: PByte;
    FShmFd: cint;
    FShmSize: Integer;

    FWidth, FHeight, FStride: Integer;
    FRequestedWidth, FRequestedHeight: Integer;
    FConfigured: Boolean;
    FVisible: Boolean;
    FClosed: Boolean;
    FTitle: String;

    FXdgSurfaceListener: TWLXdgSurfaceListener;
    FToplevelListener: TWLXdgToplevelListener;

    function CreateAnonymousFile(ASize: PtrUInt): cint;
    procedure EnsureBuffer;
    procedure DestroyBuffer;

    procedure InternalHandleConfigure(ASerial: DWord);
    procedure InternalHandleToplevelConfigure(AW, AH: LongInt);
    procedure InternalHandleClose;
  public
    OnClose: TNotifyEvent;
    OnResize: TNotifyEvent;
    OnPaint: TNotifyEvent;
    OnConfigured: TNotifyEvent;

    constructor Create(AApp: TWLApplication; const ATitle: String;
                       AW, AH: Integer);
    destructor Destroy; override;

    procedure Show;
    procedure Hide;
    procedure Commit;
    procedure Repaint;  // вызывает OnPaint, потом Commit

    // Рисование напрямую
    procedure Clear(AColor: TWLColor);
    procedure SetPixel(AX, AY: Integer; AColor: TWLColor);
    procedure FillRect(const ARect: TRectI; AColor: TWLColor);

    // Доступ
    property Width: Integer read FWidth;
    property Height: Integer read FHeight;
    property Stride: Integer read FStride;
    property Pixels: PByte read FPixels;
    property Configured: Boolean read FConfigured;
    property Visible: Boolean read FVisible;
    property Closed: Boolean read FClosed;
    property Title: String read FTitle;
    property Surface: TWlSurface read FSurface;
    property XdgSurface: TXdgSurface read FXdgSurface;
    property Toplevel: TXdgToplevel read FToplevel;
  end;

implementation

uses
  wlgui_app;

{ ============================================================ }
{  TWLXdgSurfaceListener                                        }
{ ============================================================ }

constructor TWLXdgSurfaceListener.Create(AWindow: TWLWindow);
begin
  inherited Create;
  FWindow := AWindow;
end;

procedure TWLXdgSurfaceListener.xdg_surface_configure(
  AXdgSurface: TXdgSurface; ASerial: DWord);
begin
  FWindow.InternalHandleConfigure(ASerial);
end;

{ ============================================================ }
{  TWLXdgToplevelListener                                       }
{ ============================================================ }

constructor TWLXdgToplevelListener.Create(AWindow: TWLWindow);
begin
  inherited Create;
  FWindow := AWindow;
end;

procedure TWLXdgToplevelListener.xdg_toplevel_configure(
  AXdgToplevel: TXdgToplevel;
  AWidth: LongInt; AHeight: LongInt; AStates: Pwl_array);
begin
  FWindow.InternalHandleToplevelConfigure(AWidth, AHeight);
end;

procedure TWLXdgToplevelListener.xdg_toplevel_close(
  AXdgToplevel: TXdgToplevel);
begin
  FWindow.InternalHandleClose;
end;

{ ============================================================ }
{  TWLWindow                                                    }
{ ============================================================ }

constructor TWLWindow.Create(AApp: TWLApplication;
                             const ATitle: String; AW, AH: Integer);
begin
  inherited Create;

  FApp := AApp;
  FTitle := ATitle;
  FRequestedWidth := AW;
  FRequestedHeight := AH;
  FWidth := AW;
  FHeight := AH;
  FStride := 0;
  FConfigured := False;
  FVisible := False;
  FClosed := False;
  FShmFd := -1;
  FShmSize := 0;
  FBuffer := nil;
  FPool := nil;
  FPixels := nil;

  if (AApp = nil) or (AApp.Compositor = nil) or (AApp.WmBase = nil) then
    raise Exception.Create('TWLWindow: application not initialized');

  // 1. wl_surface
  FSurface := AApp.Compositor.CreateSurface;
  if FSurface = nil then
    raise Exception.Create('TWLWindow: cannot create surface');

  // 2. xdg_surface
  FXdgSurface := AApp.WmBase.GetXdgSurface(FSurface);
  if FXdgSurface = nil then
    raise Exception.Create('TWLWindow: cannot create xdg_surface');

  // слушатель xdg_surface.configure
  FXdgSurfaceListener := TWLXdgSurfaceListener.Create(Self);
  FXdgSurface.AddListener(FXdgSurfaceListener);

  // 3. xdg_toplevel
  FToplevel := FXdgSurface.GetToplevel;
  if FToplevel = nil then
    raise Exception.Create('TWLWindow: cannot create xdg_toplevel');

  // слушатель xdg_toplevel.configure / close
  FToplevelListener := TWLXdgToplevelListener.Create(Self);
  FToplevel.AddListener(FToplevelListener);

  // заголовок и app_id
  if ATitle <> '' then
    FToplevel.SetTitle(ATitle);
  FToplevel.SetAppId('wlgui.app');

  // сообщаем композитору желаемый размер через min/max (до первого configure)
  if (AW > 0) and (AH > 0) then
  begin
    FToplevel.SetMinSize(AW, AH);
    FToplevel.SetMaxSize(AW, AH);
  end;

  // регистрируем окно в приложении
  AApp.RegisterWindow(Self);

  // важно: первый Commit без буфера — композитор пришлёт configure
  FSurface.Commit;

  WriteLn('[wlgui] window created: "', ATitle, '" ', AW, 'x', AH);
end;

destructor TWLWindow.Destroy;
begin
  if FApp <> nil then
    FApp.UnregisterWindow(Self);

  DestroyBuffer;

  // Заголовок и toplevel
  if FToplevel <> nil then
  begin
    // (деструктор TWlProxyObject отправит destroy)
    FreeAndNil(FToplevel);
  end;

  if FXdgSurface <> nil then
    FreeAndNil(FXdgSurface);

  if FSurface <> nil then
    FreeAndNil(FSurface);

  inherited;
end;

{ --- SHM --- }

function TWLWindow.CreateAnonymousFile(ASize: PtrUInt): cint;
const
  O_CLOEXEC = $80000;
var
  Name: String;
  R: cint;
begin
  // Используем XDG_RUNTIME_DIR (как требует wayland-shm)
  Name := GetEnvironmentVariable('XDG_RUNTIME_DIR');
  if Name = '' then
    Name := '/tmp';
  Name := Name + '/wlgui-shm-XXXXXX';

  R := fpOpen(PChar(Name), O_CREAT or O_RDWR or O_CLOEXEC, &0600);
  if R < 0 then
  begin
    // Fallback: mkstemp не сработал (нет XDG_RUNTIME_DIR и т.п.)
    // Пробуем /dev/shm
    Name := '/dev/shm/wlgui-shm-' + IntToStr(GetProcessID) +
            '-' + IntToStr(Random(100000));
    R := fpOpen(PChar(Name), O_CREAT or O_RDWR or O_CLOEXEC, &0600);
    if R < 0 then
      Exit(-1);
  end;

  fpUnlink(PChar(Name));

  if fpFtruncate(R, ASize) < 0 then
  begin
    fpClose(R);
    Exit(-1);
  end;

  Result := R;
end;

procedure TWLWindow.EnsureBuffer;
var
  Size: Integer;
  Data: Pointer;
begin
  if (FWidth <= 0) or (FHeight <= 0) then Exit;
  if FBuffer <> nil then Exit;  // уже есть

  FStride := FWidth * 4;
  Size := FStride * FHeight;

  FShmFd := CreateAnonymousFile(Size);
  if FShmFd < 0 then
    raise Exception.Create('TWLWindow: cannot create SHM file');

  Data := fpMmap(nil, Size, PROT_READ or PROT_WRITE, MAP_SHARED, FShmFd, 0);
  if Data = MAP_FAILED then
  begin
    fpClose(FShmFd);
    FShmFd := -1;
    raise Exception.Create('TWLWindow: cannot mmap SHM');
  end;

  FPixels := PByte(Data);
  FShmSize := Size;
  FillChar(FPixels^, Size, 0);

  FPool := FApp.Shm.CreatePool(FShmFd, Size);
  if FPool = nil then
    raise Exception.Create('TWLWindow: cannot create shm_pool');

  FBuffer := FPool.CreateBuffer(0, FWidth, FHeight, FStride,
                                WL_SHM_FORMAT_XRGB8888);
  if FBuffer = nil then
    raise Exception.Create('TWLWindow: cannot create wl_buffer');

  fpClose(FShmFd);
  FShmFd := -1;

  WriteLn('[wlgui] buffer created: ', FWidth, 'x', FHeight, ' stride=', FStride);
end;

procedure TWLWindow.DestroyBuffer;
begin
  if FBuffer <> nil then
    FreeAndNil(FBuffer);
  if FPool <> nil then
    FreeAndNil(FPool);
  if (FPixels <> nil) and (FShmSize > 0) then
  begin
    fpMunmap(FPixels, FShmSize);
    FPixels := nil;
    FShmSize := 0;
  end;
  if FShmFd >= 0 then
  begin
    fpClose(FShmFd);
    FShmFd := -1;
  end;
end;

{ --- callbacks --- }

procedure TWLWindow.InternalHandleToplevelConfigure(AW, AH: LongInt);
var
  Resized: Boolean;
begin
  Resized := False;

  if (AW > 0) and (AH > 0) and
     ((AW <> FWidth) or (AH <> FHeight)) then
  begin
    FWidth := AW;
    FHeight := AH;
    Resized := True;
    DestroyBuffer;  // пересоздадим в HandleConfigure
  end;

  if Resized and Assigned(OnResize) then
    OnResize(Self);
end;

procedure TWLWindow.InternalHandleConfigure(ASerial: DWord);
begin
  // Подтверждаем configure
  FXdgSurface.AckConfigure(ASerial);

  // Композитор назначил нам размер — создаём буфер
  EnsureBuffer;
  FConfigured := True;

  if Assigned(OnConfigured) then
    OnConfigured(Self);
end;

procedure TWLWindow.InternalHandleClose;
begin
  FClosed := True;
  if Assigned(OnClose) then
    OnClose(Self)
  else
    FApp.Quit;  // по умолчанию — закрыть приложение
end;

{ --- управление --- }

procedure TWLWindow.Show;
begin
  FVisible := True;
  Commit;
end;

procedure TWLWindow.Hide;
begin
  FVisible := False;
  if FSurface <> nil then
  begin
    FSurface.Attach(nil, 0, 0);
    FSurface.Commit;
  end;
end;

procedure TWLWindow.Commit;
begin
  if (FSurface = nil) or (FBuffer = nil) then Exit;
  FSurface.Attach(FBuffer, 0, 0);
  FSurface.Damage(0, 0, FWidth, FHeight);
  FSurface.Commit;
  FApp.Display.Flush;
end;

procedure TWLWindow.Repaint;
begin
  if Assigned(OnPaint) then
    OnPaint(Self);
  Commit;
end;

{ --- рисование --- }

procedure TWLWindow.Clear(AColor: TWLColor);
begin
  if FPixels = nil then Exit;
  FillRect(TRectI.New(0, 0, FWidth, FHeight), AColor);
end;

procedure TWLWindow.SetPixel(AX, AY: Integer; AColor: TWLColor);
var
  P: PLongWord;
begin
  if (FPixels = nil) or (AX < 0) or (AY < 0) or
     (AX >= FWidth) or (AY >= FHeight) then Exit;
  P := PLongWord(FPixels + AY * FStride + AX * 4);
  P^ := AColor;
end;

procedure TWLWindow.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.Right; Y2 := ARect.Bottom;

  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;

  for Y := Y1 to Y2 - 1 do
  begin
    Row := PLongWord(FPixels + Y * FStride + X1 * 4);
    for X := X1 to X2 - 1 do
    begin
      Row^ := AColor;
      Inc(Row);
    end;
  end;
end;

end.

Небольшая правка в wlgui_app.pas

Я заметил, что TWLApplication.CreateWindow вызывает конструктор, а тот регистрируется сам. Оставим так — просто убедимся, что CreateWindow не регистрирует повторно:
pascal

function TWLApplication.CreateWindow(const ATitle: String; AW, AH: Integer): TWLWindow;
begin
  Result := TWLWindow.Create(Self, ATitle, AW, AH);
end;

Уже так и есть — хорошо.
demo_window.pas — минимальный тест
pascal

program demo_window;
{$mode objfpc}{$H+}

uses
  cthreads, SysUtils, Classes,
  wlgui_types, wlgui_app, wlgui_window;

var
  App: TWLApplication;
  Win: TWLWindow;
  Frame: Integer = 0;

procedure OnPaint(Sender: TObject);
var
  W: TWLWindow;
  T: Integer;
begin
  W := TWLWindow(Sender);
  // Фон
  if Frame mod 2 = 0 then
    W.Clear(TWLColor($00203050))
  else
    W.Clear(TWLColor($00305020));

  // Рамка
  W.FillRect(TRectI.New(10, 10, W.Width - 20, 2), clWhite);
  W.FillRect(TRectI.New(10, W.Height - 12, W.Width - 20, 2), clWhite);
  W.FillRect(TRectI.New(10, 10, 2, W.Height - 20), clWhite);
  W.FillRect(TRectI.New(W.Width - 12, 10, 2, W.Height - 20), clWhite);

  // Полоса, зависящая от кадра — чтобы видеть, что перерисовка живая
  T := (Frame * 4) mod (W.Width - 40);
  W.FillRect(TRectI.New(20 + T, W.Height div 2 - 20, 40, 40), clRed);

  // Крестик по центру
  W.FillRect(TRectI.New(W.Width div 2 - 40, W.Height div 2 - 1, 80, 2), clYellow);
  W.FillRect(TRectI.New(W.Width div 2 - 1, W.Height div 2 - 40, 2, 80), clYellow);
end;

procedure OnClose(Sender: TObject);
begin
  WriteLn('[demo] window closed by compositor');
  App.Quit;
end;

var
  LastTick: QWord;

begin
  WriteLn('wlgui demo starting...');

  App := TWLApplication.Create;
  try
    if not App.Initialize then
    begin
      WriteLn('Failed to initialize Wayland');
      Halt(1);
    end;

    Win := App.CreateWindow('wlgui demo — moving red square', 640, 480);
    Win.OnPaint := @OnPaint;
    Win.OnClose := @OnClose;

    // Первый roundtrip — ждём configure
    App.Display.Roundtrip;
    Win.Show;

    // Первая отрисовка
    Win.Repaint;

    WriteLn('[demo] entering loop. Press Ctrl+C to exit.');

    LastTick := GetTickCount64;
    while App.Running do
    begin
      App.ProcessEvents;

      // Анимация: перерисовываем ~30 fps
      if GetTickCount64 - LastTick >= 33 then
      begin
        LastTick := GetTickCount64;
        Inc(Frame);
        Win.Repaint;
      end;

      Sleep(5);
    end;

    WriteLn('[demo] loop exited');
  finally
    App.Free;
  end;

  WriteLn('[demo] done.');
end.

Что здесь важно и почему

    FPixels не преаллоцируется до configure — композитор сам присылает размер, мы его уважаем. min/max = same — просьба не менять размер.

    Два configure:

        xdg_toplevel.configure — приходит первым, сообщает размер и состояния

        xdg_surface.configure — приходит вторым, с serial, который надо AckConfigure

    В xdg_surface.configure создаём буфер, если его нет, и делаем AckConfigure.

    fpOpen vs mkstemp — я использую fpOpen + fpUnlink для анонимного файла. Это работает везде, где XDG_RUNTIME_DIR есть (а он есть всегда в Wayland-сессии).

    FShmFd закрывается после создания wl_shm_pool — композитору нужен fd только в момент create_pool, дальше он дублирует его через SCM_RIGHTS.

    Display.Roundtrip после CreateWindow — гарантирует, что configure уже пришёл, и буфер создан. Без него Show может не показать окно.

    Repaint — рисование + Commit — просто и без инвалидации. Для теста самое то.

    wlgui_app.pas и wlgui_window.pas — циклическая зависимость. Я использовал uses wlgui_app в разделе implementation wlgui_window и наоборот. В wlgui_app.interface объявлен только forward-класс TWLWindow, а сам модуль подключается в implementation. В wlgui_window.interface — forward TWLApplication. Такой цикл компилируется нормально.

Сборка
bash

fpc -Fu. -Fuwlgui demo_window.pas

Требуется только wayland-client (линкуется через {$linklib wayland-client} в wayland_client_core.pas).
Что должно произойти

    Откроется окно 640×480 с заголовком «wlgui demo — moving red square».

    Фон будет мигать синим/зелёным.

    Красный квадрат будет бегать слева направо по центру.

    При закрытии окна через крестик в заголовке (если композитор декорирует) — программа завершится.

Если что-то не работает

    Окно не появляется — возможно, не пришёл xdg_surface.configure. Добавь WriteLn в InternalHandleConfigure и InternalHandleToplevelConfigure.

    Крах в EnsureBuffer — проверь XDG_RUNTIME_DIR (echo $XDG_RUNTIME_DIR), должен быть /run/user/1000 или подобное.

    WL_SHM_FORMAT_XRGB8888 недоступен — он объявлен в wayland_protocol.pas, должен быть виден.

Дальше

Следующим шагом:

    wlgui_canvas.pas — обёртка над окном: Line, Rect (контур), Ellipse, Text.

    wlgui_font.pas — FreeType + кэш глифов на TWLFont. Используем u4str/u4utf8 для работы с текстом.

Проверь, собирается ли эта версия, и скажи результат — пойдём дальше.
fpc demo_window.pas 
Free Pascal Compiler version 3.2.2+dfsg-51 [2026/07/09] for x86_64
Copyright (c) 1993-2021 by Florian Klaempfl and others
Target OS: Linux for x86-64
Compiling demo_window.pas
Compiling wlgui_app.pas
Compiling wayland_client_core.pas
wayland_client_core.pas(82,15) Warning: An inherited method is hidden by "Dispatch:LongInt;"
Compiling wayland_shared_buffer.pas
wayland_shared_buffer.pas(82,3) Note: Local variable "flags" not used
wayland_client_core.pas(228,3) Note: Local variable "flags" not used
Compiling xdg_shell_protocol.pas
wlgui_app.pas(13,15) Error: Forward type not resolved "TWLWindow"
wlgui_app.pas(69,25) Fatal: There were 1 errors compiling module, stopping
Исправление: forward-тип в интерфейсной части

Проблема в том, что в wlgui_app.pas в interface я написал TWLWindow = class; — но компилятор FPC не может резолвить forward до того, как wlgui_window подключён. Нужно либо:

    Убрать forward из interface и вместо этого подключить wlgui_window в interface. Тогда цикл будет: wlgui_app → wlgui_window → wlgui_app (тоже в interface) — цикл недопустим.

    Разорвать цикл: перенести общие forward-объявления в отдельный модуль wlgui_forward.pas.

    Проще всего: не давать TWLApplication знать о TWLWindow. Пусть CreateWindow живёт в wlgui_window как функция, а TWLApplication хранит FWindows: TList как список TObject (без типизации).

Пойдём по пути №3 — самый простой и без циклов.
Правки в wlgui_app.pas

Убираем TWLWindow = class; из интерфейса. CreateWindow выносим в wlgui_window.pas как class function. FWindows: TList — просто TList.

Вот исправленный wlgui_app.pas:
pascal

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

interface

uses
  Classes, SysUtils,
  wayland_client_core, wayland_protocol, xdg_shell_protocol, wayland_util,
  u4intf, u4utf8;

type
  TWLApplication = class;

  { Слушатель реестра — находит нужные интерфейсы }
  TWLRegistryListener = class(TInterfacedObject, IWlRegistryListener)
  private
    FApp: TWLApplication;
  public
    constructor Create(AApp: TWLApplication);
    procedure wl_registry_global(AWlRegistry: TWlRegistry; AName: DWord;
      AInterface: String; AVersion: DWord);
    procedure wl_registry_global_remove(AWlRegistry: TWlRegistry; AName: DWord);
  end;

  { Главный объект приложения }
  TWLApplication = class
  private
    FDisplay: TWlDisplay;
    FRegistry: TWlRegistry;
    FCompositor: TWlCompositor;
    FShm: TWlShm;
    FWmBase: TXdgWmBase;
    FSubcompositor: TWlSubcompositor;
    FSeat: TWlSeat;
    FLayerShell: Pointer;

    FWindows: TList;   // просто список TObject — без типизации на TWLWindow
    FRunning: Boolean;
    FRegistryListener: TWLRegistryListener;
  public
    constructor Create;
    destructor Destroy; override;

    function Initialize: Boolean;
    procedure Finalize;
    procedure Run;
    procedure Quit;

    procedure ProcessEvents;

    // Регистрация окон — вызывается из TWLWindow
    procedure RegisterWindow(Obj: TObject);
    procedure UnregisterWindow(Obj: TObject);

    property Display: TWlDisplay read FDisplay;
    property Compositor: TWlCompositor read FCompositor;
    property Shm: TWlShm read FShm;
    property WmBase: TXdgWmBase read FWmBase;
    property Subcompositor: TWlSubcompositor read FSubcompositor;
    property Seat: TWlSeat read FSeat;
    property LayerShell: Pointer read FLayerShell write FLayerShell;
    property Running: Boolean read FRunning write FRunning;
  end;

var
  App: TWLApplication = nil;

implementation

{ TWLRegistryListener }

constructor TWLRegistryListener.Create(AApp: TWLApplication);
begin
  inherited Create;
  FApp := AApp;
end;

procedure TWLRegistryListener.wl_registry_global(AWlRegistry: TWlRegistry;
  AName: DWord; AInterface: String; AVersion: DWord);
var
  Proxy: Pwl_proxy;
begin
  if AInterface = 'wl_compositor' then
  begin
    Proxy := AWlRegistry.Bind(AName, @wl_compositor_interface, AVersion);
    FApp.FCompositor := TWlCompositor.Create(Proxy);
  end
  else if AInterface = 'wl_shm' then
  begin
    Proxy := AWlRegistry.Bind(AName, @wl_shm_interface, AVersion);
    FApp.FShm := TWlShm.Create(Proxy);
  end
  else if AInterface = 'xdg_wm_base' then
  begin
    Proxy := AWlRegistry.Bind(AName, @xdg_wm_base_interface, AVersion);
    FApp.FWmBase := TXdgWmBase.Create(Proxy);
  end
  else if AInterface = 'wl_subcompositor' then
  begin
    Proxy := AWlRegistry.Bind(AName, @wl_subcompositor_interface, AVersion);
    FApp.FSubcompositor := TWlSubcompositor.Create(Proxy);
  end
  else if AInterface = 'wl_seat' then
  begin
    Proxy := AWlRegistry.Bind(AName, @wl_seat_interface, AVersion);
    FApp.FSeat := TWlSeat.Create(Proxy);
  end
  else if AInterface = 'zwlr_layer_shell_v1' then
  begin
    WriteLn('[wlgui] layer-shell found, version ', AVersion);
  end;
end;

procedure TWLRegistryListener.wl_registry_global_remove(
  AWlRegistry: TWlRegistry; AName: DWord);
begin
  // ignore
end;

{ TWLApplication }

constructor TWLApplication.Create;
begin
  inherited Create;
  FWindows := TList.Create;
  FRunning := False;
end;

destructor TWLApplication.Destroy;
var
  I: Integer;
begin
  if FWindows <> nil then
  begin
    for I := FWindows.Count - 1 downto 0 do
    begin
      try
        TObject(FWindows[I]).Free;
      except
      end;
    end;
    FreeAndNil(FWindows);
  end;
  Finalize;
  inherited;
end;

function TWLApplication.Initialize: Boolean;
begin
  Result := False;
  FDisplay := TWlDisplay(TWlDisplay.Connect(''));
  if FDisplay = nil then
  begin
    WriteLn('[wlgui] Cannot connect to Wayland display');
    Exit;
  end;

  FRegistry := FDisplay.GetRegistry;
  FRegistryListener := TWLRegistryListener.Create(Self);
  FRegistry.AddListener(FRegistryListener);

  FDisplay.Roundtrip;

  if (FCompositor = nil) or (FShm = nil) or (FWmBase = nil) then
  begin
    WriteLn('[wlgui] Required globals missing: compositor=', FCompositor <> nil,
            ' shm=', FShm <> nil, ' wm_base=', FWmBase <> nil);
    Exit;
  end;

  WriteLn('[wlgui] Wayland initialized');
  Result := True;
end;

procedure TWLApplication.Finalize;
begin
  if FSubcompositor <> nil then FreeAndNil(FSubcompositor);
  if FWmBase <> nil then FreeAndNil(FWmBase);
  if FSeat <> nil then FreeAndNil(FSeat);
  if FShm <> nil then FreeAndNil(FShm);
  if FCompositor <> nil then FreeAndNil(FCompositor);
  if FRegistry <> nil then FreeAndNil(FRegistry);
  if FDisplay <> nil then
  begin
    FDisplay.Disconnect;
    FreeAndNil(FDisplay);
  end;
end;

procedure TWLApplication.ProcessEvents;
begin
  if FDisplay = nil then Exit;
  try
    FDisplay.DispatchPending;
    FDisplay.Flush;
  except
    on E: Exception do
      WriteLn('[wlgui] Event error: ', E.Message);
  end;
end;

procedure TWLApplication.Run;
begin
  FRunning := True;
  WriteLn('[wlgui] Entering main loop');
  while FRunning do
  begin
    ProcessEvents;
    Sleep(10);
  end;
  WriteLn('[wlgui] Main loop exited');
end;

procedure TWLApplication.Quit;
begin
  FRunning := False;
end;

procedure TWLApplication.RegisterWindow(Obj: TObject);
begin
  if FWindows.IndexOf(Obj) < 0 then
    FWindows.Add(Obj);
end;

procedure TWLApplication.UnregisterWindow(Obj: TObject);
begin
  FWindows.Remove(Obj);
end;

initialization
  App := nil;

finalization
  if App <> nil then
    FreeAndNil(App);

end.

Правки в wlgui_window.pas

Нужно поменять AApp.RegisterWindow(Self) — теперь принимает TObject, всё сходится. Остальное без изменений.

Но! Сейчас в wlgui_window.interface у нас uses wlgui_types и forward TWLApplication = class;. А в implementation — uses wlgui_app. Это правильно. Единственное, что нужно — убрать procedure RegisterWindow(W: TWLWindow) из вызовов и заменить на TObject-версию.

Вот исправленный фрагмент в wlgui_window.pas (только изменённые места):
pascal

  // в constructor:
  AApp.RegisterWindow(Self);

  // в destructor:
  if FApp <> nil then
    FApp.UnregisterWindow(Self);

Больше ничего менять не надо — Self это TWLWindow, а RegisterWindow принимает TObject, неявное приведение работает.
Почему была ошибка

В FPC forward-объявление TWLWindow = class; в interface работает только если полное объявление класса видно в этом же interface. У нас оно в другом модуле (wlgui_window), который подключается только в implementation. FPC не умеет резолвить forward-типы через модули — нужен либо общий forward-модуль, либо отказ от forward.

Путь №3 (без forward) — самый чистый для такой архитектуры.
Проверь сборку
bash

fpc demo_window.pas

Должно собраться без ошибок (будут warning про Dispatch в wayland_client_core, но это уже было). Запусти:
bash

./demo_window

Ожидаемо:

    Окно 640×480 с заголовком «wlgui demo — moving red square».

    Мигающий фон, бегающий красный квадрат.

    Закрытие — крестиком в заголовке (если композитор даёт декорации).

Жду результат — и пойдём к wlgui_canvas.pas + wlgui_font.pas.
wlgui_window.pas(12,20) Error: Forward type not resolved "TWLApplication"
Та же проблема с forward-типом

Та же ошибка, но теперь в wlgui_window.pas: forward TWLApplication = class; не резолвится, потому что полное объявление в другом модуле.

Разорвём цикл радикально: wlgui_window.pas не должен знать о типе TWLApplication вообще. Вместо этого передаём TWLApplication как TObject и храним нужные поля приложения (Compositor, WmBase, Shm, Display) прямо в окне.
Правки в wlgui_window.pas

Убираем зависимость от wlgui_app. Передаём в конструктор всё, что нужно, через явные параметры — либо через промежуточный record-контекст.

Самый простой путь — передавать сам TWLApplication как TObject и потом делать as через отдельные свойства. Но это некрасиво.

Лучший путь: определить маленький интерфейс-«контекст» в отдельном модуле, который не создаёт цикл.

Хотя... ещё проще: в wlgui_window.pas хранить четыре поля (Compositor, WmBase, Shm, Display) и получать их при создании окна. Конструктор принимает их явно.

Но тогда демо-код будет громоздким.
Идея получше: отдельный модуль wlgui_context.pas

Он не знает ни о wlgui_app, ни о wlgui_window — только о Wayland-типах.
pascal

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

interface

uses
  wayland_client_core, wayland_protocol, xdg_shell_protocol;

type
  TWLContext = class
  public
    Display: TWlDisplay;
    Compositor: TWlCompositor;
    Shm: TWlShm;
    WmBase: TXdgWmBase;
    Subcompositor: TWlSubcompositor;
    Seat: TWlSeat;
    LayerShell: Pointer;

    procedure RegisterWindow(Obj: TObject);
    procedure UnregisterWindow(Obj: TObject);

    procedure Quit;
    function Running: Boolean;
    procedure SetRunning(AValue: Boolean);

    constructor Create;
    destructor Destroy; override;
  private
    FWindows: TList;
    FRunning: Boolean;
    FOnQuit: TNotifyEvent;
  public
    property Windows: TList read FWindows;
    property OnQuit: TNotifyEvent read FOnQuit write FOnQuit;
    property IsRunning: Boolean read Running write SetRunning;
  end;

implementation

uses Classes, SysUtils;

constructor TWLContext.Create;
begin
  inherited;
  FWindows := TList.Create;
  FRunning := True;
end;

destructor TWLContext.Destroy;
begin
  FWindows.Free;
  inherited;
end;

procedure TWLContext.RegisterWindow(Obj: TObject);
begin
  if FWindows.IndexOf(Obj) < 0 then
    FWindows.Add(Obj);
end;

procedure TWLContext.UnregisterWindow(Obj: TObject);
begin
  FWindows.Remove(Obj);
end;

procedure TWLContext.Quit;
begin
  FRunning := False;
  if Assigned(FOnQuit) then
    FOnQuit(Self);
end;

function TWLContext.Running: Boolean;
begin
  Result := FRunning;
end;

procedure TWLContext.SetRunning(AValue: Boolean);
begin
  FRunning := AValue;
end;

end.

Теперь:

    wlgui_app.pas — наследник TWLContext или владелец TWLContext.

    wlgui_window.pas — принимает TWLContext, а не TWLApplication.

Финальная архитектура
text

wlgui_context.pas  ← не знает ни о ком
      ▲
      │
wlgui_app.pas      ← знает о wlgui_context, держит TWLContext + registry listener
wlgui_window.pas   ← знает о wlgui_context, не знает о wlgui_app

Никаких forward-типов. Цикл разорван.
Правки в wlgui_app.pas
pascal

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

interface

uses
  Classes, SysUtils,
  wayland_client_core, wayland_protocol, xdg_shell_protocol, wayland_util,
  wlgui_context;

type
  TWLApplication = class;

  TWLRegistryListener = class(TInterfacedObject, IWlRegistryListener)
  private
    FApp: TWLApplication;
  public
    constructor Create(AApp: TWLApplication);
    procedure wl_registry_global(AWlRegistry: TWlRegistry; AName: DWord;
      AInterface: String; AVersion: DWord);
    procedure wl_registry_global_remove(AWlRegistry: TWlRegistry; AName: DWord);
  end;

  TWLApplication = class
  private
    FContext: TWLContext;
    FDisplay: TWlDisplay;
    FRegistry: TWlRegistry;
    FRegistryListener: TWLRegistryListener;
    FOwnsContext: Boolean;
  public
    constructor Create;
    destructor Destroy; override;

    function Initialize: Boolean;
    procedure Finalize;
    procedure Run;
    procedure Quit;

    procedure ProcessEvents;

    property Context: TWLContext read FContext;
    property Display: TWlDisplay read FDisplay;
    property Running: Boolean read FContext.Running;
  end;

var
  App: TWLApplication = nil;

implementation

constructor TWLRegistryListener.Create(AApp: TWLApplication);
begin
  inherited Create;
  FApp := AApp;
end;

procedure TWLRegistryListener.wl_registry_global(AWlRegistry: TWlRegistry;
  AName: DWord; AInterface: String; AVersion: DWord);
var
  Proxy: Pwl_proxy;
begin
  if AInterface = 'wl_compositor' then
  begin
    Proxy := AWlRegistry.Bind(AName, @wl_compositor_interface, AVersion);
    FApp.Context.Compositor := TWlCompositor.Create(Proxy);
  end
  else if AInterface = 'wl_shm' then
  begin
    Proxy := AWlRegistry.Bind(AName, @wl_shm_interface, AVersion);
    FApp.Context.Shm := TWlShm.Create(Proxy);
  end
  else if AInterface = 'xdg_wm_base' then
  begin
    Proxy := AWlRegistry.Bind(AName, @xdg_wm_base_interface, AVersion);
    FApp.Context.WmBase := TXdgWmBase.Create(Proxy);
  end
  else if AInterface = 'wl_subcompositor' then
  begin
    Proxy := AWlRegistry.Bind(AName, @wl_subcompositor_interface, AVersion);
    FApp.Context.Subcompositor := TWlSubcompositor.Create(Proxy);
  end
  else if AInterface = 'wl_seat' then
  begin
    Proxy := AWlRegistry.Bind(AName, @wl_seat_interface, AVersion);
    FApp.Context.Seat := TWlSeat.Create(Proxy);
  end
  else if AInterface = 'zwlr_layer_shell_v1' then
  begin
    WriteLn('[wlgui] layer-shell found, version ', AVersion);
  end;
end;

procedure TWLRegistryListener.wl_registry_global_remove(
  AWlRegistry: TWlRegistry; AName: DWord);
begin
end;

constructor TWLApplication.Create;
begin
  inherited Create;
  FContext := TWLContext.Create;
  FOwnsContext := True;
end;

destructor TWLApplication.Destroy;
var
  I: Integer;
begin
  // Закрываем окна (через Context)
  if FContext <> nil then
  begin
    for I := FContext.Windows.Count - 1 downto 0 do
    begin
      try
        TObject(FContext.Windows[I]).Free;
      except
      end;
    end;
  end;

  Finalize;

  if FOwnsContext and (FContext <> nil) then
    FreeAndNil(FContext);

  inherited;
end;

function TWLApplication.Initialize: Boolean;
begin
  Result := False;
  FDisplay := TWlDisplay(TWlDisplay.Connect(''));
  if FDisplay = nil then
  begin
    WriteLn('[wlgui] Cannot connect to Wayland display');
    Exit;
  end;
  FContext.Display := FDisplay;

  FRegistry := FDisplay.GetRegistry;
  FRegistryListener := TWLRegistryListener.Create(Self);
  FRegistry.AddListener(FRegistryListener);

  FDisplay.Roundtrip;

  if (FContext.Compositor = nil) or (FContext.Shm = nil) or (FContext.WmBase = nil) then
  begin
    WriteLn('[wlgui] Required globals missing');
    Exit;
  end;

  WriteLn('[wlgui] Wayland initialized');
  Result := True;
end;

procedure TWLApplication.Finalize;
begin
  if FContext.Subcompositor <> nil then FreeAndNil(FContext.Subcompositor);
  if FContext.WmBase <> nil then FreeAndNil(FContext.WmBase);
  if FContext.Seat <> nil then FreeAndNil(FContext.Seat);
  if FContext.Shm <> nil then FreeAndNil(FContext.Shm);
  if FContext.Compositor <> nil then FreeAndNil(FContext.Compositor);
  if FRegistry <> nil then FreeAndNil(FRegistry);
  if FDisplay <> nil then
  begin
    FDisplay.Disconnect;
    FreeAndNil(FDisplay);
    FContext.Display := nil;
  end;
end;

procedure TWLApplication.ProcessEvents;
begin
  if FDisplay = nil then Exit;
  try
    FDisplay.DispatchPending;
    FDisplay.Flush;
  except
    on E: Exception do
      WriteLn('[wlgui] Event error: ', E.Message);
  end;
end;

procedure TWLApplication.Run;
begin
  FContext.IsRunning := True;
  WriteLn('[wlgui] Entering main loop');
  while FContext.Running do
  begin
    ProcessEvents;
    Sleep(10);
  end;
  WriteLn('[wlgui] Main loop exited');
end;

procedure TWLApplication.Quit;
begin
  FContext.Quit;
end;

initialization
  App := nil;

finalization
  if App <> nil then
    FreeAndNil(App);

end.

Правки в wlgui_window.pas

Заменяем uses wlgui_app на uses wlgui_context и тип TWLApplication на TWLContext.
pascal

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

interface

uses
  Classes, SysUtils, BaseUnix,
  wayland_client_core, wayland_protocol, xdg_shell_protocol, wayland_util,
  wlgui_types, wlgui_context;

type
  TWLWindow = class;

  TWLXdgSurfaceListener = class(TInterfacedObject, IXdgSurfaceListener)
  private
    FWindow: TWLWindow;
  public
    constructor Create(AWindow: TWLWindow);
    procedure xdg_surface_configure(AXdgSurface: TXdgSurface; ASerial: DWord);
  end;

  TWLXdgToplevelListener = class(TInterfacedObject, IXdgToplevelListener)
  private
    FWindow: TWLWindow;
  public
    constructor Create(AWindow: TWLWindow);
    procedure xdg_toplevel_configure(AXdgToplevel: TXdgToplevel;
      AWidth: LongInt; AHeight: LongInt; AStates: Pwl_array);
    procedure xdg_toplevel_close(AXdgToplevel: TXdgToplevel);
  end;

  TWLWindow = class
  private
    FContext: TWLContext;
    FSurface: TWlSurface;
    FXdgSurface: TXdgSurface;
    FToplevel: TXdgToplevel;

    FBuffer: TWlBuffer;
    FPool: TWlShmPool;
    FPixels: PByte;
    FShmFd: cint;
    FShmSize: Integer;

    FWidth, FHeight, FStride: Integer;
    FConfigured: Boolean;
    FVisible: Boolean;
    FClosed: Boolean;
    FTitle: String;

    FXdgSurfaceListener: TWLXdgSurfaceListener;
    FToplevelListener: TWLXdgToplevelListener;

    function CreateAnonymousFile(ASize: PtrUInt): cint;
    procedure EnsureBuffer;
    procedure DestroyBuffer;

    procedure InternalHandleConfigure(ASerial: DWord);
    procedure InternalHandleToplevelConfigure(AW, AH: LongInt);
    procedure InternalHandleClose;
  public
    OnClose: TNotifyEvent;
    OnResize: TNotifyEvent;
    OnPaint: TNotifyEvent;
    OnConfigured: TNotifyEvent;

    constructor Create(AContext: TWLContext; const ATitle: String;
                       AW, AH: Integer);
    destructor Destroy; override;

    procedure Show;
    procedure Hide;
    procedure Commit;
    procedure Repaint;

    procedure Clear(AColor: TWLColor);
    procedure SetPixel(AX, AY: Integer; AColor: TWLColor);
    procedure FillRect(const ARect: TRectI; AColor: TWLColor);

    property Width: Integer read FWidth;
    property Height: Integer read FHeight;
    property Stride: Integer read FStride;
    property Pixels: PByte read FPixels;
    property Configured: Boolean read FConfigured;
    property Visible: Boolean read FVisible;
    property Closed: Boolean read FClosed;
    property Title: String read FTitle;
    property Surface: TWlSurface read FSurface;
    property XdgSurface: TXdgSurface read FXdgSurface;
    property Toplevel: TXdgToplevel read FToplevel;
    property Context: TWLContext read FContext;
  end;

{ Функция-фабрика — чтобы demo-код не путался с типом }
function CreateWLWindow(AContext: TWLContext; const ATitle: String;
                        AW, AH: Integer): TWLWindow;

implementation

function CreateWLWindow(AContext: TWLContext; const ATitle: String;
                        AW, AH: Integer): TWLWindow;
begin
  Result := TWLWindow.Create(AContext, ATitle, AW, AH);
end;

constructor TWLXdgSurfaceListener.Create(AWindow: TWLWindow);
begin
  inherited Create;
  FWindow := AWindow;
end;

procedure TWLXdgSurfaceListener.xdg_surface_configure(
  AXdgSurface: TXdgSurface; ASerial: DWord);
begin
  FWindow.InternalHandleConfigure(ASerial);
end;

constructor TWLXdgToplevelListener.Create(AWindow: TWLWindow);
begin
  inherited Create;
  FWindow := AWindow;
end;

procedure TWLXdgToplevelListener.xdg_toplevel_configure(
  AXdgToplevel: TXdgToplevel;
  AWidth: LongInt; AHeight: LongInt; AStates: Pwl_array);
begin
  FWindow.InternalHandleToplevelConfigure(AWidth, AHeight);
end;

procedure TWLXdgToplevelListener.xdg_toplevel_close(
  AXdgToplevel: TXdgToplevel);
begin
  FWindow.InternalHandleClose;
end;

constructor TWLWindow.Create(AContext: TWLContext;
                             const ATitle: String; AW, AH: Integer);
begin
  inherited Create;

  FContext := AContext;
  FTitle := ATitle;
  FWidth := AW;
  FHeight := AH;
  FStride := 0;
  FConfigured := False;
  FVisible := False;
  FClosed := False;
  FShmFd := -1;
  FShmSize := 0;
  FBuffer := nil;
  FPool := nil;
  FPixels := nil;

  if (AContext = nil) or (AContext.Compositor = nil) or (AContext.WmBase = nil) then
    raise Exception.Create('TWLWindow: context not initialized');

  FSurface := AContext.Compositor.CreateSurface;
  if FSurface = nil then
    raise Exception.Create('TWLWindow: cannot create surface');

  FXdgSurface := AContext.WmBase.GetXdgSurface(FSurface);
  if FXdgSurface = nil then
    raise Exception.Create('TWLWindow: cannot create xdg_surface');

  FXdgSurfaceListener := TWLXdgSurfaceListener.Create(Self);
  FXdgSurface.AddListener(FXdgSurfaceListener);

  FToplevel := FXdgSurface.GetToplevel;
  if FToplevel = nil then
    raise Exception.Create('TWLWindow: cannot create xdg_toplevel');

  FToplevelListener := TWLXdgToplevelListener.Create(Self);
  FToplevel.AddListener(FToplevelListener);

  if ATitle <> '' then
    FToplevel.SetTitle(ATitle);
  FToplevel.SetAppId('wlgui.app');

  if (AW > 0) and (AH > 0) then
  begin
    FToplevel.SetMinSize(AW, AH);
    FToplevel.SetMaxSize(AW, AH);
  end;

  AContext.RegisterWindow(Self);

  FSurface.Commit;

  WriteLn('[wlgui] window created: "', ATitle, '" ', AW, 'x', AH);
end;

destructor TWLWindow.Destroy;
begin
  if FContext <> nil then
    FContext.UnregisterWindow(Self);

  DestroyBuffer;

  if FToplevel <> nil then FreeAndNil(FToplevel);
  if FXdgSurface <> nil then FreeAndNil(FXdgSurface);
  if FSurface <> nil then FreeAndNil(FSurface);

  inherited;
end;

function TWLWindow.CreateAnonymousFile(ASize: PtrUInt): cint;
const
  O_CLOEXEC = $80000;
var
  Name: String;
  R: cint;
begin
  Name := GetEnvironmentVariable('XDG_RUNTIME_DIR');
  if Name = '' then
    Name := '/tmp';
  Name := Name + '/wlgui-shm-XXXXXX';

  R := fpOpen(PChar(Name), O_CREAT or O_RDWR or O_CLOEXEC, &0600);
  if R < 0 then
  begin
    Name := '/dev/shm/wlgui-shm-' + IntToStr(GetProcessID) +
            '-' + IntToStr(Random(100000));
    R := fpOpen(PChar(Name), O_CREAT or O_RDWR or O_CLOEXEC, &0600);
    if R < 0 then
      Exit(-1);
  end;

  fpUnlink(PChar(Name));

  if fpFtruncate(R, ASize) < 0 then
  begin
    fpClose(R);
    Exit(-1);
  end;

  Result := R;
end;

procedure TWLWindow.EnsureBuffer;
var
  Size: Integer;
  Data: Pointer;
begin
  if (FWidth <= 0) or (FHeight <= 0) then Exit;
  if FBuffer <> nil then Exit;

  FStride := FWidth * 4;
  Size := FStride * FHeight;

  FShmFd := CreateAnonymousFile(Size);
  if FShmFd < 0 then
    raise Exception.Create('TWLWindow: cannot create SHM file');

  Data := fpMmap(nil, Size, PROT_READ or PROT_WRITE, MAP_SHARED, FShmFd, 0);
  if Data = MAP_FAILED then
  begin
    fpClose(FShmFd);
    FShmFd := -1;
    raise Exception.Create('TWLWindow: cannot mmap SHM');
  end;

  FPixels := PByte(Data);
  FShmSize := Size;
  FillChar(FPixels^, Size, 0);

  FPool := FContext.Shm.CreatePool(FShmFd, Size);
  if FPool = nil then
    raise Exception.Create('TWLWindow: cannot create shm_pool');

  FBuffer := FPool.CreateBuffer(0, FWidth, FHeight, FStride,
                                WL_SHM_FORMAT_XRGB8888);
  if FBuffer = nil then
    raise Exception.Create('TWLWindow: cannot create wl_buffer');

  fpClose(FShmFd);
  FShmFd := -1;

  WriteLn('[wlgui] buffer created: ', FWidth, 'x', FHeight, ' stride=', FStride);
end;

procedure TWLWindow.DestroyBuffer;
begin
  if FBuffer <> nil then FreeAndNil(FBuffer);
  if FPool <> nil then FreeAndNil(FPool);
  if (FPixels <> nil) and (FShmSize > 0) then
  begin
    fpMunmap(FPixels, FShmSize);
    FPixels := nil;
    FShmSize := 0;
  end;
  if FShmFd >= 0 then
  begin
    fpClose(FShmFd);
    FShmFd := -1;
  end;
end;

procedure TWLWindow.InternalHandleToplevelConfigure(AW, AH: LongInt);
var
  Resized: Boolean;
begin
  Resized := False;
  if (AW > 0) and (AH > 0) and
     ((AW <> FWidth) or (AH <> FHeight)) then
  begin
    FWidth := AW;
    FHeight := AH;
    Resized := True;
    DestroyBuffer;
  end;
  if Resized and Assigned(OnResize) then
    OnResize(Self);
end;

procedure TWLWindow.InternalHandleConfigure(ASerial: DWord);
begin
  FXdgSurface.AckConfigure(ASerial);
  EnsureBuffer;
  FConfigured := True;
  if Assigned(OnConfigured) then
    OnConfigured(Self);
end;

procedure TWLWindow.InternalHandleClose;
begin
  FClosed := True;
  if Assigned(OnClose) then
    OnClose(Self)
  else
    FContext.Quit;
end;

procedure TWLWindow.Show;
begin
  FVisible := True;
  Commit;
end;

procedure TWLWindow.Hide;
begin
  FVisible := False;
  if FSurface <> nil then
  begin
    FSurface.Attach(nil, 0, 0);
    FSurface.Commit;
  end;
end;

procedure TWLWindow.Commit;
begin
  if (FSurface = nil) or (FBuffer = nil) then Exit;
  FSurface.Attach(FBuffer, 0, 0);
  FSurface.Damage(0, 0, FWidth, FHeight);
  FSurface.Commit;
  FContext.Display.Flush;
end;

procedure TWLWindow.Repaint;
begin
  if Assigned(OnPaint) then
    OnPaint(Self);
  Commit;
end;

procedure TWLWindow.Clear(AColor: TWLColor);
begin
  if FPixels = nil then Exit;
  FillRect(TRectI.New(0, 0, FWidth, FHeight), AColor);
end;

procedure TWLWindow.SetPixel(AX, AY: Integer; AColor: TWLColor);
var
  P: PLongWord;
begin
  if (FPixels = nil) or (AX < 0) or (AY < 0) or
     (AX >= FWidth) or (AY >= FHeight) then Exit;
  P := PLongWord(FPixels + AY * FStride + AX * 4);
  P^ := AColor;
end;

procedure TWLWindow.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;

  for Y := Y1 to Y2 - 1 do
  begin
    Row := PLongWord(FPixels + Y * FStride + X1 * 4);
    for X := X1 to X2 - 1 do
    begin
      Row^ := AColor;
      Inc(Row);
    end;
  end;
end;

end.

Правки в demo_window.pas

Меняем вызов App.CreateWindow на CreateWLWindow(App.Context, ...):
pascal

program demo_window;
{$mode objfpc}{$H+}

uses
  cthreads, SysUtils, Classes,
  wlgui_types, wlgui_context, wlgui_app, wlgui_window;

var
  MyApp: TWLApplication;
  Win: TWLWindow;
  Frame: Integer = 0;

procedure OnPaint(Sender: TObject);
var
  W: TWLWindow;
  T: Integer;
begin
  W := TWLWindow(Sender);
  if Frame mod 2 = 0 then
    W.Clear(TWLColor($00203050))
  else
    W.Clear(TWLColor($00305020));

  W.FillRect(TRectI.New(10, 10, W.Width - 20, 2), clWhite);
  W.FillRect(TRectI.New(10, W.Height - 12, W.Width - 20, 2), clWhite);
  W.FillRect(TRectI.New(10, 10, 2, W.Height - 20), clWhite);
  W.FillRect(TRectI.New(W.Width - 12, 10, 2, W.Height - 20), clWhite);

  T := (Frame * 4) mod (W.Width - 40);
  W.FillRect(TRectI.New(20 + T, W.Height div 2 - 20, 40, 40), clRed);

  W.FillRect(TRectI.New(W.Width div 2 - 40, W.Height div 2 - 1, 80, 2), clYellow);
  W.FillRect(TRectI.New(W.Width div 2 - 1, W.Height div 2 - 40, 2, 80), clYellow);
end;

procedure OnClose(Sender: TObject);
begin
  WriteLn('[demo] window closed');
  MyApp.Quit;
end;

var
  LastTick: QWord;

begin
  WriteLn('wlgui demo starting...');

  MyApp := TWLApplication.Create;
  try
    if not MyApp.Initialize then
    begin
      WriteLn('Failed to initialize Wayland');
      Halt(1);
    end;

    Win := CreateWLWindow(MyApp.Context,
                          'wlgui demo — moving red square', 640, 480);
    Win.OnPaint := @OnPaint;
    Win.OnClose := @OnClose;

    // Ждём configure
    MyApp.Display.Roundtrip;
    Win.Show;
    Win.Repaint;

    WriteLn('[demo] entering loop. Ctrl+C to exit.');

    LastTick := GetTickCount64;
    while MyApp.Running do
    begin
      MyApp.ProcessEvents;
      if GetTickCount64 - LastTick >= 33 then
      begin
        LastTick := GetTickCount64;
        Inc(Frame);
        Win.Repaint;
      end;
      Sleep(5);
    end;

    WriteLn('[demo] loop exited');
  finally
    MyApp.Free;
  end;

  WriteLn('[demo] done.');
end.

Итог

Цикл разорван через wlgui_context:
text

wayland_*  (не знают ни о чём выше)
   ▲
wlgui_types, wlgui_context  (не знают о window/app)
   ▲
wlgui_window  →  wlgui_context
wlgui_app     →  wlgui_context
demo_window   →  все три

Никаких forward-типов между модулями, никаких циклов. Собирай:
bash

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

Если что-то ещё всплывёт — покажи ошибку, поправим.
wlgui_app.pas(44,44) Error: Record or object type expected
wlgui_app.pas(44,45) Error: Unknown record field identifier "Running"

Опечатка в property Running: Boolean read FContext.Running; — FPC не разрешает читать свойство через цепочку объект.свойство в объявлении property. Нужен промежуточный getter.
Правка в wlgui_app.pas

Добавляем приватный метод:
pascal

  TWLApplication = class
  private
    FContext: TWLContext;
    FDisplay: TWlDisplay;
    FRegistry: TWlRegistry;
    FRegistryListener: TWLRegistryListener;
    FOwnsContext: Boolean;
    function GetRunning: Boolean;
  public
    ...
    property Running: Boolean read GetRunning;
  end;

И в implementation:
pascal

function TWLApplication.GetRunning: Boolean;
begin
  Result := FContext.Running;
end;

Полный исправленный wlgui_app.pas
pascal

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

interface

uses
  Classes, SysUtils,
  wayland_client_core, wayland_protocol, xdg_shell_protocol, wayland_util,
  wlgui_context;

type
  TWLApplication = class;

  TWLRegistryListener = class(TInterfacedObject, IWlRegistryListener)
  private
    FApp: TWLApplication;
  public
    constructor Create(AApp: TWLApplication);
    procedure wl_registry_global(AWlRegistry: TWlRegistry; AName: DWord;
      AInterface: String; AVersion: DWord);
    procedure wl_registry_global_remove(AWlRegistry: TWlRegistry; AName: DWord);
  end;

  TWLApplication = class
  private
    FContext: TWLContext;
    FDisplay: TWlDisplay;
    FRegistry: TWlRegistry;
    FRegistryListener: TWLRegistryListener;
    FOwnsContext: Boolean;
    function GetRunning: Boolean;
  public
    constructor Create;
    destructor Destroy; override;

    function Initialize: Boolean;
    procedure Finalize;
    procedure Run;
    procedure Quit;

    procedure ProcessEvents;

    property Context: TWLContext read FContext;
    property Display: TWlDisplay read FDisplay;
    property Running: Boolean read GetRunning;
  end;

var
  App: TWLApplication = nil;

implementation

constructor TWLRegistryListener.Create(AApp: TWLApplication);
begin
  inherited Create;
  FApp := AApp;
end;

procedure TWLRegistryListener.wl_registry_global(AWlRegistry: TWlRegistry;
  AName: DWord; AInterface: String; AVersion: DWord);
var
  Proxy: Pwl_proxy;
begin
  if AInterface = 'wl_compositor' then
  begin
    Proxy := AWlRegistry.Bind(AName, @wl_compositor_interface, AVersion);
    FApp.Context.Compositor := TWlCompositor.Create(Proxy);
  end
  else if AInterface = 'wl_shm' then
  begin
    Proxy := AWlRegistry.Bind(AName, @wl_shm_interface, AVersion);
    FApp.Context.Shm := TWlShm.Create(Proxy);
  end
  else if AInterface = 'xdg_wm_base' then
  begin
    Proxy := AWlRegistry.Bind(AName, @xdg_wm_base_interface, AVersion);
    FApp.Context.WmBase := TXdgWmBase.Create(Proxy);
  end
  else if AInterface = 'wl_subcompositor' then
  begin
    Proxy := AWlRegistry.Bind(AName, @wl_subcompositor_interface, AVersion);
    FApp.Context.Subcompositor := TWlSubcompositor.Create(Proxy);
  end
  else if AInterface = 'wl_seat' then
  begin
    Proxy := AWlRegistry.Bind(AName, @wl_seat_interface, AVersion);
    FApp.Context.Seat := TWlSeat.Create(Proxy);
  end
  else if AInterface = 'zwlr_layer_shell_v1' then
  begin
    WriteLn('[wlgui] layer-shell found, version ', AVersion);
  end;
end;

procedure TWLRegistryListener.wl_registry_global_remove(
  AWlRegistry: TWlRegistry; AName: DWord);
begin
end;

constructor TWLApplication.Create;
begin
  inherited Create;
  FContext := TWLContext.Create;
  FOwnsContext := True;
end;

destructor TWLApplication.Destroy;
var
  I: Integer;
begin
  if FContext <> nil then
  begin
    for I := FContext.Windows.Count - 1 downto 0 do
    begin
      try
        TObject(FContext.Windows[I]).Free;
      except
      end;
    end;
  end;

  Finalize;

  if FOwnsContext and (FContext <> nil) then
    FreeAndNil(FContext);

  inherited;
end;

function TWLApplication.GetRunning: Boolean;
begin
  Result := FContext.Running;
end;

function TWLApplication.Initialize: Boolean;
begin
  Result := False;
  FDisplay := TWlDisplay(TWlDisplay.Connect(''));
  if FDisplay = nil then
  begin
    WriteLn('[wlgui] Cannot connect to Wayland display');
    Exit;
  end;
  FContext.Display := FDisplay;

  FRegistry := FDisplay.GetRegistry;
  FRegistryListener := TWLRegistryListener.Create(Self);
  FRegistry.AddListener(FRegistryListener);

  FDisplay.Roundtrip;

  if (FContext.Compositor = nil) or (FContext.Shm = nil) or (FContext.WmBase = nil) then
  begin
    WriteLn('[wlgui] Required globals missing');
    Exit;
  end;

  WriteLn('[wlgui] Wayland initialized');
  Result := True;
end;

procedure TWLApplication.Finalize;
begin
  if FContext.Subcompositor <> nil then FreeAndNil(FContext.Subcompositor);
  if FContext.WmBase <> nil then FreeAndNil(FContext.WmBase);
  if FContext.Seat <> nil then FreeAndNil(FContext.Seat);
  if FContext.Shm <> nil then FreeAndNil(FContext.Shm);
  if FContext.Compositor <> nil then FreeAndNil(FContext.Compositor);
  if FRegistry <> nil then FreeAndNil(FRegistry);
  if FDisplay <> nil then
  begin
    FDisplay.Disconnect;
    FreeAndNil(FDisplay);
    FContext.Display := nil;
  end;
end;

procedure TWLApplication.ProcessEvents;
begin
  if FDisplay = nil then Exit;
  try
    FDisplay.DispatchPending;
    FDisplay.Flush;
  except
    on E: Exception do
      WriteLn('[wlgui] Event error: ', E.Message);
  end;
end;

procedure TWLApplication.Run;
begin
  FContext.IsRunning := True;
  WriteLn('[wlgui] Entering main loop');
  while FContext.Running do
  begin
    ProcessEvents;
    Sleep(10);
  end;
  WriteLn('[wlgui] Main loop exited');
end;

procedure TWLApplication.Quit;
begin
  FContext.Quit;
end;

initialization
  App := nil;

finalization
  if App <> nil then
    FreeAndNil(App);

end.

Собирай снова:
bash

fpc -Fu. -Fuwlgui demo_window.pas

Это классическая ошибка FPC — в property нельзя писать read SomeObject.SomeProperty, только read SomeField, read SomeGetter, read SomeIndex. В отличие от Delphi, где read FField.Prop тоже не работает, но сообщение другое.
demo_window.pas(58,20) Error: Incompatible types: got "<address of procedure(TObject);Register>" expected "<procedure variable type of procedure(TObject) of object;Register>"
demo_window.pas(59,20) Error: Incompatible types: got "<address of procedure(TObject);Register>" expected "<procedure variable type of procedure(TObject) of object;Register>"
Ошибка: TNotifyEvent требует метод объекта, а не процедуру

TNotifyEvent в FPC — это procedure(Sender: TObject) of object, то есть метод класса. А у нас OnPaint и OnClose — глобальные процедуры. Нужно либо:

    Сделать их методами какого-то класса (например, TForm-обёртки).

    Заменить тип callback-полей на обычный procedure(Sender: TObject).

Для простоты пойдём по пути №2 — определим в wlgui_types.pas собственный тип:
pascal

type
  TWLNotifyEvent = procedure(Sender: TObject);

И поменяем TNotifyEvent → TWLNotifyEvent в wlgui_window.pas.
Правки в wlgui_types.pas

Добавить в interface:
pascal

type
  TWLNotifyEvent = procedure(Sender: TObject);

Правки в wlgui_window.pas

Заменить все TNotifyEvent на TWLNotifyEvent:
pascal

  public
    OnClose: TWLNotifyEvent;
    OnResize: TWLNotifyEvent;
    OnPaint: TWLNotifyEvent;
    OnConfigured: TWLNotifyEvent;

И в uses — wlgui_types уже подключён, тип будет виден.
Правки в wlgui_context.pas

Тоже есть FOnQuit: TNotifyEvent — заменяем:
pascal

uses
  Classes, SysUtils, wlgui_types;

type
  TWLContext = class
  ...
  public
    property OnQuit: TWLNotifyEvent read FOnQuit write FOnQuit;
  ...
  end;

(поле FOnQuit: TWLNotifyEvent)
Что менять в demo_window.pas

Ничего — OnPaint := @OnPaint; теперь работает, потому что OnPaint — глобальная процедура procedure(Sender: TObject), и @OnPaint совместим с TWLNotifyEvent.
Альтернатива: сделать callback-и методами

Если ты предпочитаешь of object (что удобнее для будущего — обработчики в классе органайзера), можно оставить TNotifyEvent и сделать обработчики методами какого-то класса. Например:
pascal

type
  TDemoApp = class
    procedure OnPaint(Sender: TObject);
    procedure OnClose(Sender: TObject);
  end;

Но для теста проще TWLNotifyEvent.
Итог изменений

Три файла:
wlgui_types.pas — добавить тип
pascal

type
  TWLNotifyEvent = procedure(Sender: TObject);

wlgui_context.pas — использовать свой тип
pascal

uses
  Classes, SysUtils, wlgui_types;
...
  FOnQuit: TWLNotifyEvent;
...
  property OnQuit: TWLNotifyEvent read FOnQuit write FOnQuit;

wlgui_window.pas — заменить TNotifyEvent на TWLNotifyEvent
pascal

  public
    OnClose: TWLNotifyEvent;
    OnResize: TWLNotifyEvent;
    OnPaint: TWLNotifyEvent;
    OnConfigured: TWLNotifyEvent;

Собирай:
bash

fpc -Fu. -Fuwlgui demo_window.pas

Должно собраться. Если пойдут ещё ошибки такого рода — просто продолжай заменять TNotifyEvent на TWLNotifyEvent, где встретится.
Спасибо! Собралось. Запустил. Окна не видно, в консоле: ./demo_window
wlgui demo starting...
[wlgui] Wayland initialized
[wlgui] window created: "wlgui demo — moving red square" 640x480
interface 'xdg_toplevel' has no event 3
[demo] entering loop. Ctrl+C to exit.
Ошибка interface 'xdg_toplevel' has no event 3 — баг в xdg_shell_protocol.pas

Это не наша вина — это несоответствие версий. Посмотрим на факты:

    В xdg_shell_protocol.pas интерфейс xdg_toplevel объявлен с version := 2.

    При биндинге в wlgui_app.pas мы передаём AVersion — то, что предлагает композитор, обычно 6+.

    Композитор видит, что клиент запросил версию X, и присылает событие, которое в этой версии есть, но в нашем клиентском дескрипторе его нет.

Точнее: xdg_toplevel в v1 имел 2 события (configure, close). В v2 добавилось событие configure_bounds (event index 2). В v4 — wm_capabilities (event index 3). Сообщение «has no event 3» означает, что композитор попытался отправить нам событие с opcode=3, но в нашей таблице xdg_toplevel_events только 2 записи (configure, close).

Причина: мы забиндили xdg_toplevel с запрошенной версией, большей чем у нашего дескриптора, и композитор шлёт события, которых наш proxy-handler не знает.
Правильное решение

При биндинге всегда просить Min(версия_композитора, версия_нашего_дескриптора). Мы это делаем в wlgui_app.pas? Нет, мы передаём AVersion как есть. И в xdg_shell_protocol.pas для xdg_toplevel стоит version := 2, но мы просим больше.

Смотрим глубже — TXdgWmBase.GetXdgSurface:
pascal

function TXdgWmBase.GetXdgSurface(ASurface: TWlSurface; ...): TXdgSurface;
begin
  id := wl_proxy_marshal_constructor(FProxy,
      _GET_XDG_SURFACE, @xdg_surface_interface, nil, ASurface.Proxy);
  ...

При создании xdg_surface через маршаллинг наследуется версия parent proxy (xdg_wm_base). А xdg_wm_base мы забиндили с AVersion = то, что даёт композитор (6+). Значит xdg_surface получит тоже 6+. Аналогично xdg_toplevel получит версию от xdg_surface.

Итог: наш дескриптор xdg_toplevel знает только 2 события, а композитор шлёт события v4+.
Что делать

Способ 1 (правильный, архитектурный) — забиндить xdg_wm_base с Min(AVersion, 2), чтобы вся цепочка xdg_wm_base → xdg_surface → xdg_toplevel имела версию 2, и композитор не слал лишние события.
pascal

else if AInterface = 'xdg_wm_base' then
begin
  if AVersion > 2 then AVersion := 2;  // ← ограничиваем
  Proxy := AWlRegistry.Bind(AName, @xdg_wm_base_interface, AVersion);
  FApp.Context.WmBase := TXdgWmBase.Create(Proxy);
end

Но! В xdg_shell_protocol.pas xdg_wm_base_interface.version := 2 — значит, Bind должен передать версию, не превышающую дескриптор. Наш код передаёт AVersion (может быть 6), и wl_registry.bind создаёт proxy с версией 6, но наш handler прописан только на 2 события. Отсюда коллизия.

Правильная логика: версия биндинга = Min(версия_композитора, версия_нашего_дескриптора). Делаем это для всех глобалов.
Патч wlgui_app.pas

Заменяем wl_registry_global на такой:
pascal

procedure TWLRegistryListener.wl_registry_global(AWlRegistry: TWlRegistry;
  AName: DWord; AInterface: String; AVersion: DWord);
var
  Proxy: Pwl_proxy;
  V: DWord;
begin
  if AInterface = 'wl_compositor' then
  begin
    V := AVersion;
    if V > 4 then V := 4;  // наш дескриптор wl_compositor = 5, но обычно хватает 4
    Proxy := AWlRegistry.Bind(AName, @wl_compositor_interface, V);
    FApp.Context.Compositor := TWlCompositor.Create(Proxy);
  end
  else if AInterface = 'wl_shm' then
  begin
    V := AVersion;
    if V > 1 then V := 1;
    Proxy := AWlRegistry.Bind(AName, @wl_shm_interface, V);
    FApp.Context.Shm := TWlShm.Create(Proxy);
  end
  else if AInterface = 'xdg_wm_base' then
  begin
    // КРИТИЧНО: ограничиваем до 2 — наш дескриптор знает только v1/v2 события
    V := AVersion;
    if V > 2 then V := 2;
    Proxy := AWlRegistry.Bind(AName, @xdg_wm_base_interface, V);
    FApp.Context.WmBase := TXdgWmBase.Create(Proxy);
  end
  else if AInterface = 'wl_subcompositor' then
  begin
    V := AVersion;
    if V > 1 then V := 1;
    Proxy := AWlRegistry.Bind(AName, @wl_subcompositor_interface, V);
    FApp.Context.Subcompositor := TWlSubcompositor.Create(Proxy);
  end
  else if AInterface = 'wl_seat' then
  begin
    V := AVersion;
    if V > 5 then V := 5;  // наш дескриптор знает до 7, но события до 5
    Proxy := AWlRegistry.Bind(AName, @wl_seat_interface, V);
    FApp.Context.Seat := TWlSeat.Create(Proxy);
  end
  else if AInterface = 'zwlr_layer_shell_v1' then
  begin
    WriteLn('[wlgui] layer-shell found, version ', AVersion);
  end;
end;

Но это не всё — окно всё равно может не появиться

Причина вторая: окно не показывается, пока не будет AckConfigure + Attach + Commit. У нас это должно произойти в InternalHandleConfigure. Проверим, приходит ли xdg_surface.configure. Судя по логу — мы не видим ни buffer created, ни window created после configure. То есть xdg_surface.configure не приходит. Почему?

Скорее всего, композитор не может отправить configure из-за той самой ошибки has no event 3 — протокол сломался, соединение не работает как надо.
Ещё один важный момент — порядок Bind для wl_seat

В нашем дескрипторе wl_seat version=7, но события wl_seat определены только для 2 (capabilities, name). Всё ок.
Патч xdg_shell_protocol.pas — тоже важно

В xdg_shell_protocol.pas в initialization установлены версии:
pascal

xdg_wm_base_interface.version := 2;
xdg_surface_interface.version := 2;
xdg_toplevel_interface.version := 2;
xdg_popup_interface.version := 2;
xdg_positioner_interface.version := 2;

Это правильно для наших дескрипторов. Проблема была в том, что Bind передавал больше.

Однако есть тонкость: wl_registry.bind в wayland_client_core.pas вызывается с AVersion — как есть. Композитор создаёт proxy с этой версией, и прокси-объект внутри libwayland получает «version=6». Когда композитор отправляет событие #3 (для v4+), libwayland пытается его распарсить — и наш handler не имеет этого события. Если бы версия была 2, композитор бы не отправлял это событие вообще.

Итог: правильный Min() — обязателен.
Дополнительные проверки

Добавь отладочные WriteLn в TWLWindow.InternalHandleToplevelConfigure и InternalHandleConfigure:
pascal

procedure TWLWindow.InternalHandleToplevelConfigure(AW, AH: LongInt);
begin
  WriteLn('[wlgui] toplevel configure: ', AW, 'x', AH);
  ...
end;

procedure TWLWindow.InternalHandleConfigure(ASerial: DWord);
begin
  WriteLn('[wlgui] xdg_surface configure, serial=', ASerial);
  ...
end;

Если после патча Bind увидишь:
text

[wlgui] toplevel configure: 640x480
[wlgui] xdg_surface configure, serial=42
[wlgui] buffer created: 640x480 stride=2560

— всё работает, окно появится.
Собери и запусти
bash

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

Ожидаемый лог:
text

wlgui demo starting...
[wlgui] Wayland initialized
[wlgui] window created: "wlgui demo — moving red square" 640x480
[wlgui] toplevel configure: 640x480
[wlgui] xdg_surface configure, serial=NNN
[wlgui] buffer created: 640x480 stride=2560
[demo] entering loop. Ctrl+C to exit.

И окно с мигающим фоном и бегающим квадратом.

Если окно всё равно не появится — покажи лог, посмотрим дальше.
Спасибо! Мигающее окно с летящим квадратом появилось. Некоторое время работает, окно исчезает и появляется надпись про Broken pipe: ./demo_window
wlgui demo starting...
[wlgui] Wayland initialized
[wlgui] window created: "wlgui demo — moving red square" 640x480
[wlgui] buffer created: 640x480 stride=2560
[demo] entering loop. Ctrl+C to exit.
Error sending request for wl_surface.damage: Broken pipe
Broken pipe — классическая ошибка в Wayland: гонка буфера

Причина: мы перерисовываем буфер, пока композитор его ещё читает. Или точнее — мы повторно привязываем тот же wl_buffer, не дожидаясь wl_buffer.release, а иногда и перезаписываем pixel_data для буфера, который сейчас используется композитором.

Wayland явно требует:

    После wl_surface.commit с attach(buffer), клиент не должен менять содержимое буфера, пока не получит wl_buffer.release.

Мы это правило нарушаем: каждый кадр делаем Attach(FBuffer) + Damage + Commit, не слушая wl_buffer.release. В итоге libwayland-клиент может отправить запрос в момент, когда соединение уже развалилось (композитор закрыл окно / приостановил приём) — и мы видим «Broken pipe».

Есть две отдельные проблемы, которые наслаиваются:
Проблема A. Нет wl_buffer.release listener

Каждый wl_buffer должен иметь listener с методом release. Композитор присылает release, когда буфер больше не нужен. До этого мы не имеем права переиспользовать буфер.
Проблема B. Один буфер и «damage 0,0,W,H» каждый кадр

Мы делаем Attach+Commit каждый кадр с тем же буфером. Композитор может копить эти коммиты, и libwayland-клиент переполняет очередь (backpressure). При 30 fps и 640×480 — не должно бы, но при отрисовке в цикле без пауз — запросто.
Решение: двойная буферизация + wl_buffer.release

Правильный подход для анимации — два буфера (double buffering). Пока композитор показывает буфер A, мы рисуем в буфер B. Когда он отпускает A — переключаемся.

Плюс — wl_buffer.release listener.
Патч wlgui_window.pas

Добавим listener для wl_buffer:
pascal

type
  TWLBufferListener = class(TInterfacedObject, IWlBufferListener)
  private
    FWindow: TWLWindow;
  public
    constructor Create(AWindow: TWLWindow);
    procedure wl_buffer_release(AWlBuffer: TWlBuffer);
  end;

В TWLWindow:
pascal

  TWLWindow = class
  private
    ...
    // Двойная буферизация
    FBuffers: array[0..1] of record
      Buffer: TWlBuffer;
      Pool: TWlShmPool;
      Pixels: PByte;
      Fd: cint;
      Size: Integer;
      Released: Boolean;
    end;
    FBackIndex: Integer;   // какой буфер рисуем сейчас
    FBufferListener: array[0..1] of TWLBufferListener;
    ...

Это громоздко. Давай сделаем через маленький вспомогательный record/класс TWLShmBuffer, чтобы код читался.
Отдельный класс TWLShmBuffer (внутри wlgui_window.pas)
pascal

type
  TWLShmBuffer = class
  private
    FOwner: TWLWindow;
    FBuffer: TWlBuffer;
    FPool: TWlShmPool;
    FPixels: PByte;
    FFd: cint;
    FSize: Integer;
    FStride: Integer;
    FWidth, FHeight: Integer;
    FReleased: Boolean;
    FListener: TWLBufferListener;
    function CreateAnonymousFile(ASize: PtrUInt): cint;
  public
    constructor Create(AOwner: TWLWindow; AContext: TWLContext;
                       AW, AH: Integer);
    destructor Destroy; override;
    procedure MarkBusy;     // отправлен композитору
    procedure MarkReleased; // получен release
    property Buffer: TWlBuffer read FBuffer;
    property Pixels: PByte read FPixels;
    property Stride: Integer read FStride;
    property Released: Boolean read FReleased;
    property Width: Integer read FWidth;
    property Height: Integer read FHeight;
  end;

И в TWLWindow:
pascal

  private
    FBuffers: array[0..1] of TWLShmBuffer;
    FDrawIndex: Integer;   // индекс буфера, в который рисуем

Логика:

    EnsureBuffers — создаём два TWLShmBuffer.

    Commit — берём FBuffers[FDrawIndex], Attach, Damage, Commit, MarkBusy, переключаем FDrawIndex := 1 - FDrawIndex.

    В OnBufferRelease (вызывается listener'ом) — MarkReleased соответствующего буфера.

    Перед рисованием нового кадра — выбираем буфер, который released (или оба released — берём другой от текущего).

Минимальный, но правильный вариант

Чтобы не раздувать код, сделаю более компактно:

    Оставляю один TWLShmBuffer-класс.

    Массив из 2 буферов.

    В Commit — ждём освободившийся буфер.

    Если оба заняты — пропускаем кадр (не рисуем в занятый, не коммитим).

Это стандартный подход в Wayland-анимациях.
Полный патч wlgui_window.pas

Вот новая версия модуля целиком (убрал лишнее, добавил двойную буферизацию и release-listener):
pascal

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

interface

uses
  Classes, SysUtils, BaseUnix,
  wayland_client_core, wayland_protocol, xdg_shell_protocol, wayland_util,
  wlgui_types, wlgui_context;

type
  TWLWindow = class;

  { --- wl_buffer.release listener --- }
  TWLBufferListener = class(TInterfacedObject, IWlBufferListener)
  private
    FWindow: TWLWindow;
    FIndex: Integer;
  public
    constructor Create(AWindow: TWLWindow; AIndex: Integer);
    procedure wl_buffer_release(AWlBuffer: TWlBuffer);
  end;

  { --- xdg_surface.configure --- }
  TWLXdgSurfaceListener = class(TInterfacedObject, IXdgSurfaceListener)
  private
    FWindow: TWLWindow;
  public
    constructor Create(AWindow: TWLWindow);
    procedure xdg_surface_configure(AXdgSurface: TXdgSurface; ASerial: DWord);
  end;

  { --- xdg_toplevel.configure / close --- }
  TWLXdgToplevelListener = class(TInterfacedObject, IXdgToplevelListener)
  private
    FWindow: TWLWindow;
  public
    constructor Create(AWindow: TWLWindow);
    procedure xdg_toplevel_configure(AXdgToplevel: TXdgToplevel;
      AWidth: LongInt; AHeight: LongInt; AStates: Pwl_array);
    procedure xdg_toplevel_close(AXdgToplevel: TXdgToplevel);
  end;

  { --- Один SHM-буфер --- }
  TWLShmBuffer = class
  private
    FBuffer: TWlBuffer;
    FPool: TWlShmPool;
    FPixels: PByte;
    FShmFd: cint;
    FShmSize: Integer;
    FStride: Integer;
    FWidth, FHeight: Integer;
    FReleased: Boolean;
    FListener: TWLBufferListener;
    function CreateAnonymousFile(ASize: PtrUInt): cint;
  public
    constructor Create(AContext: TWLContext; AOwner: TWLWindow;
                       AW, AH, AIndex: Integer);
    destructor Destroy; override;
    procedure MarkBusy;
    procedure MarkReleased;
    property Buffer: TWlBuffer read FBuffer;
    property Pixels: PByte read FPixels;
    property Stride: Integer read FStride;
    property Width: Integer read FWidth;
    property Height: Integer read FHeight;
    property Released: Boolean read FReleased;
  end;

  { --- Окно --- }
  TWLWindow = class
  private
    FContext: TWLContext;
    FSurface: TWlSurface;
    FXdgSurface: TXdgSurface;
    FToplevel: TXdgToplevel;

    FBuffers: array[0..1] of TWLShmBuffer;
    FDrawIndex: Integer;

    FWidth, FHeight: Integer;
    FConfigured: Boolean;
    FVisible: Boolean;
    FClosed: Boolean;
    FTitle: String;

    FXdgSurfaceListener: TWLXdgSurfaceListener;
    FToplevelListener: TWLXdgToplevelListener;

    procedure EnsureBuffers;
    procedure DestroyBuffers;

    procedure InternalHandleConfigure(ASerial: DWord);
    procedure InternalHandleToplevelConfigure(AW, AH: LongInt);
    procedure InternalHandleClose;
  public
    OnClose: TWLNotifyEvent;
    OnResize: TWLNotifyEvent;
    OnPaint: TWLNotifyEvent;
    OnConfigured: TWLNotifyEvent;

    constructor Create(AContext: TWLContext; const ATitle: String;
                       AW, AH: Integer);
    destructor Destroy; override;

    procedure Show;
    procedure Hide;
    procedure Commit;
    procedure Repaint;

    // Возвращает указатель на пиксели буфера для рисования, или nil если
    // нет свободного буфера (тогда кадр надо пропустить).
    function BeginPaint: PByte;
    // Отправляет заполненный буфер композитору.
    procedure EndPaint;

    procedure Clear(AColor: TWLColor);
    procedure SetPixel(AX, AY: Integer; AColor: TWLColor);
    procedure FillRect(const ARect: TRectI; AColor: TWLColor);

    property Width: Integer read FWidth;
    property Height: Integer read FHeight;
    property Configured: Boolean read FConfigured;
    property Visible: Boolean read FVisible;
    property Closed: Boolean read FClosed;
    property Title: String read FTitle;
    property Surface: TWlSurface read FSurface;
    property XdgSurface: TXdgSurface read FXdgSurface;
    property Toplevel: TXdgToplevel read FToplevel;
    property Context: TWLContext read FContext;
    property DrawIndex: Integer read FDrawIndex;
  end;

function CreateWLWindow(AContext: TWLContext; const ATitle: String;
                        AW, AH: Integer): TWLWindow;

implementation

function CreateWLWindow(AContext: TWLContext; const ATitle: String;
                        AW, AH: Integer): TWLWindow;
begin
  Result := TWLWindow.Create(AContext, ATitle, AW, AH);
end;

{ ============================================================ }
{  TWLBufferListener                                            }
{ ============================================================ }

constructor TWLBufferListener.Create(AWindow: TWLWindow; AIndex: Integer);
begin
  inherited Create;
  FWindow := AWindow;
  FIndex := AIndex;
end;

procedure TWLBufferListener.wl_buffer_release(AWlBuffer: TWlBuffer);
begin
  if (FWindow <> nil) and (FIndex >= 0) and (FIndex <= 1) then
    if FWindow.FBuffers[FIndex] <> nil then
      FWindow.FBuffers[FIndex].MarkReleased;
end;

{ ============================================================ }
{  TWLXdgSurfaceListener                                        }
{ ============================================================ }

constructor TWLXdgSurfaceListener.Create(AWindow: TWLWindow);
begin
  inherited Create;
  FWindow := AWindow;
end;

procedure TWLXdgSurfaceListener.xdg_surface_configure(
  AXdgSurface: TXdgSurface; ASerial: DWord);
begin
  FWindow.InternalHandleConfigure(ASerial);
end;

{ ============================================================ }
{  TWLXdgToplevelListener                                       }
{ ============================================================ }

constructor TWLXdgToplevelListener.Create(AWindow: TWLWindow);
begin
  inherited Create;
  FWindow := AWindow;
end;

procedure TWLXdgToplevelListener.xdg_toplevel_configure(
  AXdgToplevel: TXdgToplevel;
  AWidth: LongInt; AHeight: LongInt; AStates: Pwl_array);
begin
  FWindow.InternalHandleToplevelConfigure(AWidth, AHeight);
end;

procedure TWLXdgToplevelListener.xdg_toplevel_close(
  AXdgToplevel: TXdgToplevel);
begin
  FWindow.InternalHandleClose;
end;

{ ============================================================ }
{  TWLShmBuffer                                                 }
{ ============================================================ }

function TWLShmBuffer.CreateAnonymousFile(ASize: PtrUInt): cint;
const
  O_CLOEXEC = $80000;
var
  Name: String;
  R: cint;
begin
  Name := GetEnvironmentVariable('XDG_RUNTIME_DIR');
  if Name = '' then Name := '/tmp';
  Name := Name + '/wlgui-shm-XXXXXX';
  R := fpOpen(PChar(Name), O_CREAT or O_RDWR or O_CLOEXEC, &0600);
  if R < 0 then
  begin
    Name := '/dev/shm/wlgui-shm-' + IntToStr(GetProcessID) +
            '-' + IntToStr(Random(1000000));
    R := fpOpen(PChar(Name), O_CREAT or O_RDWR or O_CLOEXEC, &0600);
    if R < 0 then Exit(-1);
  end;
  fpUnlink(PChar(Name));
  if fpFtruncate(R, ASize) < 0 then
  begin
    fpClose(R);
    Exit(-1);
  end;
  Result := R;
end;

constructor TWLShmBuffer.Create(AContext: TWLContext; AOwner: TWLWindow;
                                AW, AH, AIndex: Integer);
var
  Size: Integer;
  Data: Pointer;
begin
  inherited Create;
  FWidth := AW;
  FHeight := AH;
  FStride := AW * 4;
  Size := FStride * AH;
  FReleased := True;
  FShmFd := -1;
  FShmSize := 0;
  FBuffer := nil;
  FPool := nil;
  FPixels := nil;

  FShmFd := CreateAnonymousFile(Size);
  if FShmFd < 0 then
    raise Exception.Create('TWLShmBuffer: cannot create SHM file');

  Data := fpMmap(nil, Size, PROT_READ or PROT_WRITE, MAP_SHARED, FShmFd, 0);
  if Data = MAP_FAILED then
  begin
    fpClose(FShmFd);
    FShmFd := -1;
    raise Exception.Create('TWLShmBuffer: cannot mmap SHM');
  end;

  FPixels := PByte(Data);
  FShmSize := Size;
  FillChar(FPixels^, Size, 0);

  FPool := AContext.Shm.CreatePool(FShmFd, Size);
  if FPool = nil then
    raise Exception.Create('TWLShmBuffer: cannot create pool');

  FBuffer := FPool.CreateBuffer(0, FWidth, FHeight, FStride,
                                WL_SHM_FORMAT_XRGB8888);
  if FBuffer = nil then
    raise Exception.Create('TWLShmBuffer: cannot create buffer');

  // release listener
  FListener := TWLBufferListener.Create(AOwner, AIndex);
  FBuffer.AddListener(FListener);

  fpClose(FShmFd);
  FShmFd := -1;
end;

destructor TWLShmBuffer.Destroy;
begin
  if FBuffer <> nil then FreeAndNil(FBuffer);
  if FPool <> nil then FreeAndNil(FPool);
  if (FPixels <> nil) and (FShmSize > 0) then
  begin
    fpMunmap(FPixels, FShmSize);
    FPixels := nil;
  end;
  if FShmFd >= 0 then
  begin
    fpClose(FShmFd);
    FShmFd := -1;
  end;
  inherited;
end;

procedure TWLShmBuffer.MarkBusy;
begin
  FReleased := False;
end;

procedure TWLShmBuffer.MarkReleased;
begin
  FReleased := True;
end;

{ ============================================================ }
{  TWLWindow                                                    }
{ ============================================================ }

constructor TWLWindow.Create(AContext: TWLContext;
                             const ATitle: String; AW, AH: Integer);
begin
  inherited Create;

  FContext := AContext;
  FTitle := ATitle;
  FWidth := AW;
  FHeight := AH;
  FConfigured := False;
  FVisible := False;
  FClosed := False;
  FDrawIndex := 0;
  FBuffers[0] := nil;
  FBuffers[1] := nil;

  if (AContext = nil) or (AContext.Compositor = nil) or (AContext.WmBase = nil) then
    raise Exception.Create('TWLWindow: context not initialized');

  FSurface := AContext.Compositor.CreateSurface;
  if FSurface = nil then
    raise Exception.Create('TWLWindow: cannot create surface');

  FXdgSurface := AContext.WmBase.GetXdgSurface(FSurface);
  if FXdgSurface = nil then
    raise Exception.Create('TWLWindow: cannot create xdg_surface');

  FXdgSurfaceListener := TWLXdgSurfaceListener.Create(Self);
  FXdgSurface.AddListener(FXdgSurfaceListener);

  FToplevel := FXdgSurface.GetToplevel;
  if FToplevel = nil then
    raise Exception.Create('TWLWindow: cannot create xdg_toplevel');

  FToplevelListener := TWLXdgToplevelListener.Create(Self);
  FToplevel.AddListener(FToplevelListener);

  if ATitle <> '' then
    FToplevel.SetTitle(ATitle);
  FToplevel.SetAppId('wlgui.app');

  if (AW > 0) and (AH > 0) then
  begin
    FToplevel.SetMinSize(AW, AH);
    FToplevel.SetMaxSize(AW, AH);
  end;

  AContext.RegisterWindow(Self);

  FSurface.Commit;

  WriteLn('[wlgui] window created: "', ATitle, '" ', AW, 'x', AH);
end;

destructor TWLWindow.Destroy;
begin
  if FContext <> nil then
    FContext.UnregisterWindow(Self);

  DestroyBuffers;

  if FToplevel <> nil then FreeAndNil(FToplevel);
  if FXdgSurface <> nil then FreeAndNil(FXdgSurface);
  if FSurface <> nil then FreeAndNil(FSurface);

  inherited;
end;

procedure TWLWindow.EnsureBuffers;
begin
  if FBuffers[0] <> nil then Exit;
  if (FWidth <= 0) or (FHeight <= 0) then Exit;

  FBuffers[0] := TWLShmBuffer.Create(FContext, Self, FWidth, FHeight, 0);
  FBuffers[1] := TWLShmBuffer.Create(FContext, Self, FWidth, FHeight, 1);
  FDrawIndex := 0;

  WriteLn('[wlgui] 2 buffers created: ', FWidth, 'x', FHeight,
          ' stride=', FBuffers[0].Stride);
end;

procedure TWLWindow.DestroyBuffers;
begin
  if FBuffers[0] <> nil then FreeAndNil(FBuffers[0]);
  if FBuffers[1] <> nil then FreeAndNil(FBuffers[1]);
end;

procedure TWLWindow.InternalHandleToplevelConfigure(AW, AH: LongInt);
var
  Resized: Boolean;
begin
  Resized := False;
  if (AW > 0) and (AH > 0) and
     ((AW <> FWidth) or (AH <> FHeight)) then
  begin
    FWidth := AW;
    FHeight := AH;
    Resized := True;
    DestroyBuffers;
  end;
  if Resized and Assigned(OnResize) then
    OnResize(Self);
end;

procedure TWLWindow.InternalHandleConfigure(ASerial: DWord);
begin
  FXdgSurface.AckConfigure(ASerial);
  EnsureBuffers;
  FConfigured := True;
  if Assigned(OnConfigured) then
    OnConfigured(Self);
end;

procedure TWLWindow.InternalHandleClose;
begin
  FClosed := True;
  if Assigned(OnClose) then
    OnClose(Self)
  else
    FContext.Quit;
end;

procedure TWLWindow.Show;
begin
  FVisible := True;
  // ничего дополнительно — поверхность уже commit'нута при создании
end;

procedure TWLWindow.Hide;
begin
  FVisible := False;
  if FSurface <> nil then
  begin
    FSurface.Attach(nil, 0, 0);
    FSurface.Commit;
    FContext.Display.Flush;
  end;
end;

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

  // Ищем свободный буфер, начиная с FDrawIndex
  Tries := 0;
  Idx := FDrawIndex;
  while Tries < 2 do
  begin
    if FBuffers[Idx].Released then
    begin
      Result := FBuffers[Idx].Pixels;
      FDrawIndex := Idx;
      Exit;
    end;
    Idx := 1 - Idx;
    Inc(Tries);
  end;
  // оба заняты — кадр пропускаем
end;

procedure TWLWindow.EndPaint;
var
  B: TWLShmBuffer;
begin
  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;

procedure TWLWindow.Commit;
begin
  // Оставлен для совместимости: если буфер уже нарисован — не трогаем
  EndPaint;
end;

procedure TWLWindow.Repaint;
begin
  if Assigned(OnPaint) then
    OnPaint(Self);
  EndPaint;
end;

procedure TWLWindow.Clear(AColor: TWLColor);
begin
  FillRect(TRectI.New(0, 0, FWidth, FHeight), AColor);
end;

procedure TWLWindow.SetPixel(AX, AY: Integer; AColor: TWLColor);
var
  P: PLongWord;
  B: TWLShmBuffer;
begin
  if (FBuffers[FDrawIndex] = nil) then Exit;
  B := FBuffers[FDrawIndex];
  if (AX < 0) or (AY < 0) or (AX >= FWidth) or (AY >= FHeight) then Exit;
  P := PLongWord(B.Pixels + AY * B.Stride + AX * 4);
  P^ := AColor;
end;

procedure TWLWindow.FillRect(const ARect: TRectI; AColor: TWLColor);
var
  X1, Y1, X2, Y2, Y, X: Integer;
  Row: PLongWord;
  B: TWLShmBuffer;
begin
  if FBuffers[FDrawIndex] = nil then Exit;
  B := FBuffers[FDrawIndex];

  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;

  for Y := Y1 to Y2 - 1 do
  begin
    Row := PLongWord(B.Pixels + Y * B.Stride + X1 * 4);
    for X := X1 to X2 - 1 do
    begin
      Row^ := AColor;
      Inc(Row);
    end;
  end;
end;

end.

Патч demo_window.pas

Меняем цикл — теперь Repaint вызывает OnPaint и EndPaint. Но если оба буфера заняты, BeginPaint вернёт nil, а FillRect молча ничего не сделает — кадр пропустится. Это нормально.

Демо-код:
pascal

procedure OnPaint(Sender: TObject);
var
  W: TWLWindow;
  T: Integer;
begin
  W := TWLWindow(Sender);
  if W.BeginPaint = nil then Exit;   // нет свободного буфера — пропускаем кадр

  if Frame mod 2 = 0 then
    W.Clear(TWLColor($00203050))
  else
    W.Clear(TWLColor($00305020));

  W.FillRect(TRectI.New(10, 10, W.Width - 20, 2), clWhite);
  W.FillRect(TRectI.New(10, W.Height - 12, W.Width - 20, 2), clWhite);
  W.FillRect(TRectI.New(10, 10, 2, W.Height - 20), clWhite);
  W.FillRect(TRectI.New(W.Width - 12, 10, 2, W.Height - 20), clWhite);

  T := (Frame * 4) mod (W.Width - 40);
  W.FillRect(TRectI.New(20 + T, W.Height div 2 - 20, 40, 40), clRed);

  W.FillRect(TRectI.New(W.Width div 2 - 40, W.Height div 2 - 1, 80, 2), clYellow);
  W.FillRect(TRectI.New(W.Width div 2 - 1, W.Height div 2 - 40, 2, 80), clYellow);
  // EndPaint вызовется автоматически в W.Repaint
end;

Про «окно исчезает и Broken pipe»

В твоём случае, скорее всего, произошло следующее:

    Композитор закрыл окно по какой-то причине (или сессия потеряла соединение).

    libwayland отправил запрос в закрытый сокет.

    Пришёл EPIPE, клиент падает с «Broken pipe».

С двумя буферами и wl_buffer.release мы сильно снижаем риск переполнения. Но полностью от Broken pipe не застрахованы — если композитор решит закрыть окно, следующий запрос всё равно упадёт.
Дополнительная защита: обработать wl_display.error

Хорошо бы добавить listener на wl_display и не продолжать цикл, если пришла ошибка:
pascal

type
  TWLDisplayListener = class(TInterfacedObject, IWlDisplayListener)
  public
    procedure wl_display_error(AWlDisplay: TWlDisplay; AObjectId: Pointer;
      ACode: DWord; AMessage: String);
    procedure wl_display_delete_id(AWlDisplay: TWlDisplay; AId: DWord);
  end;

procedure TWLDisplayListener.wl_display_error(...);
begin
  WriteLn('[wlgui] display error: ', AMessage);
  if App <> nil then App.Quit;
end;

И добавить в TWLApplication.Initialize:
pascal

FDisplayListener := TWLDisplayListener.Create;
FDisplay.AddListener(FDisplayListener);

Это не спасёт от EPIPE (это происходит на уровне сокета), но хотя бы мы узнаем, если композитор что-то не так понял.
Про падение через какое-то время

Ещё одна возможная причина — наш Sleep(5) + 30 fps дают нестабильный тайминг, и раз в N секунд композитор отправляет wl_buffer.release не вовремя. С wl_buffer.release listener'ом буферы будут корректно освобождаться.

Попробуй патч, покажи, что в логе. Если снова «Broken pipe», добавим обработчик ошибок wl_display.
Собираем
bash

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

Если всё правильно — окно будет работать долго и стабильно, без падений.
Окно появилось. Квадрат в левой стороне и не движется, окно не мигает. Со временем окно не исчезает и корректно закрывается по Ctrl+C. Окно можно успешно перетаскивать за содержимое. ./demo_window
wlgui demo starting...
[wlgui] Wayland initialized
[wlgui] window created: "wlgui demo — moving red square" 640x480
[wlgui] 2 buffers created: 640x480 stride=2560
[demo] entering loop. Ctrl+C to exit.
^C
Отлично, окно стабильно! Но анимации нет — есть 3 причины
Причина 1: не приходит wl_buffer.release

Мы ни разу не увидели, чтобы рисование повторилось. В логе после «2 buffers created» — тишина. Причина: wl_buffer.release не приходит, потому что... мы отправляем Commit с Attach один раз, и этого достаточно композитору.

Проблема в другом. Смотрим OnPaint:
pascal

if W.BeginPaint = nil then Exit;

BeginPaint возвращает nil, если оба буфера заняты. После первого кадра:

    FBuffers[0].Released = False (мы её Attach-нули, MarkBusy)

    FBuffers[1].Released = True — свободна

Значит второй BeginPaint должен вернуть указатель на буфер 1. Но потом происходит EndPaint, который проверяет:
pascal

B := FBuffers[FDrawIndex];
if not B.Released then Exit;  // защита

Тут всё ок. Смотрим дальше: Repaint вызывает OnPaint и EndPaint. OnPaint начал с BeginPaint — FDrawIndex теперь 0 или 1. EndPaint берёт FDrawIndex, Attach, MarkBusy, переключает FDrawIndex := 1 - FDrawIndex.

Стоп. А как мы рисуем? W.FillRect и W.Clear внутри OnPaint тоже используют FBuffers[FDrawIndex]. Но BeginPaint уже выбрал FDrawIndex — и не менял его. Значит рисование идёт в тот же буфер, который EndPaint потом Attach-нет. Хорошо.
Но почему не двигается?

Смотрим внимательнее. После первого Repaint:

    FDrawIndex был 0.

    BeginPaint вернул указатель буфера 0.

    Рисуем в буфер 0.

    EndPaint взял буфер 0, Attach, MarkBusy(0), FDrawIndex := 1.

Второй Repaint:

    BeginPaint: Idx = 1, FBuffers[1].Released = True (никогда не отправлялся) → возвращает буфер 1, FDrawIndex := 1.

    Рисуем в буфер 1.

    EndPaint: берёт буфер 1, Attach, MarkBusy(1), FDrawIndex := 0.

Третий Repaint:

    BeginPaint: Idx = 0, FBuffers[0].Released = False → Idx := 1, FBuffers[1].Released = False → оба заняты, возвращает nil.

    OnPaint делает Exit.

    EndPaint: берёт FBuffers[FDrawIndex] = FBuffers[0], Released = False → Exit.

И так навсегда. Оба буфера заняты, потому что wl_buffer.release не приходит. Значит listener не вызывается.
Почему не вызывается wl_buffer.release

Смотрим TWLBufferListener.Create(AOwner, AIndex) в TWLShmBuffer.Create. И потом:
pascal

FListener := TWLBufferListener.Create(AOwner, AIndex);
FBuffer.AddListener(FListener);

Ага, вот баг. FBuffer.AddListener в wayland_protocol.pas делает:
pascal

function TWlBuffer.AddListener(AIntf: IWlBufferListener): LongInt;
begin
  FUserDataRec.ListenerUserData := Pointer(AIntf);
  Result := wl_proxy_add_listener(FProxy, @vIntf_wl_buffer_Listener, @FUserDataRec);
end;

Обрати внимание: Pointer(AIntf) — это сырой указатель на интерфейс, который в FPC (в режиме corba) — указатель на vtable. А @FUserDataRec — указатель на запись внутри TWLProxyObject. Всё правильно, но...

Проблема: FUserDataRec — это запись TWLUserData, и у неё есть поле PascalObject. При создании TWLProxyObject.Create(AProxy):
pascal

FUserDataRec.PascalObject := Self;
FProxy := AProxy;
if Assigned(FProxy) then
  wl_proxy_set_user_data(FProxy, @FUserDataRec);

Теперь в wl_buffer_release_Intf (wayland_protocol.pas):
pascal

procedure wl_buffer_release_Intf(AData: PWLUserData; Awl_buffer: Pwl_buffer); cdecl;
var
  AIntf: IWlBufferListener;
begin
  if AData = nil then Exit;
  AIntf := IWlBufferListener(AData^.ListenerUserData);
  AIntf.wl_buffer_release(TWlBuffer(AData^.PascalObject));
end;

Всё выглядит корректно. Тогда почему release не вызывается?
Причина 2: мы не вызываем DispatchPending достаточно часто

Смотрим цикл:
pascal

while MyApp.Running do
begin
  MyApp.ProcessEvents;   // DispatchPending + Flush
  if GetTickCount64 - LastTick >= 33 then
  begin
    ...
    Win.Repaint;
  end;
  Sleep(5);
end;

DispatchPending не блокирует — он обрабатывает только те события, которые уже в очереди. wl_buffer.release приходит в сокет. Если мы не блокируемся в poll() — событие может ещё не быть прочитано. Но Flush отправляет наши запросы, а DispatchPending — забирает пришедшие.

Хм, но DispatchPending должен всё-таки прочитать то, что уже пришло. Проблема в том, что мы не даём libwayland возможности прочитать сокет — DispatchPending не делает read() с блокировкой, он использует уже прочитанные данные. Но кто их читает? Dispatch (блокирующий) или wl_display_read_events после prepare_read.

Вот и причина №2: DispatchPending без Dispatch не работает как ожидается в цикле с Sleep.

Правильный event loop в Wayland:
pascal

// 1. Подготовиться к чтению
if wl_display_prepare_read(display) <> 0 then
begin
  // есть уже готовые события — обрабатываем без poll
  wl_display_dispatch_pending(display);
  wl_display_flush(display);
  continue;
end;
wl_display_flush(display);

// 2. poll с таймаутом
poll(fd, ..., timeout);

// 3. Прочитать события
if (revents and POLLIN) <> 0 then
  wl_display_read_events(display)
else
  wl_display_cancel_read(display);

// 4. Обработать
wl_display_dispatch_pending(display);

Или проще — использовать блокирующий wl_display_dispatch и таймер через poll с timeout. Но это сложнее встроить в текущий цикл.

Самое простое решение: раз в N миллисекунд делать wl_display_roundtrip — он принудительно прочитает всё из сокета и обработает. Roundtrip — блокирующий, но для теста сойдёт.
Причина 3: wl_display.dispatch не вызывается

Простейший фикс — добавить блокирующий wl_display.Dispatch в цикл, но с ограничением по времени. Или использовать wl_display.Roundtrip периодически.
Патч: исправляем event loop

Меняем цикл в demo_window.pas:
pascal

LastTick := GetTickCount64;
while MyApp.Running do
begin
  // Блокирующий dispatch — гарантирует чтение из сокета
  // Timeout реализуем через roundtrip раз в 16ms
  MyApp.Display.DispatchPending;
  MyApp.Display.Flush;

  // Периодически делаем roundtrip — гарантированно читает release
  if GetTickCount64 - LastTick >= 16 then
  begin
    MyApp.Display.Roundtrip;   // ← заставит обработать входящие
    LastTick := GetTickCount64;
    Inc(Frame);
    Win.Repaint;
  end;

  Sleep(1);
end;

Но Roundtrip — блокирующий, он ждёт ответа от композитора. При 60 fps это нормально, но при отсутствии событий — может залипнуть. Лучше такой паттерн:

Патч в wlgui_context.pas — добавить правильный event loop helper:
pascal

function TWLContext.DispatchWithTimeout(ATimeoutMs: Integer): Boolean;
var
  Fd: cint;
  Pfd: TPollfd;
  Ret: Integer;
begin
  Result := False;
  if FDisplay = nil then Exit;

  // Если есть уже готовые события — обрабатываем их
  if wl_display_prepare_read(FDisplay) <> 0 then
  begin
    wl_display_dispatch_pending(FDisplay);
    wl_display_flush(FDisplay);
    Exit(True);
  end;

  Fd := wl_display_get_fd(FDisplay);

  // Отправляем всё что накопилось
  if wl_display_flush(FDisplay) < 0 then
  begin
    wl_display_cancel_read(FDisplay);
    Exit(False);
  end;

  // Ждём событий
  Pfd.fd := Fd;
  Pfd.events := POLLIN;
  Pfd.revents := 0;
  Ret := fpPoll(@Pfd, 1, ATimeoutMs);

  if (Ret > 0) and ((Pfd.revents and POLLIN) <> 0) then
  begin
    wl_display_read_events(FDisplay);
    wl_display_dispatch_pending(FDisplay);
    Result := True;
  end
  else
  begin
    wl_display_cancel_read(FDisplay);
    wl_display_dispatch_pending(FDisplay);
    wl_display_flush(FDisplay);
  end;
end;

Но wl_display_prepare_read объявлен в wayland_client_core.pas как внешняя функция. Проверим... да, есть:
pascal

function  wl_display_prepare_read(display :Pwl_display): cint; cdecl; external;
procedure wl_display_cancel_read(display :Pwl_display); cdecl; external;
function  wl_display_read_events(display :Pwl_display): cint; cdecl; external;

И fpPoll — в BaseUnix.
Ещё одно — упростить до минимума

Для теста можно сделать так. В demo_window.pas:
pascal

while MyApp.Running do
begin
  // Читаем и обрабатываем всё, что пришло
  MyApp.Display.DispatchPending;
  MyApp.Display.Flush;

  // Раз в 16 мс — анимация
  Now := GetTickCount64;
  if Now - LastTick >= 16 then
  begin
    LastTick := Now;
    Inc(Frame);
    Win.Repaint;
  end;

  // Даём сокету шанс прочитать — блокирующий roundtrip раз в 100 мс
  Now := GetTickCount64;
  if Now - LastRoundtrip >= 100 then
  begin
    LastRoundtrip := Now;
    MyApp.Display.Roundtrip;  // ← ключевой момент, читает release
  end;

  Sleep(1);
end;

Roundtrip — блокирующий, но раз в 100 мс это ок. При этом он гарантированно читает всё пришедшее из сокета, включая wl_buffer.release.
Или ещё проще — сразу после EndPaint сделать Dispatch один раз

Repaint вызывает EndPaint, который делает Commit и Flush. Сразу после этого можно вызвать неблокирующий DispatchPending — он обработает то, что уже пришло, включая быстрый release (если композитор уже успел его прислать).

Но композитор присылает release асинхронно, в следующем событии. Так что нужно подождать.
Итог: что попробовать сейчас

Самый быстрый тест — замени цикл в demo_window.pas на такой:
pascal

LastTick := GetTickCount64;
LastRoundtrip := 0;
while MyApp.Running do
begin
  MyApp.Display.DispatchPending;
  MyApp.Display.Flush;

  Now := GetTickCount64;

  if Now - LastTick >= 16 then
  begin
    LastTick := Now;
    Inc(Frame);
    Win.Repaint;
  end;

  if Now - LastRoundtrip >= 50 then
  begin
    LastRoundtrip := Now;
    MyApp.Display.Roundtrip;
    WriteLn('[demo] frame=', Frame, ' buf0.released=', Win.FBuffersDebug(0));
  end;

  Sleep(1);
end;

Для отладки добавь в TWLWindow публичную функцию:
pascal

function TWLWindow.FBuffersDebug(AIndex: Integer): Boolean;
begin
  if (AIndex < 0) or (AIndex > 1) or (FBuffers[AIndex] = nil) then
    Result := False
  else
    Result := FBuffers[AIndex].Released;
end;

Если после патча в логе видно buf0.released=True/False меняется — значит release приходит, анимация пойдёт.
Что реально надо сделать в перспективе

Правильный event loop:

    wl_display_prepare_read

    wl_display_flush

    poll(fd, timeout) — тут можно дождаться таймера анимации

    wl_display_read_events или wl_display_cancel_read

    wl_display_dispatch_pending

    Если время кадра — Repaint

Так мы и слушаем сокет, и рисуем по таймеру, без блокирующих roundtrip. Реализую в wlgui_events.pas, когда будем делать ввод.
Про «окно можно таскать за содержимое»

Это композитор сам решил, что раз окно без заголовка, а мышь тащит — можно двигать окно. Это поведение xdg_toplevel.move. Приятный бонус, но для «летающей панели» мы в будущем будем использовать layer-shell — там позиция задаётся клиентом через margin.
Что делать прямо сейчас

    Сделай патч demo_window.pas выше — с Roundtrip раз в 50 мс.

    Прогони 10 секунд, покажи лог.

    Смотрим, меняется ли released.

Если released меняется, а анимация всё равно застряла — проблема в BeginPaint/EndPaint, будем отлаживать.
Немного поправил FDisplay -> Display но всё равно: wlgui_context.pas(88,8) Error: Identifier not found "TPollfd"
wlgui_context.pas(88,15) Error: Error in type definition
wlgui_context.pas(112,7) Error: Illegal qualifier
wlgui_context.pas(113,7) Error: Illegal qualifier
wlgui_context.pas(113,17) Error: Identifier not found "POLLIN"
wlgui_context.pas(114,7) Error: Illegal qualifier
wlgui_context.pas(115,10) Error: Identifier not found "fpPoll"
wlgui_context.pas(117,26) Error: Illegal qualifier
wlgui_context.pas(117,38) Error: Identifier not found "POLLIN"
TPollfd и fpPoll — в разных модулях

В FPC:

    TPollfd и POLLIN — в модуле BaseUnix (не Unix).

    fpPoll — тоже в BaseUnix.

Плюс BaseUnix не подключён в wlgui_context.pas.
Патч wlgui_context.pas

Меняем uses:
pascal

uses
  Classes, SysUtils, BaseUnix, wlgui_types;

И метод DispatchWithTimeout:
pascal

function TWLContext.DispatchWithTimeout(ATimeoutMs: Integer): Boolean;
var
  Fd: cint;
  Pfd: TPollfd;
  Ret: Integer;
begin
  Result := False;
  if FDisplay = nil then Exit;

  // Если есть уже готовые события — обрабатываем их без poll
  if wl_display_prepare_read(FDisplay) <> 0 then
  begin
    wl_display_dispatch_pending(FDisplay);
    wl_display_flush(FDisplay);
    Exit(True);
  end;

  Fd := wl_display_get_fd(FDisplay);

  // Отправляем всё, что накопилось
  if wl_display_flush(FDisplay) < 0 then
  begin
    wl_display_cancel_read(FDisplay);
    Exit(False);
  end;

  // Ждём событий
  Pfd.fd := Fd;
  Pfd.events := POLLIN;
  Pfd.revents := 0;
  Ret := fpPoll(@Pfd, 1, ATimeoutMs);

  if (Ret > 0) and ((Pfd.revents and POLLIN) <> 0) then
  begin
    wl_display_read_events(FDisplay);
    wl_display_dispatch_pending(FDisplay);
    Result := True;
  end
  else
  begin
    wl_display_cancel_read(FDisplay);
    wl_display_dispatch_pending(FDisplay);
    wl_display_flush(FDisplay);
  end;
end;

Но! Метод DispatchWithTimeout должен быть объявлен в interface секции класса TWLContext. Если ты добавлял только реализацию — компилятор не знает. Проверь, что в TWLContext есть:
pascal

  public
    ...
    function DispatchWithTimeout(ATimeoutMs: Integer): Boolean;

Про wl_display_prepare_read и компанию

В wayland_client_core.pas они объявлены как external:
pascal

function  wl_display_prepare_read(display :Pwl_display): cint; cdecl; external;
procedure wl_display_cancel_read(display :Pwl_display); cdecl; external;
function  wl_display_read_events(display :Pwl_display): cint; cdecl; external;

Значит, они будут видны, если подключить wayland_client_core в wlgui_context.pas. У нас он уже подключён — проверь.
Быстрый тест без нового метода

Если не хочется возиться с TPollfd — можно обойтись без DispatchWithTimeout, просто добавив Roundtrip в цикл. Это уже работало, просто реже.

В demo_window.pas:
pascal

var
  LastTick, LastRoundtrip, Now_: QWord;
begin
  ...
  LastTick := GetTickCount64;
  LastRoundtrip := LastTick;
  while MyApp.Running do
  begin
    // Простая обработка событий
    MyApp.Display.DispatchPending;
    MyApp.Display.Flush;

    Now_ := GetTickCount64;

    // 60 fps — рисуем
    if Now_ - LastTick >= 16 then
    begin
      LastTick := Now_;
      Inc(Frame);
      Win.Repaint;
    end;

    // Раз в 50 мс — roundtrip, чтобы прочитать release
    if Now_ - LastRoundtrip >= 50 then
    begin
      LastRoundtrip := Now_;
      MyApp.Display.Roundtrip;
    end;

    Sleep(1);
  end;

Это заработает. Roundtrip — блокирующий, но раз в 50 мс при 60 fps это даст микро-паузы ~1 мс, незаметно.
Что именно исправить в wlgui_context.pas

Полный исправленный модуль:
pascal

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

interface

uses
  Classes, SysUtils, BaseUnix,
  wayland_client_core, wayland_protocol, xdg_shell_protocol,
  wlgui_types;

type
  TWLContext = class
  public
    Display: TWlDisplay;
    Compositor: TWlCompositor;
    Shm: TWlShm;
    WmBase: TXdgWmBase;
    Subcompositor: TWlSubcompositor;
    Seat: TWlSeat;
    LayerShell: Pointer;

    procedure RegisterWindow(Obj: TObject);
    procedure UnregisterWindow(Obj: TObject);

    procedure Quit;
    function Running: Boolean;
    procedure SetRunning(AValue: Boolean);

    function DispatchWithTimeout(ATimeoutMs: Integer): Boolean;

    constructor Create;
    destructor Destroy; override;
  private
    FWindows: TList;
    FRunning: Boolean;
    FOnQuit: TWLNotifyEvent;
  public
    property Windows: TList read FWindows;
    property OnQuit: TWLNotifyEvent read FOnQuit write FOnQuit;
    property IsRunning: Boolean read Running write SetRunning;
  end;

implementation

constructor TWLContext.Create;
begin
  inherited;
  FWindows := TList.Create;
  FRunning := True;
end;

destructor TWLContext.Destroy;
begin
  FWindows.Free;
  inherited;
end;

procedure TWLContext.RegisterWindow(Obj: TObject);
begin
  if FWindows.IndexOf(Obj) < 0 then
    FWindows.Add(Obj);
end;

procedure TWLContext.UnregisterWindow(Obj: TObject);
begin
  FWindows.Remove(Obj);
end;

procedure TWLContext.Quit;
begin
  FRunning := False;
  if Assigned(FOnQuit) then
    FOnQuit(Self);
end;

function TWLContext.Running: Boolean;
begin
  Result := FRunning;
end;

procedure TWLContext.SetRunning(AValue: Boolean);
begin
  FRunning := AValue;
end;

function TWLContext.DispatchWithTimeout(ATimeoutMs: Integer): Boolean;
var
  Fd: cint;
  Pfd: TPollfd;
  Ret: Integer;
begin
  Result := False;
  if Display = nil then Exit;

  if wl_display_prepare_read(Display) <> 0 then
  begin
    wl_display_dispatch_pending(Display);
    wl_display_flush(Display);
    Exit(True);
  end;

  Fd := wl_display_get_fd(Display);

  if wl_display_flush(Display) < 0 then
  begin
    wl_display_cancel_read(Display);
    Exit(False);
  end;

  Pfd.fd := Fd;
  Pfd.events := POLLIN;
  Pfd.revents := 0;
  Ret := fpPoll(@Pfd, 1, ATimeoutMs);

  if (Ret > 0) and ((Pfd.revents and POLLIN) <> 0) then
  begin
    wl_display_read_events(Display);
    wl_display_dispatch_pending(Display);
    Result := True;
  end
  else
  begin
    wl_display_cancel_read(Display);
    wl_display_dispatch_pending(Display);
    wl_display_flush(Display);
  end;
end;

end.

Если wl_display_prepare_read не находится

Проверь, что в wayland_client_core.pas в интерфейсной секции они объявлены (а не только в implementation):
pascal

function  wl_display_prepare_read(display :Pwl_display): cint; cdecl; external;
procedure wl_display_cancel_read(display :Pwl_display); cdecl; external;
function  wl_display_read_events(display :Pwl_display): cint; cdecl; external;

В твоём файле они есть (я видел). Значит uses wayland_client_core — обязательно.
Проверь сигнатуру TPollfd в BaseUnix

В FPC BaseUnix определяет:
pascal

type
  TPollfd = record
    fd: cint;
    events: cshort;
    revents: cshort;
  end;

Поля events и revents — cshort, не Word. Присваивание POLLIN (константа = 1) работает.
Итог

    uses BaseUnix в wlgui_context.pas.

    Убедись, что DispatchWithTimeout объявлен в классе.

    Пересобери demo с новым циклом.

Если и с DispatchWithTimeout не заработает — вернёмся к простому Roundtrip раз в 50 мс.