Привет! Мы делаем пробные виджеты для Wayland на FreePascal'е. Появляется окно, всё в порядке, но через какое-то время ввод сбивается (в консоле появляются пары вначале mouse enter, затем mouse leave, что-то как бы "выбрасывает" мышь), а вместо него появляется возможность таскать окно за содержимое. Ты можешь помочь исправить?

Да. Я вижу в коде несколько подозрительных мест, и одно из них очень хорошо соответствует твоему симптому.

Главная проблема, скорее всего, находится в обработке wl_pointer и особенно в смене курсора. В текущем коде wl_pointer_enter сохраняет serial, но при button используется уже другой serial. Кроме того, объект TWLCursor вообще не получает FPointer, поэтому его Commit() фактически ничего не делает. Это видно непосредственно в исходнике: FPointer создаётся в TWLEventManager, но внутри TWLCursor.Create остаётся nil.

Ещё важнее вот этот участок:

if AState = 1 then
begin
  FOwner.FCursor.SetCursorShape('grabbing');
  FOwner.FCursor.Commit(ASerial);
end
else
begin
  FOwner.FCursor.SetCursorShape('left_ptr');
  FOwner.FCursor.Commit(ASerial);
end;

ASerial здесь — serial события wl_pointer.button, а wl_pointer.set_cursor должен использовать serial, полученный из wl_pointer.enter, то есть тот serial, которым compositor передал право клиенту менять указатель.

Именно поэтому я бы первым делом убрал смену курсора из wl_pointer_button. Сейчас она не только не нужна для теста ввода, но и концептуально неправильна.

Что я предлагаю исправить

В wl_pointer_enter оставить:

FOwner.FCursor.SetCursorShape('left_ptr');
FOwner.FCursor.LastSerial := ASerial;
FOwner.FCursor.Commit(ASerial);

А из wl_pointer_button полностью убрать:

if AState = 1 then
begin
  ...
end
else
begin
  ...
end;

То есть обработчик кнопки должен заниматься только состоянием кнопки и передачей события приложению.

Но есть ещё одна вещь, которую я хочу проверить перед тем, как дать тебе готовые исправленные units: почему compositor начинает перетаскивать xdg_toplevel за содержимое. В показанном файле прямого вызова xdg_toplevel.move() нет вообще, поэтому надо посмотреть реализацию wayland_protocol/xdg_shell_protocol или оставшуюся часть wlgui_window — возможно, там есть автоматический grab/move, которого пока не видно в извлечённом фрагменте.

Если хочешь, я могу сейчас 
разобрать весь all.txt целиком по цепочке wl_seat → wl_pointer → EventManager → TWLWindow и дать конкретный патч для wlgui_events.pas и wlgui_window.pas, чтобы мышь перестала «вылетать» и окно не начинало таскаться за содержимое.

wayland_protocol.pas
Файл
xdg_shell_protocol.pas
Файл
Давай, спасибо!

Конечно. Сделаем совсем минимальный тест: одно окно, вывод в консоль ENTER/LEAVE, движение мыши, кнопки и клавиатура. Никакой отрисовки, курсора, виджетов и xdg_toplevel.move() — чтобы максимально чисто проверить именно ввод.

Судя по вашим юнитам, файл можно назвать demo_input_min.pas:

program demo_input_min;

{$mode objfpc}{$H+}
{$codepage utf8}

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

var
  App: TWLApplication;
  Win: TWLWindow;

  MouseX, MouseY: Integer;
  MouseButtons: Integer = 0;
  EnterCount: Integer = 0;
  LeaveCount: Integer = 0;
  MoveCount: Integer = 0;
  KeyCount: Integer = 0;

procedure MouseDown(Sender: TObject; const E: TWLMouseEvent);
begin
  MouseX := E.X;
  MouseY := E.Y;
  MouseButtons := MouseButtons or (1 shl E.Button);

  WriteLn(
    '[mouse] DOWN  button=', E.Button,
    ' pos=', E.X, ',', E.Y,
    ' buttons=', MouseButtons
  );
end;

procedure MouseUp(Sender: TObject; const E: TWLMouseEvent);
begin
  MouseX := E.X;
  MouseY := E.Y;
  MouseButtons := MouseButtons and not (1 shl E.Button);

  WriteLn(
    '[mouse] UP    button=', E.Button,
    ' pos=', E.X, ',', E.Y,
    ' buttons=', MouseButtons
  );
end;

procedure MouseMove(Sender: TObject; const E: TWLMouseEvent);
begin
  MouseX := E.X;
  MouseY := E.Y;
  Inc(MoveCount);

  if (MoveCount mod 20) = 0 then
    WriteLn(
      '[mouse] MOVE  pos=', E.X, ',', E.Y,
      ' count=', MoveCount
    );
end;

procedure MouseEnter(Sender: TObject);
begin
  Inc(EnterCount);

  WriteLn(
    '[mouse] ENTER #', EnterCount,
    ' pos=', MouseX, ',', MouseY
  );
end;

procedure MouseLeave(Sender: TObject);
begin
  Inc(LeaveCount);

  WriteLn(
    '[mouse] LEAVE #', LeaveCount,
    ' buttons=', MouseButtons,
    ' moves=', MoveCount
  );
end;

procedure MouseWheel(Sender: TObject; const E: TWLWheelEvent);
begin
  WriteLn(
    '[mouse] WHEEL dx=', E.DeltaX,
    ' dy=', E.DeltaY
  );
end;

procedure KeyDown(Sender: TObject; const E: TWLKeyEvent);
begin
  Inc(KeyCount);

  WriteLn(
    '[key] DOWN scancode=', E.Scancode,
    ' keysym=$', IntToHex(E.Keysym, 4),
    ' codepoint=U+', IntToHex(E.Codepoint, 4)
  );
end;

procedure KeyUp(Sender: TObject; const E: TWLKeyEvent);
begin
  WriteLn(
    '[key] UP   scancode=', E.Scancode,
    ' keysym=$', IntToHex(E.Keysym, 4)
  );
end;

procedure FocusIn(Sender: TObject);
begin
  WriteLn('[focus] IN');
end;

procedure FocusOut(Sender: TObject);
begin
  WriteLn('[focus] OUT');
end;

procedure CloseWindow(Sender: TObject);
begin
  WriteLn('[window] CLOSE');
  App.Quit;
end;

begin
  WriteLn('========================================');
  WriteLn(' Minimal Wayland input test');
  WriteLn('========================================');

  App := TWLApplication.Create;

  try
    if not App.Initialize then
    begin
      WriteLn('Wayland initialization failed.');
      Halt(1);
    end;

    Win := CreateWLWindow(
      App.Context,
      'Minimal Wayland input test',
      640,
      480
    );

    Win.OnMouseDown  := @MouseDown;
    Win.OnMouseUp    := @MouseUp;
    Win.OnMouseMove  := @MouseMove;
    Win.OnMouseEnter := @MouseEnter;
    Win.OnMouseLeave := @MouseLeave;
    Win.OnMouseWheel := @MouseWheel;

    Win.OnKeyDown := @KeyDown;
    Win.OnKeyUp   := @KeyUp;

    Win.OnFocusIn  := @FocusIn;
    Win.OnFocusOut := @FocusOut;

    Win.OnClose := @CloseWindow;

    App.Display.Roundtrip;

    Win.Show;

    WriteLn;
    WriteLn('Test window is running.');
    WriteLn('Move mouse, click buttons, type keys.');
    WriteLn('Press Ctrl+C in terminal to stop.');
    WriteLn;

    while App.Running do
      App.ProcessEvents;

  finally
    App.Free;
  end;
end.

Компиляция примерно такая:

fpc demo_input_min.pas

И запуск:

./demo_input_min
Что особенно важно в этом тесте

Я специально не использовал:

TWLCanvas;
OnPaint;
Win.Repaint;
TWLCursor;
изменение формы курсора;
xdg_toplevel.move;
TWLWidget.

То есть если получится ситуация:

[mouse] ENTER #1
...
[mouse] LEAVE #1
[mouse] ENTER #2
[mouse] LEAVE #2

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

И ещё: не запускайте пока с WAYLAND_DEBUG=1, сначала посмотрим обычный вывод. Если снова появится странная пара ENTER → LEAVE, пришлите весь вывод от запуска до этого момента. Тогда следующим шагом я бы уже правил wlgui_events.pas, а не само демо.

Он не показывает окно. В консоле: ./demo_input_min
========================================
 Minimal Wayland input test
========================================
[wlgui] EventManager created
[xkb] libxkbcommon loaded
[xkb] context created
[wlgui] Wayland initialized
[wlgui] window created: "Minimal Wayland input test" 640x480
[events] seat name: default
[events] seat capabilities=3
[cursor] libwayland-cursor loaded
[cursor] theme loaded: "" size=24
[cursor] cursor surface created
[events] pointer attached
[events] keyboard attached
[wlgui] 2 buffers created: 640x480 stride=2560

Test window is running.
Move mouse, click buttons, type keys.
Press Ctrl+C in terminal to stop.

[events] keyboard keymap format=1 size=38030
[xkb] keymap loaded
^C

Да, теперь причина ясна. В ваших wlgui_window.pas метод Show не показывает содержимое окна сам по себе:

procedure TWLWindow.Show;
begin
  FVisible := True;
  // ничего дополнительно
end;

А TWLWindow создаёт SHM-буферы только после xdg_surface.configure. Поэтому наш тест дождался configure, создал два буфера — и дальше ни разу не сделал EndPaint/Repaint, то есть compositor так и не получил первый wl_buffer.

Исправим демо минимально: после OnConfigured один раз отправляем чёрный буфер.

program demo_input_min;

{$mode objfpc}{$H+}

uses
  cthreads,
  SysUtils,
  wlgui_app,
  wlgui_window,
  wlgui_types;

var
  App: TWLApplication;
  Win: TWLWindow;

  EnterCount: Integer = 0;
  LeaveCount: Integer = 0;
  MoveCount: Integer = 0;
  MouseButtons: Integer = 0;

procedure DoConfigured(Sender: TObject);
begin
  WriteLn('[window] CONFIGURED');

  { Первый настоящий commit с буфером.
    Без него compositor не покажет окно. }
  Win.Repaint;

  WriteLn('[window] FIRST FRAME COMMITTED');
end;

procedure MouseDown(Sender: TObject; const E: TWLMouseEvent);
begin
  MouseButtons := MouseButtons or (1 shl E.Button);

  WriteLn(
    '[mouse] DOWN  button=', E.Button,
    ' pos=', E.X, ',', E.Y,
    ' buttons=', MouseButtons
  );
end;

procedure MouseUp(Sender: TObject; const E: TWLMouseEvent);
begin
  MouseButtons := MouseButtons and not (1 shl E.Button);

  WriteLn(
    '[mouse] UP    button=', E.Button,
    ' pos=', E.X, ',', E.Y,
    ' buttons=', MouseButtons
  );
end;

procedure MouseMove(Sender: TObject; const E: TWLMouseEvent);
begin
  Inc(MoveCount);

  { Не засоряем консоль каждым motion-событием. }
  if (MoveCount mod 20) = 0 then
    WriteLn(
      '[mouse] MOVE  pos=', E.X, ',', E.Y,
      ' count=', MoveCount
    );
end;

procedure MouseEnter(Sender: TObject);
begin
  Inc(EnterCount);

  WriteLn(
    '[mouse] ENTER #', EnterCount
  );
end;

procedure MouseLeave(Sender: TObject);
begin
  Inc(LeaveCount);

  WriteLn(
    '[mouse] LEAVE #', LeaveCount,
    ' buttons=', MouseButtons,
    ' moves=', MoveCount
  );
end;

procedure MouseWheel(Sender: TObject; const E: TWLWheelEvent);
begin
  WriteLn(
    '[mouse] WHEEL dx=', E.DeltaX,
    ' dy=', E.DeltaY
  );
end;

procedure KeyDown(Sender: TObject; const E: TWLKeyEvent);
begin
  WriteLn(
    '[key] DOWN scancode=', E.Scancode,
    ' keysym=$', IntToHex(E.Keysym, 4),
    ' codepoint=U+', IntToHex(E.Codepoint, 4)
  );
end;

procedure KeyUp(Sender: TObject; const E: TWLKeyEvent);
begin
  WriteLn(
    '[key] UP   scancode=', E.Scancode,
    ' keysym=$', IntToHex(E.Keysym, 4)
  );
end;

procedure FocusIn(Sender: TObject);
begin
  WriteLn('[focus] IN');
end;

procedure FocusOut(Sender: TObject);
begin
  WriteLn('[focus] OUT');
end;

procedure CloseWindow(Sender: TObject);
begin
  WriteLn('[window] CLOSE');
  App.Quit;
end;

begin
  WriteLn('========================================');
  WriteLn(' Minimal Wayland input test');
  WriteLn('========================================');

  App := TWLApplication.Create;

  try
    if not App.Initialize then
      Halt(1);

    Win := CreateWLWindow(
      App.Context,
      'Minimal Wayland input test',
      640,
      480
    );

    Win.OnConfigured := @DoConfigured;

    Win.OnMouseDown  := @MouseDown;
    Win.OnMouseUp    := @MouseUp;
    Win.OnMouseMove  := @MouseMove;
    Win.OnMouseEnter := @MouseEnter;
    Win.OnMouseLeave := @MouseLeave;
    Win.OnMouseWheel := @MouseWheel;

    Win.OnKeyDown := @KeyDown;
    Win.OnKeyUp   := @KeyUp;

    Win.OnFocusIn  := @FocusIn;
    Win.OnFocusOut := @FocusOut;

    Win.OnClose := @CloseWindow;

    { Начальный commit xdg_surface уже сделан конструктором.
      Теперь ждём configure. }
    App.Display.Roundtrip;

    Win.Show;

    WriteLn;
    WriteLn('Waiting for xdg_surface.configure...');
    WriteLn('Move mouse, click buttons and type keys.');
    WriteLn('Press Ctrl+C to stop.');
    WriteLn;

    while App.Running do
      App.ProcessEvents;

  finally
    App.Free;
  end;
end.
Что должно измениться

Теперь в консоли ожидаем примерно:

[wlgui] window created: "Minimal Wayland input test" 640x480
...
[wlgui] 2 buffers created: 640x480 stride=2560
[window] CONFIGURED
[window] FIRST FRAME COMMITTED

И после этого окно должно появиться.

Причём это заодно хороший контрольный тест: после появления окна поводим мышью и посмотрим, не повторяется ли прежняя последовательность:

[mouse] ENTER #1
...
[mouse] LEAVE #1
[mouse] ENTER #2
[mouse] LEAVE #2

Если она повторится, это уже будет очень ценная информация: окно и первый buffer commit работают, а проблема действительно находится в обработке pointer/cursor, а не в создании xdg_toplevel.

И пока специально не трогаем wlgui_events.pas — сначала получим чистый результат этого теста.

./demo_input_min
========================================
 Minimal Wayland input test
========================================
[wlgui] EventManager created
[xkb] libxkbcommon loaded
[xkb] context created
[wlgui] Wayland initialized
[wlgui] window created: "Minimal Wayland input test" 640x480
[events] seat name: default
[events] seat capabilities=3
[cursor] libwayland-cursor loaded
[cursor] theme loaded: "" size=24
[cursor] cursor surface created
[events] pointer attached
[events] keyboard attached
[wlgui] 2 buffers created: 640x480 stride=2560
[window] CONFIGURED
[window] FIRST FRAME COMMITTED

Waiting for xdg_surface.configure...
Move mouse, click buttons and type keys.
Press Ctrl+C to stop.

[events] keyboard keymap format=1 size=38030
[xkb] keymap loaded
[focus] IN
[window] CONFIGURED
[window] FIRST FRAME COMMITTED
[mouse] ENTER #1
[key] UP   scancode=28 keysym=$FF0D
[mouse] DOWN  button=1 pos=549,80 buttons=2
[mouse] UP    button=1 pos=549,80 buttons=0
[mouse] DOWN  button=3 pos=549,80 buttons=8
[mouse] UP    button=3 pos=549,80 buttons=0
[mouse] LEAVE #1 buttons=0 moves=7
[mouse] ENTER #2
[mouse] MOVE  pos=558,91 count=20
[mouse] LEAVE #2 buttons=0 moves=31
[mouse] ENTER #3
[mouse] MOVE  pos=439,136 count=40
[mouse] MOVE  pos=163,191 count=60
[mouse] LEAVE #3 buttons=0 moves=76
[mouse] ENTER #4
[mouse] MOVE  pos=23,390 count=80
[mouse] MOVE  pos=142,464 count=100
[mouse] LEAVE #4 buttons=0 moves=113
[mouse] ENTER #5
[mouse] MOVE  pos=172,415 count=120
[mouse] MOVE  pos=172,366 count=140
[mouse] DOWN  button=1 pos=172,360 buttons=2
[mouse] MOVE  pos=291,296 count=160
[mouse] MOVE  pos=417,237 count=180
[mouse] UP    button=1 pos=417,237 buttons=0
[mouse] MOVE  pos=310,262 count=200
[mouse] MOVE  pos=260,240 count=220
[mouse] DOWN  button=1 pos=247,229 buttons=2
[mouse] MOVE  pos=266,215 count=240
[mouse] UP    button=1 pos=291,183 buttons=0
[mouse] MOVE  pos=291,209 count=260
[mouse] DOWN  button=1 pos=284,250 buttons=2
[mouse] MOVE  pos=283,251 count=280
[mouse] UP    button=1 pos=283,251 buttons=0
[mouse] DOWN  button=1 pos=122,261 buttons=2
[mouse] UP    button=1 pos=122,261 buttons=0
[mouse] MOVE  pos=123,229 count=300
[mouse] MOVE  pos=142,124 count=320
[mouse] DOWN  button=1 pos=142,116 buttons=2
[mouse] UP    button=1 pos=142,116 buttons=0
[mouse] MOVE  pos=330,131 count=340
[mouse] MOVE  pos=365,197 count=360
[mouse] DOWN  button=1 pos=365,208 buttons=2
[mouse] UP    button=1 pos=365,210 buttons=0
[mouse] LEAVE #5 buttons=0 moves=370
[mouse] ENTER #6
[mouse] LEAVE #6 buttons=0 moves=370
[mouse] ENTER #7
[mouse] LEAVE #7 buttons=0 moves=370
[mouse] ENTER #8
[mouse] LEAVE #8 buttons=0 moves=370
[mouse] ENTER #9
[mouse] LEAVE #9 buttons=0 moves=370
[focus] OUT
[window] CONFIGURED
[window] FIRST FRAME COMMITTED
^C

Вот теперь у нас очень хороший результат. Само окно и обычный ввод работают нормально. Более того, проблема воспроизводится почти идеально:

ENTER #5
...
LEAVE #5

ENTER #6
LEAVE #6

ENTER #7
LEAVE #7

ENTER #8
LEAVE #8

Причём для #6..#9 между ENTER и LEAVE вообще нет MOVE. Это уже очень похоже именно на проблему с wl_pointer/cursor surface.

И есть ещё одна важная деталь в исходниках: курсор создаётся автоматически при появлении pointer capability, а в wl_pointer_enter сразу выполняется:

FOwner.FCursor.SetCursorShape('left_ptr');
FOwner.FCursor.LastSerial := ASerial;
FOwner.FCursor.Commit(ASerial);

То есть сейчас давайте сделаем самый чистый эксперимент: полностью отключим cursor handling, не меняя остальную обработку мыши.

1. В wlgui_events.pas

В wl_pointer_enter временно закомментируйте этот блок:

  // Устанавливаем курсор
  if (FOwner.FCursor <> nil) and FOwner.FCursor.Initialized then
  begin
    FOwner.FCursor.SetCursorShape('left_ptr');
    FOwner.FCursor.LastSerial := ASerial;
    FOwner.FCursor.Commit(ASerial);
  end;

То есть получится:

procedure TWLPointerListener.wl_pointer_enter(
  AWlPointer: TWlPointer;
  ASerial: DWord;
  ASurface: TWlSurface;
  ASurfaceX: Twl_fixed;
  ASurfaceY: Twl_fixed);
var
  Recv: IWLEventReceiver;
begin
  FOwner.FLastMouseX := Round(ASurfaceX.AsDouble);
  FOwner.FLastMouseY := Round(ASurfaceY.AsDouble);

  { КУРСОР ВРЕМЕННО ОТКЛЮЧЕН
    для диагностики enter/leave }

  Recv := FindReceiverBySurface(ASurface);
  if Recv <> nil then
  begin
    FOwner.SetFocused(Recv);
    Recv.WLRecvMouseEnter;
  end;
end;
2. И пока отключим cursor switching при нажатии

В wl_pointer_button временно уберите вот этот блок:

if AState = 1 then
begin
  if FOwner.FCursor <> nil then
  begin
    FOwner.FCursor.SetCursorShape('grabbing');
    FOwner.FCursor.Commit(ASerial);
  end;
end
else
begin
  if FOwner.FCursor <> nil then
  begin
    FOwner.FCursor.SetCursorShape('left_ptr');
    FOwner.FCursor.Commit(ASerial);
  end;
end;
3. Перекомпилировать

Важно пересобрать именно юнит:

fpc demo_input_min.pas

Если FPC возьмёт старый .ppu, удалите:

rm -f wlgui_events.o wlgui_events.ppu
fpc demo_input_min.pas
4. Запустить и просто поводить мышью

Особенно интересно, исчезнут ли:

ENTER #6
LEAVE #6
ENTER #7
LEAVE #7
ENTER #8
LEAVE #8

Если после отключения cursor получится что-то вроде:

ENTER #1
MOVE ...
MOVE ...
MOVE ...
LEAVE #1

ENTER #2
MOVE ...
MOVE ...
LEAVE #2

то причина практически найдена: не обработка мыши как таковая, а наша реализация cursor surface / set_cursor().

Есть ещё одна вещь, которую я уже вижу в исходнике и которую потом обязательно исправим:

constructor TWLCursor.Create(...);
begin
  ...
  FPointer := nil;

но в TWLSeatListener.wl_seat_capabilities после создания TWLCursor я не вижу присваивания

FOwner.FCursor.FPointer := FOwner.FPointer;

При этом TWLCursor.Commit() требует:

if (not FInitialized) or (FPointer = nil) then Exit;

То есть архитектура cursor сейчас выглядит незавершённой: курсор знает о wl_pointer через отдельное поле, но это поле не связывается с созданным pointer.

Однако прежде чем это исправлять, я бы сделал именно этот эксперимент. Если без cursor ложные ENTER/LEAVE исчезнут — у нас будет очень сильное подтверждение причины.