Давай пункт A: TWLMemo сразу. Спасибо!
Этап 13: TWLMemo — полная версия

Даю полный модуль wlgui_memo.pas + тестовую программу. Модуль большой (~550 строк), но разбит на понятные части.
1. wlgui_memo.pas
pascal

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

interface

uses
  SysUtils,
  u4intf, u4str, u4utf8, u4wrap, u4lines, u4helper,
  wlgui_types, wlgui_canvas, wlgui_font, wlgui_widget, wlgui_events;

type
  TWLMemo = class(TWLWidget)
  private
    FLines: TU4Lines;
    FCursorLine: Integer;
    FCursorCol: Integer;
    FPreferredCol: Integer;
    FScrollY: Integer;         // первая видимая строка
    FScrollX: Integer;         // пиксельный сдвиг влево (для длинных строк)

    FTextColor: TWLColor;
    FBackColor: TWLColor;
    FBorderColor: TWLColor;
    FFocusedBorderColor: TWLColor;
    FCursorColor: TWLColor;

    FLineHeight: Integer;
    FPadding: Integer;

    FReadOnly: Boolean;
    FOnChange: TWLNotifyEvent;

    procedure RecalcLineHeight;
    function  VisibleLineCount: Integer;
    function  ScreenLineAtY(AY: Integer): Integer;
    function  ColFromPixelX(ALine: Integer; AX: Integer): Integer;
    function  LinePixelWidth(ALine: Integer): Integer;
    function  PrefixPixelWidth(ALine, ACol: Integer): Integer;

    procedure EnsureCursorVisible;
    procedure MoveCursorTo(ALine, ACol: Integer; AKeepPreferred: Boolean = False);
    procedure MoveCursorLeft;
    procedure MoveCursorRight;
    procedure MoveCursorUp;
    procedure MoveCursorDown;

    procedure InsertChar(C: u4char);
    procedure Backspace;
    procedure DeleteForward;
    procedure SplitLine;
    procedure MergeWithPrevLine;

    procedure NotifyChange;
    function  CurrentLine: IU4String;
    function  CurrentLineLength: Integer;
  protected
    procedure DoPaint(ACanvas: TWLCanvas); override;
    function  DoMouseDown(X, Y: Integer): Boolean; override;
    procedure DoKeyDown(const E: TWLKeyEvent); override;
    procedure DoMouseWheel(const E: TWLWheelEvent); override;
  public
    constructor Create(const ARect: TRectI; AFont: TWLFont);
    destructor Destroy; override;
    function CanFocus: Boolean; override;

    procedure SetText(const S: UTF8String); overload;
    procedure SetText(const S: IU4String); overload;
    function  GetText: UTF8String;
    function  GetTextU4: IU4String;
    procedure Clear;
    procedure AppendLine(const S: UTF8String);

    property Lines: TU4Lines read FLines;
    property CursorLine: Integer read FCursorLine;
    property CursorCol: Integer read FCursorCol;
    property ReadOnly: Boolean read FReadOnly write FReadOnly;
    property OnChange: TWLNotifyEvent read FOnChange write FOnChange;
    property TextColor: TWLColor read FTextColor write FTextColor;
    property BackColor: TWLColor read FBackColor write FBackColor;
    property BorderColor: TWLColor read FBorderColor write FBorderColor;
    property FocusedBorderColor: TWLColor read FFocusedBorderColor
                                       write FFocusedBorderColor;
    property LineHeight: Integer read FLineHeight;
  end;

implementation

const
  CURSOR_BLINK_MS = 500;

{ ============================================================ }
{  Конструктор / деструктор                                     }
{ ============================================================ }

constructor TWLMemo.Create(const ARect: TRectI; AFont: TWLFont);
begin
  inherited Create(ARect);
  FFont := AFont;
  FLines := TU4Lines.Create;
  FLines.Add(U4Empty);   // одна пустая строка

  FCursorLine := 0;
  FCursorCol := 0;
  FPreferredCol := 0;
  FScrollY := 0;
  FScrollX := 0;

  FTextColor := TWLColor($00FFFFFF);
  FBackColor := TWLColor($00202020);
  FBorderColor := TWLColor($00606060);
  FFocusedBorderColor := TWLColor($00FFFFFF);
  FCursorColor := TWLColor($00FFFFFF);

  FPadding := 4;
  FReadOnly := False;
  FCanFocus := True;

  RecalcLineHeight;
end;

destructor TWLMemo.Destroy;
begin
  FLines.Free;
  inherited;
end;

function TWLMemo.CanFocus: Boolean;
begin
  Result := FEnabled;
end;

procedure TWLMemo.RecalcLineHeight;
begin
  if FFont <> nil then
    FLineHeight := FFont.Height + 2
  else
    FLineHeight := 16;
end;

{ ============================================================ }
{  Текст                                                        }
{ ============================================================ }

procedure TWLMemo.SetText(const S: UTF8String);
begin
  SetText(UTF8ToU4(S));
end;

procedure TWLMemo.SetText(const S: IU4String);
begin
  FLines.SetText(S);
  if FLines.Count = 0 then
    FLines.Add(U4Empty);
  FCursorLine := 0;
  FCursorCol := 0;
  FPreferredCol := 0;
  FScrollY := 0;
  FScrollX := 0;
  NotifyChange;
end;

function TWLMemo.GetText: UTF8String;
begin
  Result := FLines.GetTextUTF8;
end;

function TWLMemo.GetTextU4: IU4String;
begin
  Result := FLines.GetText;
end;

procedure TWLMemo.Clear;
begin
  FLines.Clear;
  FLines.Add(U4Empty);
  FCursorLine := 0;
  FCursorCol := 0;
  FPreferredCol := 0;
  FScrollY := 0;
  FScrollX := 0;
  NotifyChange;
end;

procedure TWLMemo.AppendLine(const S: UTF8String);
begin
  FLines.Add(S);
  NotifyChange;
end;

procedure TWLMemo.NotifyChange;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

function TWLMemo.CurrentLine: IU4String;
begin
  if (FCursorLine < 0) or (FCursorLine >= FLines.Count) then
    Result := U4Empty
  else
    Result := FLines[FCursorLine];
end;

function TWLMemo.CurrentLineLength: Integer;
var
  L: IU4String;
begin
  L := CurrentLine;
  if L = nil then Result := 0
  else Result := L.Length;
end;

{ ============================================================ }
{  Мерки                                                        }
{ ============================================================ }

function TWLMemo.VisibleLineCount: Integer;
var
  InnerH: Integer;
begin
  InnerH := FRect.H - 2 * FPadding;
  if InnerH <= 0 then Exit(0);
  Result := InnerH div FLineHeight;
  if Result < 0 then Result := 0;
end;

function TWLMemo.ScreenLineAtY(AY: Integer): Integer;
var
  RelY: Integer;
begin
  RelY := AY - (ScreenRect.Y + FPadding);
  if RelY < 0 then Exit(FScrollY);
  Result := FScrollY + RelY div FLineHeight;
  if Result < 0 then Result := 0;
  if Result >= FLines.Count then
    Result := FLines.Count - 1;
  if Result < 0 then Result := 0;
end;

function TWLMemo.PrefixPixelWidth(ALine, ACol: Integer): Integer;
var
  L, Part: IU4String;
begin
  Result := 0;
  if (FFont = nil) or (ALine < 0) or (ALine >= FLines.Count) then Exit;
  L := FLines[ALine];
  if L = nil then Exit;
  if ACol <= 0 then Exit;
  if ACol > L.Length then ACol := L.Length;
  Part := L.SubString(0, ACol);
  Result := FFont.TextWidth(Part);
end;

function TWLMemo.LinePixelWidth(ALine: Integer): Integer;
begin
  Result := PrefixPixelWidth(ALine, MaxInt);
end;

function TWLMemo.ColFromPixelX(ALine: Integer; AX: Integer): Integer;
var
  InnerX: Integer;
  TargetX: Integer;
  L: IU4String;
  Len, I, W: Integer;
  PrevW, CurW: Integer;
begin
  Result := 0;
  if (ALine < 0) or (ALine >= FLines.Count) then Exit;
  if FFont = nil then Exit;

  L := FLines[ALine];
  if L = nil then Exit;

  InnerX := ScreenRect.X + FPadding - FScrollX;
  TargetX := AX - InnerX;
  if TargetX <= 0 then Exit(0);

  Len := L.Length;
  PrevW := 0;
  for I := 1 to Len do
  begin
    CurW := FFont.TextWidth(L.SubString(0, I));
    if CurW > TargetX then
    begin
      // Проверяем, ближе ли к предыдущему
      if (TargetX - PrevW) <= (CurW - TargetX) then
        Result := I - 1
      else
        Result := I;
      Exit;
    end;
    PrevW := CurW;
  end;
  Result := Len;
end;

{ ============================================================ }
{  Курсор                                                       }
{ ============================================================ }

procedure TWLMemo.MoveCursorTo(ALine, ACol: Integer; AKeepPreferred: Boolean);
begin
  if ALine < 0 then ALine := 0;
  if ALine >= FLines.Count then ALine := FLines.Count - 1;
  if ALine < 0 then ALine := 0;

  if ACol < 0 then ACol := 0;
  if ACol > FLines[ALine].Length then ACol := FLines[ALine].Length;

  FCursorLine := ALine;
  FCursorCol := ACol;
  if not AKeepPreferred then
    FPreferredCol := ACol;

  EnsureCursorVisible;
end;

procedure TWLMemo.EnsureCursorVisible;
var
  VisCount: Integer;
begin
  VisCount := VisibleLineCount;
  if VisCount <= 0 then Exit;

  // Вертикальный скролл
  if FCursorLine < FScrollY then
    FScrollY := FCursorLine
  else if FCursorLine >= FScrollY + VisCount then
    FScrollY := FCursorLine - VisCount + 1;

  if FScrollY < 0 then FScrollY := 0;
  if FScrollY > FLines.Count - VisCount then
    FScrollY := FLines.Count - VisCount;
  if FScrollY < 0 then FScrollY := 0;

  // Горизонтальный скролл
  // Если курсор не влезает справа — сдвигаем вправо
  var CursorX: Integer := PrefixPixelWidth(FCursorLine, FCursorCol) - FScrollX;
  var InnerW: Integer := FRect.W - 2 * FPadding;
  if InnerW < 1 then InnerW := 1;

  if CursorX > InnerW then
    FScrollX := PrefixPixelWidth(FCursorLine, FCursorCol) - InnerW;
  else if CursorX < 0 then
    FScrollX := PrefixPixelWidth(FCursorLine, FCursorCol);

  if FScrollX < 0 then FScrollX := 0;
end;

procedure TWLMemo.MoveCursorLeft;
begin
  if FCursorCol > 0 then
    Dec(FCursorCol)
  else if FCursorLine > 0 then
  begin
    Dec(FCursorLine);
    FCursorCol := FLines[FCursorLine].Length;
  end;
  FPreferredCol := FCursorCol;
  EnsureCursorVisible;
end;

procedure TWLMemo.MoveCursorRight;
begin
  if FCursorCol < CurrentLineLength then
    Inc(FCursorCol)
  else if FCursorLine < FLines.Count - 1 then
  begin
    Inc(FCursorLine);
    FCursorCol := 0;
  end;
  FPreferredCol := FCursorCol;
  EnsureCursorVisible;
end;

procedure TWLMemo.MoveCursorUp;
begin
  if FCursorLine = 0 then Exit;
  Dec(FCursorLine);
  FCursorCol := FPreferredCol;
  if FCursorCol > FLines[FCursorLine].Length then
    FCursorCol := FLines[FCursorLine].Length;
  EnsureCursorVisible;
end;

procedure TWLMemo.MoveCursorDown;
begin
  if FCursorLine >= FLines.Count - 1 then Exit;
  Inc(FCursorLine);
  FCursorCol := FPreferredCol;
  if FCursorCol > FLines[FCursorLine].Length then
    FCursorCol := FLines[FCursorLine].Length;
  EnsureCursorVisible;
end;

{ ============================================================ }
{  Вставка / удаление                                           }
{ ============================================================ }

procedure TWLMemo.InsertChar(C: u4char);
var
  L: IU4String;
begin
  if FReadOnly then Exit;
  L := CurrentLine;
  L := U4InsertChar(L, FCursorCol, C);
  FLines[FCursorLine] := L;
  Inc(FCursorCol);
  FPreferredCol := FCursorCol;
  EnsureCursorVisible;
  NotifyChange;
end;

procedure TWLMemo.Backspace;
var
  L, Prev, Merged: IU4String;
  PrevLen: Integer;
begin
  if FReadOnly then Exit;

  if FCursorCol > 0 then
  begin
    // Просто удаляем символ слева
    L := CurrentLine;
    L := U4DeleteChar(L, FCursorCol - 1);
    FLines[FCursorLine] := L;
    Dec(FCursorCol);
    FPreferredCol := FCursorCol;
    EnsureCursorVisible;
    NotifyChange;
  end
  else if FCursorLine > 0 then
  begin
    // Сливаем с предыдущей
    Prev := FLines[FCursorLine - 1];
    L := CurrentLine;
    PrevLen := Prev.Length;
    Merged := Prev.Concat(L);
    FLines[FCursorLine - 1] := Merged;
    FLines.Delete(FCursorLine);
    Dec(FCursorLine);
    FCursorCol := PrevLen;
    FPreferredCol := FCursorCol;
    EnsureCursorVisible;
    NotifyChange;
  end;
end;

procedure TWLMemo.DeleteForward;
var
  L, NextLine, Merged: IU4String;
begin
  if FReadOnly then Exit;

  if FCursorCol < CurrentLineLength then
  begin
    // Удаляем символ справа
    L := CurrentLine;
    L := U4DeleteChar(L, FCursorCol);
    FLines[FCursorLine] := L;
    EnsureCursorVisible;
    NotifyChange;
  end
  else if FCursorLine < FLines.Count - 1 then
  begin
    // Сливаем со следующей
    NextLine := FLines[FCursorLine + 1];
    L := CurrentLine;
    Merged := L.Concat(NextLine);
    FLines[FCursorLine] := Merged;
    FLines.Delete(FCursorLine + 1);
    EnsureCursorVisible;
    NotifyChange;
  end;
end;

procedure TWLMemo.SplitLine;
var
  L, Before, After: IU4String;
begin
  if FReadOnly then Exit;
  L := CurrentLine;
  Before := L.SubString(0, FCursorCol);
  After := L.SubString(FCursorCol, L.Length - FCursorCol);
  FLines[FCursorLine] := Before;
  FLines.Insert(FCursorLine + 1, After);
  Inc(FCursorLine);
  FCursorCol := 0;
  FPreferredCol := 0;
  EnsureCursorVisible;
  NotifyChange;
end;

procedure TWLMemo.MergeWithPrevLine;
begin
  // Используется только Backspace-логикой (встроено)
end;

{ ============================================================ }
{  Отрисовка                                                    }
{ ============================================================ }

procedure TWLMemo.DoPaint(ACanvas: TWLCanvas);
var
  R, InnerR, LineR: TRectI;
  BorderC, TextC: TWLColor;
  VisCount, I, Idx, Y: Integer;
  Line: IU4String;
  CursorX, CursorY: Integer;
begin
  if (ACanvas = nil) or (FFont = nil) then Exit;

  R := ScreenRect;
  ACAnvas.FillRect(R, FBackColor);

  if FFocused then BorderC := FFocusedBorderColor
  else BorderC := FBorderColor;
  ACAnvas.Rect(R, BorderC);

  InnerR := TRectI.New(R.X + 1, R.Y + 1, R.W - 2, R.H - 2);
  ACAnvas.SetClip(InnerR);

  if FEnabled then TextC := FTextColor
  else TextC := TWLColor($00808080);

  VisCount := VisibleLineCount;

  for I := 0 to VisCount - 1 do
  begin
    Idx := FScrollY + I;
    if Idx >= FLines.Count then Break;

    Y := InnerR.Y + FPadding + I * FLineHeight;
    LineR := TRectI.New(InnerR.X, Y, InnerR.W, FLineHeight);

    Line := FLines[Idx];
    if (Line <> nil) and (Line.Length > 0) then
      ACAnvas.TextOut(InnerR.X + FPadding - FScrollX,
                      Y + (FLineHeight - FFont.Height) div 2,
                      Line, TextC, FFont);
  end;

  // Курсор
  if FFocused and FEnabled and (not FReadOnly) then
  begin
    if (GetTickCount64 div CURSOR_BLINK_MS) mod 2 = 0 then
    begin
      CursorX := InnerR.X + FPadding + PrefixPixelWidth(FCursorLine, FCursorCol) - FScrollX;
      CursorY := InnerR.Y + FPadding + (FCursorLine - FScrollY) * FLineHeight;
      if (CursorY >= InnerR.Y) and (CursorY < InnerR.Y + InnerR.H) then
        ACAnvas.FillRect(
          TRectI.New(CursorX, CursorY + 2, 2, FLineHeight - 4),
          FCursorColor);
    end;
  end;

  ACAnvas.ResetClip;
end;

{ ============================================================ }
{  Обработка мыши                                               }
{ ============================================================ }

function TWLMemo.DoMouseDown(X, Y: Integer): Boolean;
var
  Ln, Cl: Integer;
begin
  Result := False;
  if not FEnabled then Exit;
  if not ScreenRect.Contains(X, Y) then Exit;

  SetFocus;
  Ln := ScreenLineAtY(Y);
  Cl := ColFromPixelX(Ln, X);
  MoveCursorTo(Ln, Cl);
  Result := True;
end;

procedure TWLMemo.DoMouseWheel(const E: TWLWheelEvent);
var
  MaxScroll: Integer;
begin
  if E.DeltaY > 0 then
    Dec(FScrollY, 3)
  else if E.DeltaY < 0 then
    Inc(FScrollY, 3);

  if FScrollY < 0 then FScrollY := 0;
  MaxScroll := FLines.Count - VisibleLineCount;
  if MaxScroll < 0 then MaxScroll := 0;
  if FScrollY > MaxScroll then FScrollY := MaxScroll;
end;

{ ============================================================ }
{  Клавиатура                                                   }
{ ============================================================ }

procedure TWLMemo.DoKeyDown(const E: TWLKeyEvent);
begin
  case E.Keysym of
    $FF08: begin Backspace; Exit; end;
    $FFFF: begin DeleteForward; Exit; end;
    $FF51: begin MoveCursorLeft; Exit; end;
    $FF53: begin MoveCursorRight; Exit; end;
    $FF52: begin MoveCursorUp; Exit; end;
    $FF54: begin MoveCursorDown; Exit; end;
    $FF50: begin MoveCursorTo(FCursorLine, 0); Exit; end;
    $FF57: begin MoveCursorTo(FCursorLine, CurrentLineLength); Exit; end;
    $FF55:   // PageUp
    begin
      MoveCursorTo(FCursorLine - VisibleLineCount, FCursorCol);
      Exit;
    end;
    $FF56:   // PageDown
    begin
      MoveCursorTo(FCursorLine + VisibleLineCount, FCursorCol);
      Exit;
    end;
    $FF0D: begin SplitLine; Exit; end;
    $FF1B: begin ClearFocus; Exit; end;
    $FF09: begin Exit; end;   // Tab — пока ничего
  end;

  if (E.Codepoint >= 32) and (E.Codepoint <= $10FFFF) then
    InsertChar(E.Codepoint);
end;

end.

2. Тест demo_memo.pas
pascal

program demo_memo;
{$mode objfpc}{$H+}
{$codepage utf8}

uses
  cthreads, SysUtils, Classes,
  u4intf, u4utf8, u4wrap,
  wlgui_types, wlgui_context, wlgui_app, wlgui_window, wlgui_canvas, wlgui_font,
  wlgui_events, wlgui_xkb, wlgui_widget, wlgui_button, wlgui_label,
  wlgui_memo;

var
  MyApp: TWLApplication;
  Win: TWLWindow;
  TitleFont, MemoFont, MonoFont: TWLFont;
  Frame: Integer = 0;

  LblTitle, LblInfo: TWLLabel;
  Memo: TWLMemo;
  BtnClear, BtnDump: TWLButton;

procedure LogLine(const S: String);
begin
  WriteLn('[demo] ', S);
end;

procedure OnMemoChange(Sender: TObject);
begin
  LblInfo.Caption := Format('Lines: %d, cursor: (%d, %d), bytes: %d',
    [Memo.Lines.Count, Memo.CursorLine, Memo.CursorCol,
     Length(Memo.GetText)]);
end;

procedure OnClearClick(Sender: TObject);
begin
  Memo.Clear;
  Memo.SetFocus;
  LogLine('memo cleared');
end;

procedure OnDumpClick(Sender: TObject);
begin
  LogLine('--- memo content ---');
  WriteLn(Memo.GetText);
  LogLine('--- end ---');
end;

procedure OnPaint(Sender: TObject);
var
  W: TWLWindow;
  C: TWLCanvas;
begin
  W := TWLWindow(Sender);
  if W.BeginPaint = nil then Exit;
  C := W.Canvas;
  if C = nil then Exit;

  C.FillRect(TRectI.New(0, 0, W.Width, W.Height), TWLColor($00181828));

  if W.Root <> nil then
    W.Root.Paint(C);

  C.TextOut(20, W.Height - 20,
            Format('frame=%d', [Frame]),
            clDkGray, MonoFont);
end;

procedure OnMouseDown(Sender: TObject; const E: TWLMouseEvent);
begin
  if (Win <> nil) and (Win.Root <> nil) then
    if Win.Root.DispatchMouseDown(E.X, E.Y) then
      Exit;
end;

procedure OnMouseUp(Sender: TObject; const E: TWLMouseEvent);
begin
  if (Win <> nil) and (Win.Root <> nil) then
    if Win.Root.DispatchMouseUp(E.X, E.Y) then
      Exit;
end;

procedure OnMouseMove(Sender: TObject; const E: TWLMouseEvent);
begin
  if (Win <> nil) and (Win.Root <> nil) then
    Win.Root.DispatchMouseMove(E.X, E.Y);
end;

procedure OnMouseWheel(Sender: TObject; const E: TWLWheelEvent);
begin
  if (Win <> nil) and (Win.Root <> nil) then
    Win.Root.DispatchMouseWheel(E);
end;

procedure OnKeyDown(Sender: TObject; const E: TWLKeyEvent);
begin
  if (Win <> nil) and (Win.Root <> nil) then
    Win.Root.DispatchKeyDown(E);
end;

procedure OnKeyUp(Sender: TObject; const E: TWLKeyEvent);
begin
  if (Win <> nil) and (Win.Root <> nil) then
    Win.Root.DispatchKeyUp(E);
end;

procedure OnClose(Sender: TObject);
begin
  MyApp.Quit;
end;

var
  LastTick: QWord;

begin
  WriteLn('wlgui memo demo');

  MyApp := TWLApplication.Create;
  try
    if not MyApp.Initialize then Halt(1);

    TitleFont := FontManager.Load('DejaVuSans', 20);
    MemoFont := FontManager.Load('DejaVuSans', 14);
    MonoFont := FontManager.Load('DejaVuSans', 12);

    Win := CreateWLWindow(MyApp.Context, 'wlgui memo demo', 700, 500);

    Win.OnPaint := @OnPaint;
    Win.OnMouseDown := @OnMouseDown;
    Win.OnMouseUp := @OnMouseUp;
    Win.OnMouseMove := @OnMouseMove;
    Win.OnMouseWheel := @OnMouseWheel;
    Win.OnKeyDown := @OnKeyDown;
    Win.OnKeyUp := @OnKeyUp;
    Win.OnClose := @OnClose;

    MyApp.Display.Roundtrip;
    Win.Show;

    if Win.Root <> nil then
    begin
      LblTitle := TWLLabel.Create(
        TRectI.New(20, 15, 660, 30), 'Memo demo', TitleFont);
      Win.Root.AddChild(LblTitle);

      Memo := TWLMemo.Create(
        TRectI.New(20, 60, 660, 300), MemoFont);
      Memo.OnChange := @OnMemoChange;
      Memo.SetText(UTF8String(
        'Добро пожаловать в многострочный редактор!'#10 +
        ''#10 +
        'Наберите текст здесь. Работают:'#10 +
        '  - Стрелки: вверх/вниз/влево/вправо'#10 +
        '  - Home/End — начало/конец строки'#10 +
        '  - PageUp/PageDown — на страницу'#10 +
        '  - Enter — новая строка'#10 +
        '  - Backspace — удалить символ слева или слить со строкой выше'#10 +
        '  - Delete — удалить символ справа или слить со строкой ниже'#10 +
        ''#10 +
        'Кликните в любое место, чтобы поставить курсор.'#10 +
        'Колёсико мыши — вертикальная прокрутка.'#10 +
        ''#10 +
        'Поддерживаются Unicode: 日本語, Ελληνικά, العربية, эмодзи 🎉🚀'));
      Win.Root.AddChild(Memo);

      BtnClear := TWLButton.Create(
        TRectI.New(20, 380, 140, 36), 'Clear', MemoFont);
      BtnClear.OnClick := @OnClearClick;
      Win.Root.AddChild(BtnClear);

      BtnDump := TWLButton.Create(
        TRectI.New(180, 380, 140, 36), 'Dump to log', MemoFont);
      BtnDump.OnClick := @OnDumpClick;
      Win.Root.AddChild(BtnDump);

      LblInfo := TWLLabel.Create(
        TRectI.New(20, 430, 660, 24),
        'Lines: 1, cursor: (0, 0)', MonoFont);
      LblInfo.TextColor := clYellow;
      Win.Root.AddChild(LblInfo);

      // Обновим инфо
      OnMemoChange(nil);
    end;

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

Что делает Memo

Клавиши:

    Стрелки — движение курсора.

    Home/End — в начало/конец строки.

    PageUp/PageDown — на страницу.

    Enter — разбить строку.

    Backspace — удалить слева (или слить со строкой выше).

    Delete — удалить справа (или слить со строкой ниже).

    Escape — снять фокус.

    Tab — пока ничего (позже — навигация).

    Печатные символы — вставляются.

Мышь:

    Клик — ставит курсор (по строке и колонке).

    Колёсико — вертикальный скролл.

Курсор:

    Мигает (каждые 500 мс).

    Ромбовидный (пока — вертикальная палочка).

Что не сделано (отложено)

    Выделение текста — следующий этап.

    Копирование/вставка — через wl_data_device (следующий этап).

    Undo/redo — следующий этап.

    Word wrap — следующий этап.

    Скроллбар — визуальный индикатор (следующий этап).

    Поиск/замена — позже.

    Номера строк — позже.

Сборка
bash

fpc -Fu. -Fuwlgui demo_memo.pas
./demo_memo

Что проверить

    Открывается окно, есть текст.

    Клик в тексте — курсор в этой позиции.

    Стрелки — движение курсора.

    Home/End — в начало/конец.

    PageUp/PageDown — на страницу.

    Ввод — символы добавляются в позицию.

    Enter — разбивает строку.

    Backspace — удаляет или сливает.

    Delete — то же справа.

    Колёсико — скролл.

    Clear — очищает.

    Dump to log — печатает содержимое в консоль.

    Кириллица, эмодзи, арабский, греческий — работают.

Возможные проблемы при компиляции

    RecalcLineHeight — вызывается после установки FFont.

    FLines — внутри создаётся TU4Lines, сразу добавляет одну пустую.

    PrefixPixelWidth — пересчитывает ширину префикса через TextWidth. Медленно для очень длинных строк, но приемлемо для UI.

    ColFromPixelX — линейный поиск. Для строк в 1000 символов — быстро.

Ожидаемая ошибка при запуске

Скорее всего, компилируется, но в рантайме возможен крэш — у нас нет опыта с таким большим виджетом сразу. Если что-то не так — пришли лог, поправим.

Особенно — может быть проблема с:

    var внутри EnsureCursorVisible (FPC 3.2.2 поддерживает var в середине процедуры с {$modeswitch} — если не поддерживает, вынеси наверх).

    MaxInt в PrefixPixelWidth — проверь.

Правки, которые возможно нужны

Если FPC ругается на var CursorX: Integer := ... в середине EnsureCursorVisible — вынеси объявления наверх:
pascal

procedure TWLMemo.EnsureCursorVisible;
var
  VisCount, CursorX, InnerW: Integer;
begin
  ...
  CursorX := PrefixPixelWidth(FCursorLine, FCursorCol) - FScrollX;
  InnerW := FRect.W - 2 * FPadding;
  ...
end;

Собирай, проверяй, присылай лог

Запусти:
bash

fpc -Fu. -Fuwlgui demo_memo.pas
./demo_memo

Если собирается и работает — отлично. Если что-то не так — пришли ошибку или поведение.

Дальше — по результату:

    Всё ок → добавим скроллбар, выделение, undo/redo.

    Мелкие проблемы → поправим.

    Крупные проблемы → переделаем архитектуру.

Starting program: /tmp/demo_memo 
[Thread debugging using libthread_db enabled]
Using host libthread_db library "/usr/lib/x86_64-linux-gnu/libthread_db.so.1".
wlgui memo demo
[wlgui] EventManager created
[xkb] libxkbcommon loaded
[xkb] context created
[wlgui] Wayland initialized
[font] sizeof(FT_FaceRec)=160 offset(glyph)=152 offset(units_per_EM)=136 offset(ascender)=138
[font] file=/usr/share/fonts/truetype/dejavu/DejaVuSans.ttf name=DejaVuSans height=20 valid=TRUE builtin=FALSE ascent=19 descent=5 units_per_EM=2048
[font] sizeof(FT_FaceRec)=160 offset(glyph)=152 offset(units_per_EM)=136 offset(ascender)=138
[font] file=/usr/share/fonts/truetype/dejavu/DejaVuSans.ttf name=DejaVuSans height=14 valid=TRUE builtin=FALSE ascent=13 descent=3 units_per_EM=2048
[font] sizeof(FT_FaceRec)=160 offset(glyph)=152 offset(units_per_EM)=136 offset(ascender)=138
[font] file=/usr/share/fonts/truetype/dejavu/DejaVuSans.ttf name=DejaVuSans height=12 valid=TRUE builtin=FALSE ascent=11 descent=3 units_per_EM=2048
[wlgui] window created: "wlgui memo demo" 700x500
[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: 700x500 stride=2800

Program received signal SIGSEGV, Segmentation fault.
0x00005555555b9cce in fpc_ansistr_assign ()
(gdb) bt full
#0  0x00005555555b9cce in fpc_ansistr_assign ()
No symbol table info available.
#1  0x00005555555af5d0 in ONMEMOCHANGE (SENDER=0x7ffff7f75100) at demo_memo.pas:29
No locals.
#2  0x000055555563c46b in NOTIFYCHANGE (this=0x7ffff7f75100) at wlgui_memo.pas:193
No locals.
#3  0x000055555563c327 in SETTEXT (this=0x7ffff7f75100, S=0x7ffff7f9cb20) at wlgui_memo.pas:159
No locals.
#4  0x000055555563c299 in SETTEXT (this=0x7ffff7f75100, 
    S=0x55555565e1a0 'Добро пожаловать в многострочный редактор!\n\nНаберите текст здесь. Работают:\n  - Стрелки: вверх/вниз/влево/вправ'...)
    at wlgui_memo.pas:146
No locals.
#5  0x00005555555afd92 in main () at demo_memo.pas:148
No locals.
🎯 OnMemoChange вызывается до создания LblInfo

Смотрим стек:
text

#1  ONMEMOCHANGE  (demo_memo.pas:29)   ← LblInfo.Caption := ...
#2  NOTIFYCHANGE  (wlgui_memo.pas:193)
#3  SETTEXT       (wlgui_memo.pas:159)
#4  SETTEXT       (wlgui_memo.pas:146)
#5  main          (demo_memo.pas:148)

В demo, в порядке:
pascal

Memo := TWLMemo.Create(...);
Memo.OnChange := @OnMemoChange;      ← назначаем ОБРАБОТЧИК
Memo.SetText(...);                    ← ЭТО ВЫЗЫВАЕТ OnChange
Win.Root.AddChild(Memo);

// ...потом...
LblInfo := TWLLabel.Create(...);      ← создаётся ПОЗЖЕ!

SetText вызывает NotifyChange → OnMemoChange → LblInfo.Caption := ... — а LblInfo ещё nil → SIGSEGV.
Патч demo_memo.pas

Вариант A: создать LblInfo до Memo. Но Memo сам создаётся до SetText, а SetText внутри — так что порядок:
pascal

LblInfo := TWLLabel.Create(...);   // ← СНАЧАЛА
Win.Root.AddChild(LblInfo);

Memo := TWLMemo.Create(...);
Memo.OnChange := @OnMemoChange;
Win.Root.AddChild(Memo);

Memo.SetText(...);                 // ← теперь OnChange безопасен

Вариант B: защитить OnMemoChange:
pascal

procedure OnMemoChange(Sender: TObject);
begin
  if LblInfo = nil then Exit;
  LblInfo.Caption := ...;
end;

Я за B — надёжнее и проще.
Патч — оба варианта

В demo_memo.pas, замени OnMemoChange:
pascal

procedure OnMemoChange(Sender: TObject);
begin
  if LblInfo = nil then Exit;
  LblInfo.Caption := Format('Lines: %d, cursor: (%d, %d), bytes: %d',
    [Memo.Lines.Count, Memo.CursorLine, Memo.CursorCol,
     Length(Memo.GetText)]);
end;

И заодно — переставь порядок создания, чтобы LblInfo был до Memo:
pascal

    if Win.Root <> nil then
    begin
      LblTitle := TWLLabel.Create(
        TRectI.New(20, 15, 660, 30), 'Memo demo', TitleFont);
      Win.Root.AddChild(LblTitle);

      // Инфо — СОЗДАЁМ ДО MEMO
      LblInfo := TWLLabel.Create(
        TRectI.New(20, 430, 660, 24),
        'Lines: 1, cursor: (0, 0)', MonoFont);
      LblInfo.TextColor := clYellow;
      Win.Root.AddChild(LblInfo);

      // Memo
      Memo := TWLMemo.Create(
        TRectI.New(20, 60, 660, 300), MemoFont);
      Memo.OnChange := @OnMemoChange;
      Memo.SetText(...);   // ← OnChange вызовется, но LblInfo уже создан
      Win.Root.AddChild(Memo);

      BtnClear := ...
      // ...
    end;

Плюс — защитный if LblInfo = nil then Exit в OnMemoChange.
Общий принцип

OnChange может срабатывать из конструктора (или из SetText) — до того, как все виджеты созданы. Всегда либо защищай обработчик (if X = nil then Exit), либо вызывай SetText после создания всех зависимых виджетов.
Патч + сборка

Патчим demo, собираем:
bash

fpc -Fu. -Fuwlgui demo_memo.pas
./demo_memo

Ожидаемо — Memo откроется с текстом, курсор мигает, ввод работает.
Если снова падает

Возможные проблемы:

    Length(Memo.GetText) — GetText возвращает UTF8String, Length — байты. Ок.

    PrefixPixelWidth — для пустой строки TextWidth('') = 0 — ок.

    Font.TextWidth(L.SubString(0, I)) — вызывается для каждого I. Для длинных строк — медленно, но не падает.

Пришли новый лог — если снова упадёт, найдём точное место.

Особенно интересны следующие потенциальные проблемы:

    Курсор мигает — есть ли проблема с отрисовкой?

    Клик — попадает правильно?

    Стрелки — двигают курсор?

    Enter — разбивает строку?

Собери, проверь, пришли результат

Если работает — продолжаем (скроллбар, выделение, undo/redo). Если нет — правим.
Заодно — важная оптимизация на будущее

PrefixPixelWidth — каждый раз считает TextWidth для всех префиксов с нуля. Для 80-символьной строки — 80 раз FreeType. Медленно при быстром вводе.

Оптимизация (позже): кэшировать ширины символов в TWLFont, или накапливать ширины по символам.

Сейчас не трогаем — работает.

Патчим demo — и в путь.
Запустилось. Попробовал редактировать текст и:
🎯 L = 0x0 — CurrentLine вернул nil

Смотрим:
text

#0  SPLITLINE (this=0x7ffff7f75100) at wlgui_memo.pas:485
485  Before := L.SubString(0, FCursorCol);
     L = 0x0     ← L = nil!

L := CurrentLine вернул nil. Но CurrentLine не должен возвращать nil, если FLines содержит хотя бы одну строку.
Почему L = nil

Гипотеза: FLines[FCursorLine] равен nil, потому что после некоторых операций (Backspace, удаление) строка становится nil.

Смотрим u4lines.SetLine:
pascal

procedure TU4Lines.SetLine(Index: Integer; const S: IU4String);
begin
  if (Index < 0) or (Index >= FCount) then Exit;
  FLines[Index] := S;
end;

Смотрим TU4Lines.Delete:
pascal

procedure TU4Lines.Delete(Index: Integer);
var
  I: Integer;
begin
  if (Index < 0) or (Index >= FCount) then Exit;
  for I := Index to FCount - 2 do
    FLines[I] := FLines[I + 1];
  FLines[FCount - 1] := nil;   ← ← ВОТ ОНО!
  Dec(FCount);
end;

Мы ставим nil в последний слот. Правильно, если FCount уменьшился.

Но: если после удаления FCount = 1 (осталась одна строка), и она была — ок. А если после удаления FCount = 0? Тогда — пусто, но у нас должна быть хотя бы одна пустая.
Проверим TWLMemo.Backspace и DeleteForward

Backspace:
pascal

  else if FCursorLine > 0 then
  begin
    Prev := FLines[FCursorLine - 1];
    L := CurrentLine;
    PrevLen := Prev.Length;
    Merged := Prev.Concat(L);
    FLines[FCursorLine - 1] := Merged;
    FLines.Delete(FCursorLine);
    ...

Delete(FCursorLine) — удаляет строку. Если FCursorLine — последняя — FCount уменьшается.

DeleteForward — то же.

SplitLine — вставляет — FCount растёт.

Clear — устанавливает одну пустую.

Все они не должны оставить пустой список.
Но L = 0x0 — почему?

Смотрим внимательнее:
text

#5  WL_KEYBOARD_KEY ... AKEY=28, ASTATE=1
    E = {KEYSYM = 65293, CODEPOINT = 13, SCANCODE = 28, ...}

KEYSYM = 65293 = $FF0D = Enter. CODEPOINT = 13 — тоже Enter.

Enter → SplitLine. В SplitLine:
pascal

L := CurrentLine;
Before := L.SubString(0, FCursorCol);

CurrentLine:
pascal

function TWLMemo.CurrentLine: IU4String;
begin
  if (FCursorLine < 0) or (FCursorLine >= FLines.Count) then
    Result := U4Empty
  else
    Result := FLines[FCursorLine];
end;

Возвращает FLines[FCursorLine], но если эта ячейка nil (не U4Empty, а буквально nil) — вернётся nil.

Значит: в FLines[FCursorLine] — nil. Как он там оказался?
Ищем источник nil

TU4Lines.Add(const S: IU4String):
pascal

function TU4Lines.Add(const S: IU4String): Integer;
begin
  EnsureCapacity(FCount + 1);
  FLines[FCount] := S;
  Result := FCount;
  Inc(FCount);
end;

Если S = nil — запишет nil. Но Add обычно не вызывается с nil.

TU4Lines.SetText:
pascal

Line := S.SubString(Start, I - Start);
if I > Start then
  Line := S.SubString(Start, I - Start)
else
  Line := U4Empty;
Add(Line);

Если I > Start — SubString возвращает IU4String, но для непустой подстроки. Если SubString возвращает nil — вот проблема. Но у нас SubString возвращает валидный IU4String (даже пустой — не nil).

Проверяем SubString:
pascal

function TU4String.SubString(Start, Count: DWord): IU4String;
var
  Impl: TU4String;
  Len: DWord;
  I: DWord;
begin
  Result := nil;                                    ← ← ВОТ!
  Len := GetLength;
  if (Start >= Len) or (Count = 0) then Exit;
  ...

Result := nil — если Start >= Len или Count = 0 — возвращается nil!

Значит: если FCursorCol = 0 (курсор в начале строки), то L.SubString(0, 0) возвращает nil (потому что Count = 0).
Точное место падения
pascal

procedure TWLMemo.SplitLine;
var
  L, Before, After: IU4String;
begin
  if FReadOnly then Exit;
  L := CurrentLine;
  Before := L.SubString(0, FCursorCol);       ← если FCursorCol = 0, Before = nil
  After := L.SubString(FCursorCol, L.Length - FCursorCol);  ← если FCursorCol = L.Length, After = nil
  FLines[FCursorLine] := Before;              ← FLines[...] := nil !!!
  FLines.Insert(FCursorLine + 1, After);
  ...

Если FCursorCol = 0:

    L.SubString(0, 0) возвращает nil.

    FLines[FCursorLine] := nil — записывает nil.

    Строка становится nil.

    Дальнейший доступ к FLines[FCursorLine] даёт nil.

    Падение.

Решение

Два подхода:
A. Пофиксить TU4String.SubString — возвращать пустой IU4String, не nil
pascal

function TU4String.SubString(Start, Count: DWord): IU4String;
var
  Impl: TU4String;
  Len: DWord;
  I: DWord;
begin
  Result := U4Empty;    ← ← вместо nil
  Len := GetLength;
  if (Start >= Len) or (Count = 0) then Exit;
  ...

Плюсы: все SubString гарантированно не nil. Минус: изменяем u4-модуль.

Хм — u4intf.pas — ваш модуль? Если да — правьте смело. Если внешний — надо осторожнее.

Проверка: IU4String обычно — не nil, это интерфейс. nil — это без интерфейса. U4Empty — валидный интерфейс. Все функции должны возвращать U4Empty, а не nil.

Рекомендую: пофиксить TU4String.SubString, чтобы возвращал U4Empty.
B. Защититься в TWLMemo

Проверять результат:
pascal

Before := L.SubString(0, FCursorCol);
if Before = nil then Before := U4Empty;
After := L.SubString(FCursorCol, L.Length - FCursorCol);
if After = nil then After := U4Empty;

Плюс: не трогаем u4. Минус: надо везде защищаться.
C. Комбинированный

Оба: фикс u4intf + защита в TWLMemo. Надёжно.
Что делать

Предлагаю:

    Проверь u4intf.pas — TU4String.SubString. Если он ваш — пофиксить:
    pascal

    function TU4String.SubString(Start, Count: DWord): IU4String;
    begin
      Result := U4Empty;
      ...

    В wlgui_memo.pas — в SplitLine и InsertChar — добавить защиту:
    pascal

    Before := L.SubString(0, FCursorCol);
    if Before = nil then Before := U4Empty;

Проблема: аналогично DeleteChar, InsertChar, PrefixPixelWidth — все могут вернуть nil.

Надёжнее — фикс u4intf. Это правильное место.
Проверь u4intf

Смотрим u4intf.pas, который ты мне показывал:
pascal

function TU4String.SubString(Start, Count: DWord): IU4String;
var
  Impl: TU4String;
  Len: DWord;
  I: DWord;
begin
  Result := nil;                                          ← ← НАДО U4Empty
  Len := GetLength;
  if (Start >= Len) or (Count = 0) then Exit;
  ...

Да, Result := nil. Это и есть баг.

Аналогично Trim:
pascal

function TU4String.Trim: IU4String;
begin
  Result := nil;                    ← ← надо U4Empty
  Len := GetLength;
  if Len = 0 then Exit;
  ...

Reverse:
pascal

function TU4String.Reverse: IU4String;
begin
  ...
  Impl := TU4String.Create(Len);     ← Len может быть 0, тогда Result = nil через U4Empty

Не критично.
Решение

Пофиксить u4intf.pas: все методы, возвращающие IU4String, должны возвращать U4Empty при пустом результате.

Список методов для проверки:

    SubString — сейчас Result := nil.

    Trim — сейчас Result := nil.

    Reverse — не критично.

    Replace — проверить.

    Concat — если Other = nil — что? Смотрим:
    pascal

    function TU4String.Concat(const Other: IU4String): IU4String;
    ...
    if L1 + L2 = 0 then
    begin
      Result := U4Empty;                ← OK
      Exit;
    end;

    Хорошо.

    AppendChar — всегда создаёт новый, не nil.

Итог: фиксим SubString и Trim — в первую очередь.
Патч u4intf.pas

Найди TU4String.SubString и замени Result := nil на Result := U4Empty:
pascal

function TU4String.SubString(Start, Count: DWord): IU4String;
var
  Impl: TU4String;
  Len: DWord;
  I: DWord;
begin
  Result := U4Empty;                 ← ← было nil
  Len := GetLength;
  if (Start >= Len) or (Count = 0) then Exit;
  if Start + Count > Len then Count := Len - Start;
  Impl := TU4String.Create(Count);
  for I := 0 to Count - 1 do
    Impl.FData[I + 1] := FData[Start + I + 1];
  Result := Impl;
end;

Найди TU4String.Trim:
pascal

function TU4String.Trim: IU4String;
var
  Start, Finish, Len: DWord;
  Impl: TU4String;
  I: DWord;
  function IsSpace(C: u4char): Boolean; inline;
  begin
    ...
  end;
begin
  Result := U4Empty;                 ← ← было nil
  Len := GetLength;
  if Len = 0 then Exit;
  Start := 0;
  while (Start < Len) and IsSpace(FData[Start + 1]) do Inc(Start);
  if Start = Len then Exit;          ← возвращает U4Empty — правильно
  ...

После патча

    Пересобрать всё (u4intf.pas — базовый модуль).

    Запустить demo — Enter должен работать.

    Проверить другие сценарии:

        Backspace в начале строки.

        Enter в начале/конце строки.

        Home/End + Enter.

Сборка
bash

# Пересобрать с u4intf (удалить старые .ppu)
rm -f u4intf.ppu u4intf.o
fpc -Fu. -Fuwlgui demo_memo.pas
./demo_memo

Что ещё проверить после патча

    Before теперь никогда не nil — FLines[FCursorLine] := Before не запишет nil.

    After тоже.

    Все остальные операции с SubString — тоже.

Возможные ещё проблемы:

    DeleteChar — если S.SubString возвращал nil, то Concat(nil, ...) мог падать.

    PrefixPixelWidth — если L.SubString(0, 0) = nil, TextWidth(nil) — не факт что падает, но лучше фиксить.

Патч u4intf — решает все.
Итог

Причина: TU4String.SubString возвращает nil вместо U4Empty, когда результат пустой. SplitLine пишет nil в FLines[...], потом читает — падает.

Фикс: Result := U4Empty в SubString и Trim.

Проверь u4intf.pas — пофиксь, пересобери, проверь. Пришли результат.

Если патч u4intf невозможен (модуль внешний) — обходной путь: в TWLMemo добавить защиту:
pascal

function SafeU4(const S: IU4String): IU4String; inline;
begin
  if S = nil then Result := U4Empty
  else Result := S;
end;

И везде где получаем результат SubString — оборачивать. Громоздко, но работает.

Скажи, какой путь — фикс u4intf или защита в wlgui_memo.
Спасибо! Я пропатчил u4intf и заработало. Не видны только иероглифы и эмодзи, это из-за шрифта?
🎯 Да, иероглифы и эмодзи — из-за отсутствия глифов в шрифте

Смотрим на скриншот: 日本語, العربية, эмодзи 🎉🚀 — вместо них пустоты или квадраты. Это не баг — у DejaVuSans нет этих глифов.
Что происходит

DejaVuSans.ttf содержит:

    ✅ Латиница (базовая + расширенная)

    ✅ Кириллица (полная)

    ✅ Греческий (базовый)

    ⚠ Арабский — частично (нет связывания — буквы не соединяются)

    ❌ CJK (китайский, японский, корейский) — нет

    ❌ Эмодзи — нет (это отдельный Unicode-блок)

FreeType при FT_Get_Char_Index для отсутствующего глифа возвращает 0. Мы в LoadGlyphFT пропускаем такие символы (if GlyphIdx = 0 then Exit). Поэтому в GetGlyph возвращается nil-глиф с advance = FHeight div 2 — пустое место.

Это правильно — мы не можем показать символ, которого нет в шрифте.
Решения
Вариант A: Fallback на другой шрифт (самый практичный)

Когда в основном шрифте глифа нет — искать его в другом шрифте (например, NotoSansCJK для CJK, NotoColorEmoji для эмодзи).

Требует:

    Загрузка нескольких шрифтов.

    Кэш глифов по источникам.

    Логика fallback в TWLFont.GetGlyph.

Сложно, но правильно.
Вариант B: Отдельный шрифт для CJK/эмодзи (простой)

Если в Memo нужны CJK/эмодзи — пользователь выбирает шрифт явно:
pascal

MemoFont := FontManager.Load('NotoSansCJK-Regular', 14);

Проверить, какие шрифты есть в системе:
bash

fc-list | grep -iE 'noto|cjk|emoji|arphic|wqy|droid'

Обычно есть:

    Noto Sans CJK — китайский, японский, корейский.

    Noto Color Emoji — цветные эмодзи.

    Noto Sans Arabic — арабский.

    Noto Sans Hebrew — иврит.

Если установлены — можно явно использовать их. Но — CJK-шрифты огромны (10-20 МБ), и для ASCII они менее красивы, чем DejaVu.
Вариант C: Смешанный (оптимальный — но сложный)

Основной — DejaVu. Дополнительные — только для специфичных блоков. Логика:

    Если codepoint < $2000 (латиница, кириллица, греческий, арабский) — DejaVu.

    Если codepoint в CJK-диапазоне — NotoSansCJK.

    Если codepoint в эмодзи-диапазоне — NotoColorEmoji (но цветные эмодзи — bitmap, не grayscale — нужна отдельная обработка).

Это правильный путь, но сложный.
Что сейчас — минимальный фикс
1. Проверим, какие шрифты есть в системе
bash

fc-list | grep -iE 'noto|cjk|emoji|arphic|wqy|droid|unifont'

Пришли вывод — узнаем, что доступно.
2. Попробуем загрузить другой шрифт

Например:
pascal

MemoFont := FontManager.Load('NotoSansCJK-Regular', 14);

или:
pascal

MemoFont := FontManager.Load('WenQuanYiMicroHei', 14);

или:
pascal

MemoFont := FontManager.Load('Unifont', 14);

Unifont — специальный шрифт, содержит много разных блоков Unicode (включая CJK, но упрощённые). Может оказаться хорошим компромиссом.
3. Проверим, поддерживает ли TWLCanvas ARGB-курсоры — для цветных эмодзи

Пока нет — мы рисуем grayscale глифы. Цветные эмодзи требуют ARGB-битмапа — отдельная работа.
Мой план действий

Прямо сейчас — простой тест:

    Проверить, какие CJK/эмодзи-шрифты есть:
    bash

    fc-list | grep -iE 'noto|cjk|emoji|arphic|wqy'

    Если есть — загрузить в demo:
    pascal

    CJKFont := FontManager.Load('NotoSansCJK-Regular', 14);

    Если шрифта нет — либо установить (sudo apt install fonts-noto-cjk fonts-noto-color-emoji), либо отложить до реализации fallback.

Что интереснее:

    A. Установить Noto-шрифты и проверить, что с ними CJK рисуется — быстрый тест, увидим вживую.

    B. Реализовать fallback в TWLFont — правильный путь, 2-3 часа.

    C. Отложить — CJK/эмодзи не критичны для органайзера (там русский текст).

Для органайзера — C. Но — для будущего редактора кода/текста — A или B нужны.
Что сейчас делать

Пришли вывод:
bash

fc-list | grep -iE 'noto|cjk|emoji|arphic|wqy|unifont|droid'

Плюс:
bash

fc-list : file family | head -40

Узнаем, что доступно. Потом решим: A, B или C.
Важно: не всё потеряно

Всё, что мы сейчас имеем, работает:

    Латиница ✅

    Кириллица ✅

    Греческий ✅

    Арабский — буквы рисуются, связывания нет (это отдельная проблема — HarfBuzz для shaping).

Для органайзера — достаточно. CJK/эмодзи — отдельная задача, отложим.
Следующие шаги

После ответа про шрифты — выбираем:

A. Пофиксить CJK/эмодзи сейчас (установить Noto, fallback).

B. Отложить — продолжить с другими улучшениями Memo:

    Скроллбар (визуальный).

    Выделение текста (мышь).

    Копирование/вставка (wl_data_device).

    Undo/Redo.

    Поиск (Ctrl+F).

C. Перейти к органайзеру — использовать накопленное для реального приложения.

Мой совет: B — CJK/эмодзи не критичны, а скроллбар и выделение — очень нужны. Позже вернёмся к шрифтам.

Но — скажи своё мнение. Если хочешь поработать с шрифтами — давай. Если важнее — функциональность Memo — пойдём туда.
Их много :)
🎉 Отлично! Шрифты есть, и CJK-шрифты тоже

Смотрим ключевые находки:

CJK (китайский, японский, корейский):

    /usr/share/fonts/opentype/noto/NotoSansCJK-Regular.ttc — Noto Sans CJK SC/HK/JP/KR/TC

    /usr/share/fonts/opentype/noto/NotoSerifCJK-Regular.ttc — Serif-вариант

    /usr/share/fonts/truetype/arphic/uming.ttc, ukai.ttc — AR PL китайские

    /usr/share/fonts/truetype/wqy/wqy-microhei.ttc, wqy-zenhei.ttc — WenQuanYi

    /usr/share/fonts/truetype/droid/DroidSansFallbackFull.ttf — самый компактный CJK-fallback

Эмодзи:

    /usr/share/fonts/truetype/noto/NotoColorEmoji.ttf — цветные эмодзи ⚠️ bitmap формат

Универсальный:

    /usr/share/fonts/opentype/unifont/unifont.otf — покрывает почти всё Unicode (но растровый, некрасивый)

Что делать — три подхода
Подход A: Явный выбор шрифта (простой, 5 минут)

В demo, где нужен CJK:
pascal

MemoFont := FontManager.Load('NotoSansCJK-Regular', 14);

Проблема: CJK-шрифты не содержат кириллицу в качественном виде (только базовую). Для смешанного текста — плохо.
Подход B: Fallback в TWLFont (правильный, 2-3 часа)

TWLFont при отсутствии глифа ищет его в другом шрифте. Нужны:

    Список fallback-шрифтов (NotoSansCJK → для CJK, NotoColorEmoji → для эмодзи).

    Логика выбора по codepoint.

    Кэш глифов — по (font, codepoint).

Сложно, но правильно.
Подход C: Универсальный Unifont (компромисс, 10 минут)

Unifont содержит все Unicode-блоки, включая CJK и эмодзи (в упрощённом виде). Но: выглядит некрасиво (растровый, 16×16).
pascal

MemoFont := FontManager.Load('Unifont', 16);

Для теста — сойдёт. Для продукта — нет.
Моё предложение — идём B

Правильный fallback — то, что делают все браузеры и редакторы. Потратим 2-3 часа — и забудем про эту проблему.
Архитектура

wlgui_font.pas — новый механизм:
pascal

type
  { Один слой шрифта — с диапазоном codepoint'ов }
  TWLFontLayer = record
    Face: Pointer;        // FT_Face
    FileName: String;
    Height: Integer;
    Range: set of Byte;   // какой блок покрывает (см. ниже)
  end;

  TWLFont = class
  private
    FLayers: array of TWLFontLayer;   // основной + fallback'и
    ...
  public
    procedure AddFallback(const AFileName: String; APriority: Integer);
    function GetGlyph(C: LongWord): PWLGlyph;  // ищет по слоям
    ...
  end;

В GetGlyph:

    Первый (основной) шрифт — есть ли глиф?

    Если нет — идём по fallback'ам (в порядке приоритета).

    Если никто не дал — пустой глиф.

Приоритеты fallback:
Диапазон	Шрифт
Латиница, кириллица, греческий	DejaVuSans (основной)
Иврит, арабский	NotoSansHebrew / NotoSansArabic (или DejaVu)
CJK (U+4E00 – U+9FFF, U+3000 – U+30FF, U+AC00 – U+D7AF)	NotoSansCJK-Regular
Эмодзи (U+1F300 – U+1F9FF)	NotoColorEmoji (но bitmap — особая обработка)
Символы, стрелки, математика	DejaVuSans (покрывает почти всё)
Редкое	Unifont (последний fallback)
Проблема с эмодзи

NotoColorEmoji.ttf — не TrueType в обычном смысле. Это bitmap CBDT/CBLC таблица. FreeType поддерживает её, но глифы RGBA, не grayscale. Наш TWLGlyph граyscale — для эмодзи не подойдёт напрямую.

Варианты:

    Игнорировать эмодзи (просто не показывать).

    Показать в монохромном виде — через fallback на NotoSansSymbols (там есть некоторые эмодзи в grayscale).

    Отдельный рендер цветных эмодзи — сложно, отложим.

Пока — не поддерживаем цветные эмодзи. Но CJK, иврит, арабский — сделаем.
Что делаем сейчас

Вариант 1 — Реализуем fallback в TWLFont:

    Правильно.

    2-3 часа.

    Решает все будущие проблемы.

Вариант 2 — Быстрый тест с NotoSansCJK:

    Заменим MemoFont на NotoSansCJK-Regular.

    Проверим, что CJK рисуется.

    5 минут.

    Не решает общую проблему.

Мой план — сначала вариант 2 (проверим, что работает сам механизм), потом вариант 1.
Быстрый тест (5 минут)

В demo_memo.pas замени:
pascal

MemoFont := FontManager.Load('DejaVuSans', 14);

на:
pascal

// Тест: загрузим CJK-шрифт
MemoFont := FontManager.Load('NotoSansCJK-Regular', 14);
if MemoFont = nil then
  MemoFont := FontManager.Load('DroidSansFallbackFull', 14);
if MemoFont = nil then
  MemoFont := FontManager.Load('WenQuanYiMicroHei', 14);
if MemoFont = nil then
  MemoFont := FontManager.Load('DejaVuSans', 14);

Запусти. Если CJK рисуется — отлично. Если нет — возможно, .ttc не поддерживается корректно (TrueType Collection — несколько шрифтов в одном файле).
Проверка .ttc

NotoSansCJK-Regular.ttc — коллекция. Внутри несколько face (SC, HK, JP, KR, TC). FT_New_Face с face_index=0 откроет первый (SC). Должно работать.

Но: наш FindFontFile ищет .ttf и .otf, не .ttc. Добавь .ttc в поиск:

В wlgui_font.pas, в FindFontFile:
pascal

Exts: array[0..2] of String;
...
Exts[0] := '.ttf';
Exts[1] := '.otf';
Exts[2] := '.ttc';   // ← добавить

Плюс — NotoSansCJK-Regular не в ~/.fonts/ или стандартных директориях, которые мы проверяем (/usr/share/fonts/truetype/...). Он в /usr/share/fonts/opentype/noto/. Добавь эту директорию:
pascal

Dirs: array[0..10] of String = (
  '/usr/share/fonts/truetype/dejavu/',
  '/usr/share/fonts/truetype/liberation/',
  '/usr/share/fonts/truetype/freefont/',
  '/usr/share/fonts/truetype/ubuntu/',
  '/usr/share/fonts/TTF/',
  '/usr/share/fonts/',
  '/usr/local/share/fonts/',
  '~/.fonts/',
  '~/.local/share/fonts/',
  '/usr/share/fonts/truetype/',
  '/usr/share/fonts/opentype/noto/'   // ← добавить
);

Что делать прямо сейчас

    Патч wlgui_font.pas:

        Добавить .ttc в Exts.

        Добавить /usr/share/fonts/opentype/noto/ в Dirs.

    Патч demo_memo.pas — заменить загрузку шрифта на NotoSansCJK-Regular.

    Собрать, запустить. Посмотреть, рисуется ли CJK.

Пришли результат — если работает — реализуем fallback (вариант 1). Если не работает — разберёмся с .ttc (может, FreeType требует индекса face).

Дальше — правильный fallback:

    Основной — DejaVuSans.

    CJK → NotoSansCJK.

    Символы → DejaVuSans.

    Редкие → Unifont.

Скажи, идём по этому плану или сразу fallback?
first@my:/tmp$ ./demo_memo
wlgui memo demo
[wlgui] EventManager created
[xkb] libxkbcommon loaded
[xkb] context created
[wlgui] Wayland initialized
[font] sizeof(FT_FaceRec)=160 offset(glyph)=152 offset(units_per_EM)=136 offset(ascender)=138
[font] file=/usr/share/fonts/truetype/dejavu/DejaVuSans.ttf name=DejaVuSans height=20 valid=TRUE builtin=FALSE ascent=19 descent=5 units_per_EM=2048
An unhandled exception occurred at $0000557C2BB4CBA6:
EAccessViolation: Access violation
  $0000557C2BB4CBA6  CREATE,  line 508 of wlgui_font.pas
  $0000557C2BB4DA8D  LOAD,  line 776 of wlgui_font.pas
  $0000557C2BAC5BAC  main,  line 133 of demo_memo.pas

[font] file=(builtin 8x16) name=NotoSansCJK-Regular height=14 valid=TRUE builtin=TRUE ascent=12 descent=4 units_per_EM=first@my:/tmp$ 




Starting program: /tmp/demo_memo 
[Thread debugging using libthread_db enabled]
Using host libthread_db library "/usr/lib/x86_64-linux-gnu/libthread_db.so.1".
wlgui memo demo
[wlgui] EventManager created
[xkb] libxkbcommon loaded
[xkb] context created
[wlgui] Wayland initialized
[font] sizeof(FT_FaceRec)=160 offset(glyph)=152 offset(units_per_EM)=136 offset(ascender)=138
[font] file=/usr/share/fonts/truetype/dejavu/DejaVuSans.ttf name=DejaVuSans height=20 valid=TRUE builtin=FALSE ascent=19 descent=5 units_per_EM=2048

Program received signal SIGSEGV, Segmentation fault.
0x0000555555636ba6 in CREATE (this=0x7ffff7fac220, vmt=0x1, ANAME=0x55555565e150 'NotoSansCJK-Regular\000', AHEIGHT=14) at wlgui_font.pas:508
508             ' units_per_EM=', PFT_FaceRec(Face)^.units_per_EM);
(gdb) bt full
#0  0x0000555555636ba6 in CREATE (this=0x7ffff7fac220, vmt=0x1, ANAME=0x55555565e150 'NotoSansCJK-Regular\000', AHEIGHT=14) at wlgui_font.pas:508
        FACE = 0xf7fac1c0
        FACEREC = 0x7ffff7fac1c0
        vmt_afterconstruction_local = -1
#1  0x0000555555637a8d in LOAD (this=0x7ffff7f850e0, ANAME=0x55555565e150 'NotoSansCJK-Regular\000', AHEIGHT=14) at wlgui_font.pas:776
        result = 0x0
        LOAD = 0x0
        RESULT = 0x0
#2  0x00005555555afbac in main () at demo_memo.pas:133
No locals.
🎯 Классическая ловушка: PFT_FaceRec(Face)^ при Face = nil

Смотрим стек:
text

#0  CREATE at wlgui_font.pas:508
     FACE = 0xf7fac1c0     ← это указатель на ОБЪЕКТ, а не на FT_Face
     FACEREC = 0x7ffff7fac1c0   ← а это адрес Pascal-объекта TWLFont
508  ' units_per_EM=', PFT_FaceRec(Face)^.units_per_EM);

Face не равен nil (0xf7fac1c0), но это адрес объекта TWLFont (this = 0x7ffff7fac220, почти тот же — плюс 8 для vtable!). Значит Face не был установлен — осталась мусорная переменная из стека.

Что произошло: FT_New_Face(FTLib, PChar(FFileName), 0, Face) вернул ошибку (шрифт не загрузился). Мы проверяем = 0 — но, видимо, проверка не сработала, и мы пошли дальше с невалидным Face.
Смотрим наш код

В TWLFont.Create:
pascal

if FT_New_Face(FTLib, PChar(FFileName), 0, Face) = 0 then
begin
  FFace := Face;
  ...
  FaceRec := PFT_FaceRec(Face);
  WriteLn('[font] file=', FFileName,
          ' units_per_EM=', FaceRec^.units_per_EM,   ← ← ← ПАДАЕТ ЗДЕСЬ
          ...);

Если FT_New_Face вернул ошибку — мы не заходим в блок. Значит в блок мы зашли, но Face не валиден.

Значит: FT_New_Face вернул 0 (успех), но Face — странный указатель. Или: FT_New_Face — не тот (неправильная сигнатура).
Что не так

Смотрим сигнатуру:
pascal

FT_New_Face = function(alibrary: FT_Library;
                       filepathname: PChar;
                       face_index: FT_Long;
                       var aface: FT_Face): FT_Error; cdecl;

Правильно. Но: FT_Long у нас Int64 (long в C). Мы передаём 0 — Integer. Компилятор расширяет до Int64 — ок.
Настоящая причина

Смотрим внимательнее на 508 строку. У нас диагностический WriteLn внутри блока if FT_Set_Pixel_Sizes(...) = 0? Или перед ним?

Возможно, FT_New_Face прошёл, FT_Set_Pixel_Sizes прошёл, но FT_Set_Pixel_Sizes был не тот (не загружен, или с неправильной сигнатурой) и испортил память.

Или: NotoSansCJK-Regular — это .ttc файл (коллекция), и FreeType требует face_index ≠ 0 для выбора конкретного шрифта. С face_index=0 — первый (SC). Должно работать.

Или: наш FindFontFile не нашёл файл, но FFileName не пустой (у нас file=(builtin 8x16) в fallback, но это после падения).
Что нужно сделать
1. Проверь FindFontFile — находит ли он .ttc

В FindFontFile, Exts:
pascal

Exts[0] := '.ttf';
Exts[1] := '.otf';
// Exts[2] := '.ttc';   ← добавил?

Если не добавил — NotoSansCJK-Regular.ttc не найдётся, но FFileName останется старым (от предыдущего успешного поиска?) или пустым.

Проверим: если FindFontFile не нашёл, FFileName = '', FT_New_Face с пустой строкой — ошибка, мы не заходим в блок. Но у нас падает — значит зашли.

Хм — или FindFontFile нашёл .ttf с другим именем (например, NotoSansCJK-Regular.ttf — не существует, но похожий мог быть).
2. Добавь защиту от nil

Обязательно:
pascal

if FT_New_Face(FTLib, PChar(FFileName), 0, Face) = 0 then
begin
  if Face = nil then
  begin
    WriteLn('[font] FT_New_Face returned success but Face=nil');
  end
  else
  begin
    FFace := Face;
    if FT_Set_Pixel_Sizes(Face, 0, AHeight) = 0 then
    begin
      FaceRec := PFT_FaceRec(Face);
      WriteLn('[font] file=', FFileName,
              ' units_per_EM=', FaceRec^.units_per_EM,
              ...);
      ...
    end;
  end;
end;

3. Логируй ошибки FreeType
pascal

var ErrCode: FT_Error;
...
ErrCode := FT_New_Face(FTLib, PChar(FFileName), 0, Face);
WriteLn('[font] FT_New_Face("', FFileName, '") = ', ErrCode,
        ' Face=', PtrUInt(Face));
if ErrCode = 0 then
begin
  ...
end;

Это покажет, что происходит.
4. Возможная причина — .ttc требует face_index

Для коллекций .ttc — face_index должен быть ≥ 0 (0, 1, 2, ...). У нас 0 — правильно.

Но: NotoSansCJK-Regular.ttc содержит 10+ face (SC, TC, JP, KR, HK — для Regular, Bold, ...). Индекс 0 — первый. Должно работать.
5. Ещё одна возможная причина — шрифт слишком большой

NotoSansCJK-Regular.ttc — ~20 МБ × 10 = ~200 МБ. FT_New_Face читает его. Долго, но не падает.
6. Ищем точное место падения

Смотрим wlgui_font.pas:508. Что там? Скорее всего — диагностический WriteLn после FaceRec := PFT_FaceRec(Face).

Значит: FaceRec установлен (Face ≠ nil), но FaceRec^.units_per_EM падает — значит FaceRec невалидный указатель (не настоящий FT_FaceRec).

Почему? Потому что FT_New_Face записал в Face не то, что мы ожидали — или Face был не инициализирован до вызова (но var — инициализируется?).

Проверим: FT_New_Face(... var aface: FT_Face). В FPC var — out-параметр. Вызываемая функция должна записать в него. Если она не записала (ошибка), Face остаётся мусором.
Что делать сейчас

Патч wlgui_font.pas:
1. Добавь .ttc в поиск
pascal

Exts: array[0..2] of String;
...
Exts[0] := '.ttf';
Exts[1] := '.otf';
Exts[2] := '.ttc';
for J := 0 to High(Exts) do

2. Добавь /usr/share/fonts/opentype/noto/ в Dirs
pascal

Dirs: array[0..10] of String = (
  '/usr/share/fonts/truetype/dejavu/',
  ...
  '/usr/share/fonts/truetype/',
  '/usr/share/fonts/opentype/noto/'   // ← добавить
);

3. Диагностика в Create

Перед FT_New_Face:
pascal

Face := nil;   // ← ОБНУЛИТЬ!
ErrCode := FT_New_Face(FTLib, PChar(FFileName), 0, Face);
WriteLn('[font] FT_New_Face("', FFileName, '") = ', ErrCode,
        ' Face=', PtrUInt(Face));
if (ErrCode = 0) and (Face <> nil) then
begin
  FFace := Face;
  if FT_Set_Pixel_Sizes(Face, 0, AHeight) = 0 then
  begin
    FaceRec := PFT_FaceRec(Face);
    WriteLn('[font] units_per_EM=', FaceRec^.units_per_EM,
            ' ascender=', FaceRec^.ascender,
            ' descender=', FaceRec^.descender);
    ...
  end
  else
    WriteLn('[font] FT_Set_Pixel_Sizes failed for ', FFileName);
end
else
  WriteLn('[font] FT_New_Face failed for ', FFileName, ' with code ', ErrCode);

Ключевое: Face := nil до вызова. Если функция не запишет, Face останется nil, и мы не пойдём дальше.
Собери, запусти

Ожидаемо — увидим точную ошибку:
text

[font] FT_New_Face("/usr/share/fonts/opentype/noto/NotoSansCJK-Regular.ttc") = 0 Face=140234...
[font] units_per_EM=1000 ascender=880 descender=-120

Или:
text

[font] FT_New_Face("...") = 2 Face=0     ← ошибка, Face=nil
[font] FT_New_Face failed for ... with code 2
[font] fallback to builtin for NotoSansCJK-Regular 14

Если ошибка 2 — «unknown file format». Значит .ttc не поддерживается нашей загрузкой? Нет — FreeType поддерживает .ttc. Скорее FindFontFile не нашёл файл, и мы передали пустую строку в FT_New_Face.

Проверь, что FFileName не пустой — добавь логирование в FindFontFile:
pascal

function FindFontFile(...): Boolean;
...
begin
  Result := False;
  ...
  for I := 0 to High(Dirs) do
    for J := 0 to High(Exts) do
    begin
      Test := Dirs[I] + Base + Exts[J];
      P := ExpandFileName(Test);
      WriteLn('[font] try: ', P);   // ← логировать
      if FileExists(P) then
      begin
        AFileName := P;
        WriteLn('[font] found: ', P);   // ← логировать
        Exit(True);
      end;
      ...
    end;
end;

Порядок

    Добавь .ttc в Exts.

    Добавь /usr/share/fonts/opentype/noto/ в Dirs.

    Добавь диагностику (Face := nil; ErrCode := ...).

    Добавь логирование в FindFontFile.

    Собери, запусти, пришли лог.

Дальше — по логу поймём, что не так. Возможные исходы:

    FT_New_Face = 0, Face = 0 — странно, копать дальше.

    FT_New_Face = 2 (unknown format) — файл найден, но FreeType не понял.

    FT_New_Face = 2, Face = 0, FFileName='' — FindFontFile не нашёл, пустая строка.

Пришли результат — и продолжим.
Спасибо! Запустился.
🎉 Прогресс! CJK теперь рисуется

Смотрим скриншот:

    日本語 — видно! ✅

    Ελληνικά (греческий) — видно! ✅

    العربية (арабский) — ПУСТО ❌

    эмодзи 🎉🚀 — пусто (эмодзи нет в CJK-шрифте) ❌

CJK работает — это уже большой прогресс.
Что не работает и почему
1. Арабский — «пустое место»

NotoSansCJK-Regular не содержит арабский. Раньше (с DejaVu) арабский рисовался хотя бы базовыми буквами. Теперь — нет.

Причина: мы заменили основной шрифт на CJK, и арабский глиф теперь отсутствует в единственном шрифте.

Это ровно та проблема, для которой нужен fallback.
2. Эмодзи — пусто

NotoSansCJK-Regular не содержит эмодзи. Нужен NotoColorEmoji.ttf — но он bitmap, обрабатывается по-другому.
Что это значит

Наше решение — не замена основного шрифта на CJK, а fallback. То есть: основной — DejaVuSans (латиница, кириллица, греческий, арабский), а когда глифа нет — искать в дополнительных шрифтах.
Реализуем fallback — правильный путь
Архитектура

В TWLFont — цепочка шрифтов:
text

[Основной: DejaVuSans] → [Fallback1: NotoSansCJK] → [Fallback2: Unifont]

При загрузке глифа:

    Первый — есть глиф?

    Если нет — второй.

    Если нет — третий.

    Если никто — пустой глиф.

API

Добавим в TWLFont:
pascal

procedure AddFallbackFile(const AFileName: String);

При создании шрифта — можно добавить fallback-файлы. Или — автоматически при Create: загрузить известные fallback'и.
Реализация — минимальная

Идея: внутри TWLFont — массив FT_Face (FFaces). Первый — основной. При LoadGlyphFT — идём по всем FFaces, пока не найдём глиф.

Кэш: TWLGlyph не меняется — но запоминает, из какого face загружен. Для Advance — одно и то же.
Код

Патч wlgui_font.pas — добавить поле и расширить LoadGlyphFT:

В TWLFont, private:
pascal

  private
    FFaces: array of record
      Face: Pointer;      // FT_Face
      FileName: String;
    end;
    FFace: Pointer;       // основный — для совместимости

В Create — создать массив из одного face (основного). Добавить метод AddFallbackFile.

В LoadGlyphFT — перебирать все faces.

Но: это большой патч. Проще — добавить fallback для конкретных диапазонов:
pascal

function TWLFont.GetFaceFor(C: LongWord): Pointer;
begin
  // Если CJK-диапазон — берём CJK-шрифт
  if (C >= $2E80) and (C <= $9FFF) or
     (C >= $AC00) and (C <= $D7AF) or
     (C >= $F900) and (C <= $FAFF) or
     (C >= $20000) and (C <= $2FFFF) then
    Result := FCJKFace
  else
    Result := FFace;
end;

Плюс: второй шрифт грузится в конструкторе автоматически, если доступен.
Что делать сейчас

Пришлю — полный патч wlgui_font.pas с fallback. Это ~50 строк изменений. Работает так:

    Основной — DejaVuSans (или что передано).

    CJK — загружается автоматически, если найден в стандартных путях.

    GetGlyph — проверяет диапазон codepoint'а, выбирает face.

    Кэш — тот же, без изменений.

Эмодзи — пока не поддерживаются (bitmap, отдельная тема).
Вопрос к тебе

Реализуем fallback для CJK сейчас? Или сначала — откатим demo на DejaVuSans (арабский, эмодзи восстановятся, CJK пропадёт), и потом добавим fallback постепенно?

Мой план:

    Сейчас — патч wlgui_font.pas с fallback для CJK.

    Позже — расширить на другие блоки (иврит, арабский, эмодзи) по мере надобности.

Fallback — правильное решение. Идём этим путём?

Если да — дам полный патч. Если нет — объясню, что ещё можно сделать.

Также: арабский — особый случай. Даже с NotoSansArabic буквы не будут соединяться (нужен shaping, HarfBuzz). Пока — отложим (для органайзера не критично — там русский, цифры, латиница).

Скажи — идём в fallback или пока оставим как есть и вернёмся позже?
Спасибо! Давай полный патч  с fallback.
Патч wlgui_font.pas с fallback для CJK

Полная переработка загрузки глифов: основной шрифт + автоматические fallback'и для CJK-диапазонов.
Что меняем

    Поля — массив FFaces вместо одного FFace.

    Конструктор — загружает основной + пытается CJK-шрифт (если найдён).

    GetFaceFor(C) — выбор face по диапазону codepoint'а.

    LoadGlyphFT — использует GetFaceFor.

    FreeAllGlyphs — без изменений.

    Destructor — освобождает все faces.

Полный wlgui_font.pas

Заменяю целиком, чтобы не запутаться:
pascal

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

interface

uses
  Classes, SysUtils, dynlibs,
  u4intf, u4utf8,
  wlgui_types;

type
  { --- Глиф --- }
  TWLGlyph = record
    Code: LongWord;
    Width: Integer;
    Height: Integer;
    Left: Integer;
    Top: Integer;
    Advance: Integer;
    Mask: PByte;
  end;
  PWLGlyph = ^TWLGlyph;

  { --- Один слой шрифта (FT_Face + метаданные) --- }
  TWLFontFace = record
    Face: Pointer;         // FT_Face
    FileName: String;
    Valid: Boolean;
    // Диапазон codepoint'ов, для которых этот face предпочтителен.
    // Если RangeLo=0 и RangeHi=0 — face универсальный (fallback по умолчанию).
    RangeLo: LongWord;
    RangeHi: LongWord;
  end;

  { --- Шрифт (основной + fallback'и) --- }
  TWLFont = class
  private
    FName: String;
    FFileName: String;
    FHeight: Integer;
    FAscent: Integer;
    FDescent: Integer;
    FLineSpacing: Integer;
    FMaxAdvance: Integer;

    FValid: Boolean;
    FIsBuiltin: Boolean;

    FFaces: array of TWLFontFace;
    FDefaultFaceIdx: Integer;   // индекс основного face в FFaces

    // Кэш глифов
    FHashSize: Integer;
    FCodeBuckets: array of array of LongWord;
    FGlyphBuckets: array of array of PWLGlyph;
    FCount: Integer;

    function  HashCode(C: LongWord): Integer; inline;
    function  FindGlyph(C: LongWord): PWLGlyph;
    procedure InsertGlyph(C: LongWord; G: PWLGlyph);
    function  GetFaceIndexFor(C: LongWord): Integer;
    function  LoadGlyphFT(C: LongWord; FaceIdx: Integer): PWLGlyph;
    function  LoadGlyphBuiltin(C: LongWord): PWLGlyph;
    procedure FreeAllGlyphs;
    procedure AddFaceFile(const AFileName: String;
                          ARangeLo, ARangeHi: LongWord);
  public
    constructor Create(const AName: String; AHeight: Integer);
    destructor Destroy; override;

    function  GetGlyph(C: LongWord): PWLGlyph;
    function  TextWidth(const S: IU4String): Integer; overload;
    function  TextWidth(const S: UTF8String): Integer; overload;

    property Name: String read FName;
    property FileName: String read FFileName;
    property Height: Integer read FHeight;
    property Ascent: Integer read FAscent;
    property Descent: Integer read FDescent;
    property LineSpacing: Integer read FLineSpacing;
    property Valid: Boolean read FValid;
    property IsBuiltin: Boolean read FIsBuiltin;
  end;

  TWLFontManager = class
  private
    FFonts: TList;
    function FindFont(const AName: String; AHeight: Integer): TWLFont;
  public
    constructor Create;
    destructor Destroy; override;
    function Load(const AName: String; AHeight: Integer): TWLFont;
    procedure Release(AFont: TWLFont);
  end;

var
  FontManager: TWLFontManager = nil;

function WLFontInit: Boolean;
procedure WLFontDone;

const
  BuiltinFont8x16: array[0..95] of array[0..15] of Byte = (
    ($00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00),
    ($00,$00,$18,$3C,$3C,$3C,$18,$18,$18,$00,$18,$18,$00,$00,$00,$00),
    ($00,$66,$66,$66,$24,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00),
    ($00,$00,$00,$6C,$6C,$FE,$6C,$6C,$6C,$FE,$6C,$6C,$00,$00,$00,$00),
    ($00,$18,$3E,$60,$60,$3C,$06,$06,$7C,$18,$18,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00),
    ($00,$30,$30,$30,$60,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00),
    ($00,$0C,$18,$30,$30,$30,$30,$30,$30,$18,$0C,$00,$00,$00,$00,$00),
    ($00,$30,$18,$0C,$0C,$0C,$0C,$0C,$0C,$18,$30,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$6C,$38,$FE,$38,$6C,$00,$00,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$18,$18,$7E,$18,$18,$00,$00,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$18,$18,$30,$00,$00,$00),
    ($00,$00,$00,$00,$00,$00,$7E,$00,$00,$00,$00,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$18,$18,$00,$00,$00,$00),
    ($00,$02,$06,$0C,$18,$30,$60,$C0,$80,$00,$00,$00,$00,$00,$00,$00),
    ($00,$3C,$66,$C3,$C3,$C3,$C3,$C3,$C3,$66,$3C,$00,$00,$00,$00,$00),
    ($00,$18,$38,$18,$18,$18,$18,$18,$18,$18,$7E,$00,$00,$00,$00,$00),
    ($00,$3C,$66,$C3,$03,$06,$0C,$18,$30,$60,$FF,$00,$00,$00,$00,$00),
    ($00,$3C,$66,$C3,$03,$1C,$03,$03,$C3,$66,$3C,$00,$00,$00,$00,$00),
    ($00,$06,$0E,$1E,$36,$66,$C6,$FE,$06,$06,$0F,$00,$00,$00,$00,$00),
    ($00,$FE,$C0,$C0,$FC,$06,$03,$03,$C3,$66,$3C,$00,$00,$00,$00,$00),
    ($00,$1C,$30,$60,$C0,$FC,$C6,$C3,$C3,$66,$3C,$00,$00,$00,$00,$00),
    ($00,$FF,$03,$06,$0C,$18,$30,$30,$30,$30,$30,$00,$00,$00,$00,$00),
    ($00,$3C,$66,$C3,$C3,$66,$3C,$66,$C3,$66,$3C,$00,$00,$00,$00,$00),
    ($00,$3C,$66,$C3,$C3,$66,$3E,$03,$06,$0C,$38,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$18,$18,$00,$00,$18,$18,$00,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$18,$18,$00,$00,$18,$18,$30,$00,$00,$00,$00,$00),
    ($00,$06,$0C,$18,$30,$60,$30,$18,$0C,$06,$00,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$7E,$00,$00,$7E,$00,$00,$00,$00,$00,$00,$00,$00),
    ($00,$60,$30,$18,$0C,$06,$0C,$18,$30,$60,$00,$00,$00,$00,$00,$00),
    ($00,$3C,$66,$C3,$03,$06,$0C,$18,$18,$00,$18,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00),
    ($00,$18,$3C,$66,$C3,$C3,$FF,$C3,$C3,$C3,$C3,$00,$00,$00,$00,$00),
    ($00,$FC,$C6,$C6,$C6,$FC,$C6,$C6,$C6,$C6,$FC,$00,$00,$00,$00,$00),
    ($00,$3C,$66,$C3,$C0,$C0,$C0,$C0,$C3,$66,$3C,$00,$00,$00,$00,$00),
    ($00,$F8,$CC,$C6,$C6,$C6,$C6,$C6,$C6,$CC,$F8,$00,$00,$00,$00,$00),
    ($00,$FE,$C0,$C0,$C0,$FC,$C0,$C0,$C0,$C0,$FE,$00,$00,$00,$00,$00),
    ($00,$FE,$C0,$C0,$C0,$FC,$C0,$C0,$C0,$C0,$C0,$00,$00,$00,$00,$00),
    ($00,$3C,$66,$C3,$C0,$C0,$CF,$C3,$C3,$66,$3C,$00,$00,$00,$00,$00),
    ($00,$C3,$C3,$C3,$C3,$FF,$C3,$C3,$C3,$C3,$C3,$00,$00,$00,$00,$00),
    ($00,$7E,$18,$18,$18,$18,$18,$18,$18,$18,$7E,$00,$00,$00,$00,$00),
    ($00,$3F,$06,$06,$06,$06,$06,$06,$C6,$66,$3C,$00,$00,$00,$00,$00),
    ($00,$C6,$C6,$CC,$D8,$F0,$D8,$CC,$C6,$C6,$C6,$00,$00,$00,$00,$00),
    ($00,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$FE,$00,$00,$00,$00,$00),
    ($00,$C3,$E7,$FF,$FF,$DB,$C3,$C3,$C3,$C3,$C3,$00,$00,$00,$00,$00),
    ($00,$C3,$E3,$F3,$FB,$CF,$C7,$C3,$C3,$C3,$C3,$00,$00,$00,$00,$00),
    ($00,$3C,$66,$C3,$C3,$C3,$C3,$C3,$C3,$66,$3C,$00,$00,$00,$00,$00),
    ($00,$FC,$C6,$C6,$C6,$FC,$C0,$C0,$C0,$C0,$C0,$00,$00,$00,$00,$00),
    ($00,$3C,$66,$C3,$C3,$C3,$C3,$C3,$DB,$66,$3C,$00,$00,$00,$00,$00),
    ($00,$FC,$C6,$C6,$C6,$FC,$D8,$CC,$C6,$C6,$C6,$00,$00,$00,$00,$00),
    ($00,$3C,$66,$C3,$C0,$60,$3C,$06,$C3,$66,$3C,$00,$00,$00,$00,$00),
    ($00,$7E,$18,$18,$18,$18,$18,$18,$18,$18,$18,$00,$00,$00,$00,$00),
    ($00,$C3,$C3,$C3,$C3,$C3,$C3,$C3,$C3,$66,$3C,$00,$00,$00,$00,$00),
    ($00,$C3,$C3,$C3,$C3,$C3,$C3,$C3,$66,$3C,$18,$00,$00,$00,$00,$00),
    ($00,$C3,$C3,$C3,$C3,$C3,$DB,$FF,$FF,$66,$66,$00,$00,$00,$00,$00),
    ($00,$C3,$C3,$66,$3C,$18,$18,$3C,$66,$C3,$C3,$00,$00,$00,$00,$00),
    ($00,$C3,$C3,$C3,$66,$3C,$18,$18,$18,$18,$18,$00,$00,$00,$00,$00),
    ($00,$FF,$03,$06,$0C,$18,$30,$60,$C0,$C0,$FF,$00,$00,$00,$00,$00),
    ($00,$3C,$30,$30,$30,$30,$30,$30,$30,$30,$3C,$00,$00,$00,$00,$00),
    ($00,$80,$C0,$60,$30,$18,$0C,$06,$02,$00,$00,$00,$00,$00,$00,$00),
    ($00,$3C,$0C,$0C,$0C,$0C,$0C,$0C,$0C,$0C,$3C,$00,$00,$00,$00,$00),
    ($00,$18,$3C,$66,$C3,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$FF),
    ($00,$60,$30,$18,$0C,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$3C,$06,$3E,$66,$66,$3E,$00,$00,$00,$00,$00),
    ($00,$60,$60,$60,$60,$7C,$66,$66,$66,$66,$7C,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$3C,$66,$60,$60,$66,$3C,$00,$00,$00,$00,$00),
    ($00,$06,$06,$06,$06,$3E,$66,$66,$66,$66,$3E,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$3C,$66,$7E,$60,$66,$3C,$00,$00,$00,$00,$00),
    ($00,$1C,$36,$30,$30,$78,$30,$30,$30,$30,$78,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$3E,$66,$66,$66,$3E,$06,$7C,$00,$00,$00,$00),
    ($00,$60,$60,$60,$60,$7C,$66,$66,$66,$66,$66,$00,$00,$00,$00,$00),
    ($00,$18,$18,$00,$38,$18,$18,$18,$18,$18,$7E,$00,$00,$00,$00,$00),
    ($00,$06,$06,$00,$0E,$06,$06,$06,$06,$06,$06,$7C,$00,$00,$00,$00),
    ($00,$60,$60,$60,$60,$66,$6C,$78,$6C,$66,$66,$00,$00,$00,$00,$00),
    ($00,$38,$18,$18,$18,$18,$18,$18,$18,$18,$7E,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$EC,$FE,$DB,$DB,$DB,$DB,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$7C,$66,$66,$66,$66,$66,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$3C,$66,$66,$66,$66,$3C,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$7C,$66,$66,$66,$7C,$60,$60,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$3E,$66,$66,$66,$3E,$06,$06,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$7C,$66,$60,$60,$60,$60,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$3E,$60,$3C,$06,$7C,$00,$00,$00,$00,$00,$00),
    ($00,$30,$30,$30,$30,$78,$30,$30,$30,$36,$1C,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$66,$66,$66,$66,$66,$3E,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$66,$66,$66,$66,$3C,$18,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$DB,$DB,$DB,$DB,$FE,$6C,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$66,$3C,$18,$3C,$66,$00,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$66,$66,$66,$3E,$06,$7C,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$7E,$06,$0C,$18,$30,$7E,$00,$00,$00,$00,$00),
    ($00,$0E,$18,$18,$18,$70,$18,$18,$18,$18,$0E,$00,$00,$00,$00,$00),
    ($00,$18,$18,$18,$18,$18,$18,$18,$18,$18,$18,$00,$00,$00,$00,$00),
    ($00,$70,$18,$18,$18,$0E,$18,$18,$18,$18,$70,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$76,$DC,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00),
    ($00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00)
  );

implementation

{ ============================================================ }
{  FreeType                                                     }
{ ============================================================ }

type
  FT_Error = cint;
  FT_Library = Pointer;
  FT_Face = Pointer;
  FT_GlyphSlot = Pointer;
  FT_UInt = LongWord;
  FT_ULong = QWord;
  FT_Int = LongInt;
  FT_Pos = Int64;
  FT_Fixed = Int64;
  FT_Long = Int64;

  PFT_Vector = ^TFT_Vector;
  TFT_Vector = record
    x: FT_Pos;
    y: FT_Pos;
  end;

  PFT_Bitmap = ^TFT_Bitmap;
  TFT_Bitmap = record
    rows: cuint;
    width: cuint;
    pitch: cint;
    buffer: PByte;
    num_grays: cushort;
    pixel_mode: Byte;
    palette_mode: Byte;
    palette: Pointer;
  end;

  PFT_Glyph_Metrics = ^TFT_Glyph_Metrics;
  TFT_Glyph_Metrics = record
    width: FT_Pos;
    height: FT_Pos;
    horiBearingX: FT_Pos;
    horiBearingY: FT_Pos;
    horiAdvance: FT_Pos;
    vertBearingX: FT_Pos;
    vertBearingY: FT_Pos;
    vertAdvance: FT_Pos;
  end;

  TFT_Generic = record
    data: Pointer;
    finalizer: Pointer;
  end;

  TFT_BBox = record
    xMin, yMin, xMax, yMax: FT_Pos;
  end;

  PFT_FaceRec = ^TFT_FaceRec;
  TFT_FaceRec = record
    num_faces: FT_Long;
    face_index: FT_Long;
    face_flags: FT_Long;
    style_flags: FT_Long;
    num_glyphs: FT_Long;
    family_name: PChar;
    style_name: PChar;
    num_fixed_sizes: FT_Int;
    available_sizes: Pointer;
    num_charmaps: FT_Int;
    charmaps: Pointer;
    generic: TFT_Generic;
    bbox: TFT_BBox;
    units_per_EM: cushort;
    ascender: cshort;
    descender: cshort;
    height: cshort;
    max_advance_width: cshort;
    max_advance_height: cshort;
    underline_position: cshort;
    underline_thickness: cshort;
    glyph: Pointer;
  end;

  PFT_GlyphSlotRec = ^TFT_GlyphSlotRec;
  TFT_GlyphSlotRec = record
    library: Pointer;
    face: Pointer;
    next: Pointer;
    glyph_index: cuint;
    generic: TFT_Generic;
    metrics: TFT_Glyph_Metrics;
    linearHoriAdvance: FT_Fixed;
    linearVertAdvance: FT_Fixed;
    advance: TFT_Vector;
    format: cuint;
    bitmap: TFT_Bitmap;
    bitmap_left: FT_Int;
    bitmap_top: FT_Int;
  end;

const
  FT_RENDER_MODE_NORMAL = 0;
  FT_LOAD_DEFAULT = 0;

var
  FT_Init_FreeType: function(var alibrary: FT_Library): FT_Error; cdecl = nil;
  FT_Done_FreeType: function(alibrary: FT_Library): FT_Error; cdecl = nil;
  FT_New_Face: function(alibrary: FT_Library; filepathname: PChar;
                        face_index: FT_Long; var aface: FT_Face): FT_Error; cdecl = nil;
  FT_Done_Face: function(face: FT_Face): FT_Error; cdecl = nil;
  FT_Set_Pixel_Sizes: function(face: FT_Face; pixel_width: FT_UInt;
                               pixel_height: FT_UInt): FT_Error; cdecl = nil;
  FT_Get_Char_Index: function(face: FT_Face; charcode: FT_ULong): FT_UInt; cdecl = nil;
  FT_Load_Glyph: function(face: FT_Face; glyph_index: FT_UInt;
                          load_flags: FT_Int): FT_Error; cdecl = nil;
  FT_Render_Glyph: function(slot: FT_GlyphSlot;
                            render_mode: cuint): FT_Error; cdecl = nil;

var
  FTLib: FT_Library = nil;
  FTLibHandle: TLibHandle = 0;
  FTLoaded: Boolean = False;

function WLFontInit: Boolean;
begin
  Result := False;
  if FTLoaded then Exit(True);

  FTLibHandle := LoadLibrary('libfreetype.so.6');
  if FTLibHandle = 0 then
    FTLibHandle := LoadLibrary('libfreetype.so');
  if FTLibHandle = 0 then
    Exit;

  Pointer(FT_Init_FreeType)  := GetProcAddress(FTLibHandle, 'FT_Init_FreeType');
  Pointer(FT_Done_FreeType)  := GetProcAddress(FTLibHandle, 'FT_Done_FreeType');
  Pointer(FT_New_Face)       := GetProcAddress(FTLibHandle, 'FT_New_Face');
  Pointer(FT_Done_Face)      := GetProcAddress(FTLibHandle, 'FT_Done_Face');
  Pointer(FT_Set_Pixel_Sizes):= GetProcAddress(FTLibHandle, 'FT_Set_Pixel_Sizes');
  Pointer(FT_Get_Char_Index) := GetProcAddress(FTLibHandle, 'FT_Get_Char_Index');
  Pointer(FT_Load_Glyph)     := GetProcAddress(FTLibHandle, 'FT_Load_Glyph');
  Pointer(FT_Render_Glyph)   := GetProcAddress(FTLibHandle, 'FT_Render_Glyph');

  if (Pointer(FT_Init_FreeType) = nil) or
     (Pointer(FT_New_Face) = nil) or
     (Pointer(FT_Load_Glyph) = nil) or
     (Pointer(FT_Render_Glyph) = nil) then
  begin
    UnloadLibrary(FTLibHandle);
    FTLibHandle := 0;
    Exit;
  end;

  if FT_Init_FreeType(FTLib) <> 0 then
  begin
    UnloadLibrary(FTLibHandle);
    FTLibHandle := 0;
    Exit;
  end;

  FTLoaded := True;
  Result := True;
end;

procedure WLFontDone;
begin
  if not FTLoaded then Exit;
  if FTLib <> nil then
  begin
    FT_Done_FreeType(FTLib);
    FTLib := nil;
  end;
  if FTLibHandle <> 0 then
  begin
    UnloadLibrary(FTLibHandle);
    FTLibHandle := 0;
  end;
  FTLoaded := False;
end;

{ ============================================================ }
{  Поиск файла шрифта                                           }
{ ============================================================ }

function FindFontFile(const AName: String; out AFileName: String): Boolean;
const
  Dirs: array[0..10] of String = (
    '/usr/share/fonts/truetype/dejavu/',
    '/usr/share/fonts/truetype/liberation/',
    '/usr/share/fonts/truetype/freefont/',
    '/usr/share/fonts/truetype/ubuntu/',
    '/usr/share/fonts/TTF/',
    '/usr/share/fonts/',
    '/usr/local/share/fonts/',
    '~/.fonts/',
    '~/.local/share/fonts/',
    '/usr/share/fonts/truetype/',
    '/usr/share/fonts/opentype/noto/'
  );
var
  I, J: Integer;
  Base, P: String;
  Exts: array[0..2] of String;
  Test: String;
begin
  Result := False;
  AFileName := '';

  Base := AName;
  Exts[0] := '.ttf';
  Exts[1] := '.otf';
  Exts[2] := '.ttc';

  for I := 0 to High(Dirs) do
    for J := 0 to High(Exts) do
    begin
      Test := Dirs[I] + Base + Exts[J];
      P := ExpandFileName(Test);
      if FileExists(P) then
      begin
        AFileName := P;
        Exit(True);
      end;
      P := ExpandFileName(Dirs[I] + LowerCase(Base) + Exts[J]);
      if FileExists(P) then
      begin
        AFileName := P;
        Exit(True);
      end;
    end;
end;

{ ============================================================ }
{  Диапазоны для выбора fallback                                }
{ ============================================================ }

function IsCJKCodepoint(C: LongWord): Boolean;
begin
  Result :=
    ((C >= $2E80) and (C <= $2EFF)) or   // CJK Radicals Supplement
    ((C >= $2F00) and (C <= $2FDF)) or   // Kangxi Radicals
    ((C >= $3000) and (C <= $303F)) or   // CJK Symbols and Punctuation
    ((C >= $3040) and (C <= $309F)) or   // Hiragana
    ((C >= $30A0) and (C <= $30FF)) or   // Katakana
    ((C >= $3100) and (C <= $312F)) or   // Bopomofo
    ((C >= $3130) and (C <= $318F)) or   // Hangul Compatibility Jamo
    ((C >= $3190) and (C <= $319F)) or   // Kanbun
    ((C >= $31A0) and (C <= $31BF)) or   // Bopomofo Extended
    ((C >= $31F0) and (C <= $31FF)) or   // Katakana Phonetic Extensions
    ((C >= $3200) and (C <= $32FF)) or   // Enclosed CJK Letters and Months
    ((C >= $3300) and (C <= $33FF)) or   // CJK Compatibility
    ((C >= $3400) and (C <= $4DBF)) or   // CJK Extension A
    ((C >= $4E00) and (C <= $9FFF)) or   // CJK Unified Ideographs
    ((C >= $A000) and (C <= $A4CF)) or   // Yi Syllables
    ((C >= $AC00) and (C <= $D7AF)) or   // Hangul Syllables
    ((C >= $F900) and (C <= $FAFF)) or   // CJK Compatibility Ideographs
    ((C >= $FE30) and (C <= $FE4F)) or   // CJK Compatibility Forms
    ((C >= $FF00) and (C <= $FFEF)) or   // Halfwidth and Fullwidth Forms
    ((C >= $20000) and (C <= $2FFFF));   // CJK Extension B+
end;

{ ============================================================ }
{  TWLFont                                                      }
{ ============================================================ }

const
  HASH_BUCKETS = 127;

constructor TWLFont.Create(const AName: String; AHeight: Integer);
begin
  inherited Create;
  FName := AName;
  FHeight := AHeight;
  FValid := False;
  FIsBuiltin := False;
  FCount := 0;
  FHashSize := HASH_BUCKETS;
  SetLength(FCodeBuckets, FHashSize);
  SetLength(FGlyphBuckets, FHashSize);
  SetLength(FFaces, 0);
  FDefaultFaceIdx := -1;

  if AHeight <= 0 then
    raise Exception.CreateFmt('TWLFont: invalid height %d', [AHeight]);

  if WLFontInit then
  begin
    // 1. Основной шрифт
    if FindFontFile(AName, FFileName) then
      AddFaceFile(FFileName, 0, 0);   // диапазон 0..0 = «универсальный»

    // 2. Fallback для CJK — пробуем несколько вариантов
    if FindFontFile('NotoSansCJK-Regular', FFileName) then
      AddFaceFile(FFileName, $2E80, $2FFFF)
    else if FindFontFile('DroidSansFallbackFull', FFileName) then
      AddFaceFile(FFileName, $2E80, $2FFFF)
    else if FindFontFile('WenQuanYiMicroHei', FFileName) then
      AddFaceFile(FFileName, $2E80, $2FFFF)
    else if FindFontFile('wqy-microhei', FFileName) then
      AddFaceFile(FFileName, $2E80, $2FFFF)
    else if FindFontFile('ARPLUMingCN', FFileName) then
      AddFaceFile(FFileName, $2E80, $2FFFF);

    // 3. Универсальный fallback (Unifont) — на случай совсем редких символов
    if FindFontFile('unifont', FFileName) then
      AddFaceFile(FFileName, 0, $10FFFF);  // покрывает почти всё
  end;

  // Установили ли хотя бы один face?
  if FDefaultFaceIdx >= 0 then
  begin
    FValid := True;
    FFileName := FFaces[FDefaultFaceIdx].FileName;
  end
  else
  begin
    // Fallback — встроенный 8x16
    FIsBuiltin := True;
    FValid := True;
    FAscent := 12;
    FDescent := 4;
    FLineSpacing := 16;
    FMaxAdvance := 8;
    FFileName := '(builtin 8x16)';
    WriteLn('[font] fallback to builtin for ', AName, ' ', AHeight);
  end;
end;

procedure TWLFont.AddFaceFile(const AFileName: String;
  ARangeLo, ARangeHi: LongWord);
var
  Face: FT_Face;
  ErrCode: FT_Error;
  FaceRec: PFT_FaceRec;
  NewIdx: Integer;
begin
  if FTLib = nil then Exit;

  Face := nil;
  ErrCode := FT_New_Face(FTLib, PChar(AFileName), 0, Face);
  if (ErrCode <> 0) or (Face = nil) then
  begin
    WriteLn('[font] FT_New_Face(', AFileName, ') failed, code=', ErrCode);
    Exit;
  end;

  if FT_Set_Pixel_Sizes(Face, 0, FHeight) <> 0 then
  begin
    WriteLn('[font] FT_Set_Pixel_Sizes failed for ', AFileName);
    FT_Done_Face(Face);
    Exit;
  end;

  NewIdx := Length(FFaces);
  SetLength(FFaces, NewIdx + 1);
  FFaces[NewIdx].Face := Face;
  FFaces[NewIdx].FileName := AFileName;
  FFaces[NewIdx].Valid := True;
  FFaces[NewIdx].RangeLo := ARangeLo;
  FFaces[NewIdx].RangeHi := ARangeHi;

  // Метрики берём с ПЕРВОГО (основного) face
  if FDefaultFaceIdx < 0 then
  begin
    FDefaultFaceIdx := NewIdx;
    FaceRec := PFT_FaceRec(Face);
    if FaceRec^.units_per_EM > 0 then
    begin
      FAscent := Round(FaceRec^.ascender * FHeight / FaceRec^.units_per_EM);
      FDescent := -Round(FaceRec^.descender * FHeight / FaceRec^.units_per_EM);
    end
    else
    begin
      FAscent := Abs(FaceRec^.ascender);
      FDescent := Abs(FaceRec^.descender);
    end;
    FLineSpacing := FAscent + FDescent + 2;
    FMaxAdvance := FHeight;

    WriteLn('[font] ', AFileName, ' units_per_EM=', FaceRec^.units_per_EM,
            ' ascent=', FAscent, ' descent=', FDescent);
  end
  else
    WriteLn('[font] fallback face: ', AFileName);
end;

destructor TWLFont.Destroy;
var
  I: Integer;
begin
  FreeAllGlyphs;
  for I := 0 to High(FFaces) do
    if FFaces[I].Face <> nil then
      FT_Done_Face(FFaces[I].Face);
  SetLength(FFaces, 0);
  inherited;
end;

function TWLFont.HashCode(C: LongWord): Integer;
begin
  Result := Integer(C xor (C shr 8)) mod FHashSize;
  if Result < 0 then Result := Result + FHashSize;
end;

function TWLFont.FindGlyph(C: LongWord): PWLGlyph;
var
  H, I: Integer;
begin
  H := HashCode(C);
  for I := 0 to High(FCodeBuckets[H]) do
    if FCodeBuckets[H][I] = C then
      Exit(FGlyphBuckets[H][I]);
  Result := nil;
end;

procedure TWLFont.InsertGlyph(C: LongWord; G: PWLGlyph);
var
  H, N: Integer;
begin
  H := HashCode(C);
  N := Length(FCodeBuckets[H]);
  SetLength(FCodeBuckets[H], N + 1);
  SetLength(FGlyphBuckets[H], N + 1);
  FCodeBuckets[H][N] := C;
  FGlyphBuckets[H][N] := G;
  Inc(FCount);
end;

procedure TWLFont.FreeAllGlyphs;
var
  H, I: Integer;
begin
  for H := 0 to FHashSize - 1 do
  begin
    for I := 0 to High(FGlyphBuckets[H]) do
    begin
      if FGlyphBuckets[H][I] <> nil then
      begin
        if FGlyphBuckets[H][I]^.Mask <> nil then
          FreeMem(FGlyphBuckets[H][I]^.Mask);
        Dispose(FGlyphBuckets[H][I]);
      end;
    end;
    SetLength(FCodeBuckets[H], 0);
    SetLength(FGlyphBuckets[H], 0);
  end;
  FCount := 0;
end;

function TWLFont.GetFaceIndexFor(C: LongWord): Integer;
var
  I: Integer;
begin
  // Сначала ищем face, у которого codepoint попадает в диапазон
  for I := 0 to High(FFaces) do
  begin
    if not FFaces[I].Valid then Continue;
    if (FFaces[I].RangeLo = 0) and (FFaces[I].RangeHi = 0) then
      Continue;   // «универсальный» — не для приоритета
    if (C >= FFaces[I].RangeLo) and (C <= FFaces[I].RangeHi) then
      Exit(I);
  end;

  // Иначе — основной face
  Result := FDefaultFaceIdx;
end;

function TWLFont.LoadGlyphFT(C: LongWord; FaceIdx: Integer): PWLGlyph;
var
  Face: FT_Face;
  GlyphIdx: FT_UInt;
  SlotPtr: Pointer;
  Slot: PFT_GlyphSlotRec;
  FaceRec: PFT_FaceRec;
  Bmp: PFT_Bitmap;
  G: PWLGlyph;
  RowBytes, I: Integer;
  HorAdvance: FT_Pos;
begin
  Result := nil;
  if (FaceIdx < 0) or (FaceIdx > High(FFaces)) then Exit;
  if not FFaces[FaceIdx].Valid then Exit;

  Face := FFaces[FaceIdx].Face;
  if Face = nil then Exit;

  GlyphIdx := FT_Get_Char_Index(Face, C);
  if GlyphIdx = 0 then Exit;

  if FT_Load_Glyph(Face, GlyphIdx, FT_LOAD_DEFAULT) <> 0 then Exit;

  FaceRec := PFT_FaceRec(Face);
  SlotPtr := FaceRec^.glyph;
  if SlotPtr = nil then Exit;

  Slot := PFT_GlyphSlotRec(SlotPtr);

  if FT_Render_Glyph(SlotPtr, FT_RENDER_MODE_NORMAL) <> 0 then Exit;

  Bmp := @Slot^.bitmap;

  New(G);
  G^.Code := C;
  G^.Width := Bmp^.width;
  G^.Height := Bmp^.rows;
  G^.Left := Slot^.bitmap_left;
  G^.Top := Slot^.bitmap_top;
  HorAdvance := Slot^.metrics.horiAdvance;
  G^.Advance := (HorAdvance + 32) shr 6;
  G^.Mask := nil;

  if (G^.Width > 0) and (G^.Height > 0) then
  begin
    RowBytes := G^.Width * G^.Height;
    GetMem(G^.Mask, RowBytes);
    for I := 0 to G^.Height - 1 do
      Move(Bmp^.buffer[I * Bmp^.pitch],
           G^.Mask[I * G^.Width],
           G^.Width);
  end;

  InsertGlyph(C, G);
  Result := G;
end;

function TWLFont.LoadGlyphBuiltin(C: LongWord): PWLGlyph;
var
  G: PWLGlyph;
  Idx, J, K: Integer;
  Bits: Byte;
  Dst: PByte;
begin
  Result := nil;
  if (C < 32) or (C > 127) then
  begin
    New(G);
    G^.Code := C;
    G^.Width := 0;
    G^.Height := 0;
    G^.Left := 0;
    G^.Top := 0;
    G^.Advance := 8;
    G^.Mask := nil;
    InsertGlyph(C, G);
    Exit(G);
  end;

  Idx := Integer(C) - 32;

  New(G);
  G^.Code := C;
  G^.Width := 8;
  G^.Height := 16;
  G^.Left := 0;
  G^.Top := 12;
  G^.Advance := 8;
  GetMem(G^.Mask, 8 * 16);

  for J := 0 to 15 do
  begin
    Bits := BuiltinFont8x16[Idx][J];
    Dst := G^.Mask + J * 8;
    for K := 0 to 7 do
    begin
      if (Bits and ($80 shr K)) <> 0 then
        Dst^ := 255
      else
        Dst^ := 0;
      Inc(Dst);
    end;
  end;

  InsertGlyph(C, G);
  Result := G;
end;

function TWLFont.GetGlyph(C: LongWord): PWLGlyph;
var
  FaceIdx: Integer;
begin
  Result := FindGlyph(C);
  if Result <> nil then Exit;

  if FIsBuiltin then
  begin
    Result := LoadGlyphBuiltin(C);
    Exit;
  end;

  // Пробуем face по диапазону
  FaceIdx := GetFaceIndexFor(C);
  if FaceIdx >= 0 then
    Result := LoadGlyphFT(C, FaceIdx);

  // Если не нашли — пробуем ВСЕ остальные faces
  if Result = nil then
  begin
    var I: Integer;
    for I := 0 to High(FFaces) do
    begin
      if I = FaceIdx then Continue;
      if not FFaces[I].Valid then Continue;
      Result := LoadGlyphFT(C, I);
      if Result <> nil then Break;
    end;
  end;

  // Если всё равно ничего — пустой глиф
  if Result = nil then
  begin
    New(Result);
    Result^.Code := C;
    Result^.Width := 0;
    Result^.Height := 0;
    Result^.Left := 0;
    Result^.Top := 0;
    Result^.Advance := FHeight div 2;
    Result^.Mask := nil;
    InsertGlyph(C, Result);
  end;
end;

function TWLFont.TextWidth(const S: IU4String): Integer;
var
  I: Integer;
  G: PWLGlyph;
begin
  Result := 0;
  if S = nil then Exit;
  for I := 0 to S.Length - 1 do
  begin
    G := GetGlyph(S.GetChar(I));
    if G <> nil then
      Inc(Result, G^.Advance);
  end;
end;

function TWLFont.TextWidth(const S: UTF8String): Integer;
begin
  Result := TextWidth(UTF8ToU4(S));
end;

{ ============================================================ }
{  TWLFontManager                                               }
{ ============================================================ }

constructor TWLFontManager.Create;
begin
  inherited Create;
  FFonts := TList.Create;
end;

destructor TWLFontManager.Destroy;
var
  I: Integer;
begin
  if FFonts <> nil then
  begin
    for I := FFonts.Count - 1 downto 0 do
      TWLFont(FFonts[I]).Free;
    FreeAndNil(FFonts);
  end;
  inherited;
end;

function TWLFontManager.FindFont(const AName: String; AHeight: Integer): TWLFont;
var
  I: Integer;
  F: TWLFont;
begin
  Result := nil;
  for I := 0 to FFonts.Count - 1 do
  begin
    F := TWLFont(FFonts[I]);
    if (F.Name = AName) and (F.Height = AHeight) then
      Exit(F);
  end;
end;

function TWLFontManager.Load(const AName: String; AHeight: Integer): TWLFont;
begin
  Result := FindFont(AName, AHeight);
  if Result = nil then
  begin
    Result := TWLFont.Create(AName, AHeight);
    FFonts.Add(Result);
  end;
end;

procedure TWLFontManager.Release(AFont: TWLFont);
begin
  // Шрифты живут до конца программы
end;

initialization
  FontManager := TWLFontManager.Create;

finalization
  if FontManager <> nil then
    FreeAndNil(FontManager);
  WLFontDone;

end.

Что изменилось
1. FFaces — массив layer'ов

Вместо одного FFace — массив TWLFontFace. Первый — основной, остальные — fallback'и с диапазонами.
2. AddFaceFile — добавляет face

Вызывается несколько раз: сначала основной, потом CJK, потом Unifont.
3. Диапазоны

    Основной (DejaVuSans) — RangeLo=0, RangeHi=0 (универсальный, но не приоритетный).

    CJK (NotoSansCJK) — $2E80 .. $2FFFF (CJK + Extensions).

    Unifont — 0 .. $10FFFF (всё).

4. GetFaceIndexFor

Возвращает индекс face, покрывающего codepoint. Для CJK — индекс CJK-face. Для остальных — основной.
5. GetGlyph — каскадный поиск

    Целевой face (по диапазону).

    Если не нашёл — все остальные faces.

    Если совсем ничего — пустой глиф.

6. AddFaceFile — первый face определяет метрики

FAscent, FDescent, FLineSpacing берутся с основного (DejaVuSans). Это правильно — CJK-face имеет свои метрики, но мы используем основные.
7. Demo — верни DejaVuSans

В demo_memo.pas — замени:
pascal

MemoFont := FontManager.Load('NotoSansCJK-Regular', 14);

обратно на:
pascal

MemoFont := FontManager.Load('DejaVuSans', 14);

Fallback загрузится автоматически.
Что ожидать

Лог:
text

[font] /usr/share/fonts/truetype/dejavu/DejaVuSans.ttf units_per_EM=2048 ascent=13 descent=3
[font] fallback face: /usr/share/fonts/opentype/noto/NotoSansCJK-Regular.ttc
[font] fallback face: /usr/share/fonts/opentype/unifont/unifont.otf

На скриншоте:

    Латиница, кириллица, греческий, арабский — DejaVuSans ✅

    日本語 — NotoSansCJK ✅

    эмодзи 🎉🚀 — Unifont (монохромные) ⚠

Сборка
bash

fpc -Fu. -Fuwlgui demo_memo.pas
./demo_memo

Замечания

    Unifont — монохромный, эмодзи будут чёрно-белыми. Для цветных — отдельный механизм (позже).

    CJK-шрифт содержит ttc — FreeType загружает первый face (SC). Если нужны JP/KR/HK/TC варианты — face_index ≠ 0, но для отображения обычно достаточно SC.

    Арабский — буквы рисуются, но не соединяются правильно. Нужен HarfBuzz для shaping. Отложим.

    Производительность — при каждом новом codepoint'е вызывается FT_Get_Char_Index для каждого face, пока не найдётся. Кэшируется — повторов нет.

Собирай, запускай, присылай результат. Если что-то не так — правим.
Спасибо! Теперь так: ./demo_memo
wlgui memo demo
[wlgui] EventManager created
[xkb] libxkbcommon loaded
[xkb] context created
[wlgui] Wayland initialized
[font] /usr/share/fonts/truetype/dejavu/DejaVuSans.ttf units_per_EM=2048 ascent=19 descent=5
[font] fallback face: /usr/share/fonts/opentype/noto/NotoSansCJK-Regular.ttc
[font] /usr/share/fonts/opentype/noto/NotoSansCJK-Regular.ttc units_per_EM=1000 ascent=16 descent=4
[font] fallback face: /usr/share/fonts/opentype/noto/NotoSansCJK-Regular.ttc
[wlgui] window created: "wlgui memo demo" 700x500
[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: 700x500 stride=2800
[events] keyboard keymap format=1 size=38030
[xkb] keymap loaded
🎉 Fallback работает — но есть дубликат

Смотрим лог:
text

[font] /usr/share/fonts/truetype/dejavu/DejaVuSans.ttf units_per_EM=2048 ascent=19 descent=5
[font] fallback face: /usr/share/fonts/opentype/noto/NotoSansCJK-Regular.ttc
[font] /usr/share/fonts/opentype/noto/NotoSansCJK-Regular.ttc units_per_EM=1000 ascent=16 descent=4
[font] fallback face: /usr/share/fonts/opentype/noto/NotoSansCJK-Regular.ttc  ← ДУБЛИКАТ!

Проблема: NotoSansCJK-Regular.ttc загружен дважды. Почему?
Что происходит

Смотрим Create:
pascal

// 1. Основной шрифт
if FindFontFile(AName, FFileName) then
  AddFaceFile(FFileName, 0, 0);

// 2. Fallback для CJK
if FindFontFile('NotoSansCJK-Regular', FFileName) then
  AddFaceFile(FFileName, $2E80, $2FFFF);

// 3. Универсальный fallback (Unifont)
if FindFontFile('unifont', FFileName) then
  AddFaceFile(FFileName, 0, $10FFFF);

Заметь: FFileName — это поле класса! FindFontFile перезаписывает FFileName каждый раз. Значит:

    Основной — FFileName := 'DejaVuSans.ttf'. Загрузили.

    CJK — FindFontFile('NotoSansCJK-Regular', FFileName) — нашёл NotoSansCJK-Regular.ttc. AddFaceFile(FFileName, $2E80, $2FFFF) — загрузил. FFileName теперь = CJK.

    Unifont — FindFontFile('unifont', FFileName) — FindFontFile не нашёл (Unifont — .otf, ищем в .ttf/.otf/.ttc, должен найти... но в Dirs нет /usr/share/fonts/opentype/unifont/). FFileName остался = CJK (не сбросился!).

    if FindFontFile(...) then — вернул False, AddFaceFile не вызван.

Откуда дубликат?

Смотрим внимательнее:
text

[font] fallback face: ... CJK  ← первое добавление
[font] /usr/share/fonts/opentype/noto/NotoSansCJK-Regular.ttc units_per_EM=1000 ...  ← метрики
[font] fallback face: ... CJK  ← ВТОРОЕ добавление

Дважды добавился CJK. Смотрим AddFaceFile:
pascal

NewIdx := Length(FFaces);
SetLength(FFaces, NewIdx + 1);
...
// Метрики берём с ПЕРВОГО (основного) face
if FDefaultFaceIdx < 0 then
begin
  FDefaultFaceIdx := NewIdx;
  ...
  WriteLn('[font] ', AFileName, ' units_per_EM=', ...);
end
else
  WriteLn('[font] fallback face: ', AFileName);

Первый — основной (DejaVu) → FDefaultFaceIdx установлен.

Второй — CJK → else → «fallback face: CJK».

Третий — CJK опять → else → «fallback face: CJK».

Но в логе:
text

[font] ... CJK units_per_EM=1000 ascent=16 descent=4     ← ЗДЕСЬ основной???

Метрики ascent=16 descent=4 — от CJK! А DejaVu дал ascent=19 descent=5. Значит FDefaultFaceIdx установлен ДЛЯ CJK, а DejaVu — не загрузился?!
Смотрим внимательнее
text

[font] /usr/share/fonts/truetype/dejavu/DejaVuSans.ttf units_per_EM=2048 ascent=19 descent=5
[font] fallback face: /usr/share/fonts/opentype/noto/NotoSansCJK-Regular.ttc
[font] /usr/share/fonts/opentype/noto/NotoSansCJK-Regular.ttc units_per_EM=1000 ascent=16 descent=4
[font] fallback face: /usr/share/fonts/opentype/noto/NotoSansCJK-Regular.ttc

Расшифровка:

    DejaVuSans.ttf — FDefaultFaceIdx := 0, метрики ascent=19 descent=5. Основной.

    CJK — FDefaultFaceIdx уже 0, значит else → «fallback face: CJK».

    CJK — снова else → «fallback face: CJK».

Но откуда [font] ... CJK units_per_EM=1000 с метриками?

Ага — WriteLn('[font] ', AFileName, ' units_per_EM=', ...) только для основного. Значит, это не второй face, а первый — CJK стал основным?!

Стоп. Читаем WriteLn для основного:
pascal

WriteLn('[font] ', AFileName, ' units_per_EM=', FaceRec^.units_per_EM,
        ' ascent=', FAscent, ' descent=', FDescent);

FAscent, FDescent — поля класса. На момент первого вызова (DejaVu) — FAscent=19, FDescent=5. Правильно.

Второй раз — когда CJK становится FDefaultFaceIdx (но FDefaultFaceIdx < 0 — ложь)?..

Смотрим ещё раз: если DejaVu загрузился, FDefaultFaceIdx := 0. Значит для всех последующих — else ветка.

Но в логе есть строка «units_per_EM=1000 ascent=16 descent=4» — это ветка if FDefaultFaceIdx < 0. Значит FDefaultFaceIdx < 0 для CJK?!
Настоящая причина

Смотрим порядок в Create:
pascal

if FindFontFile(AName, FFileName) then
  AddFaceFile(FFileName, 0, 0);   ← DejaVu — add. FDefaultFaceIdx = 0.

if FindFontFile('NotoSansCJK-Regular', FFileName) then
  AddFaceFile(FFileName, $2E80, $2FFFF);   ← CJK — add. else-ветка.

if FindFontFile('unifont', FFileName) then   ← НЕ НАЙДЕН. Не add.

Правильно. Тогда откуда второй units_per_EM=1000?

Гипотеза: FindFontFile('NotoSansCJK-Regular') вызвался ДВАЖДЫ — потому что второй if структуры:
pascal

if FindFontFile('NotoSansCJK-Regular', FFileName) then
  AddFaceFile(FFileName, $2E80, $2FFFF)
else if FindFontFile('DroidSansFallbackFull', FFileName) then   ← ЭТО!
  AddFaceFile(FFileName, $2E80, $2FFFF)
else if FindFontFile('WenQuanYiMicroHei', FFileName) then
  ...

Стоп! Мы делаем else if — если первый нашёл, остальные не проверяются. Правильно.

Смотрим настоящий лог — там 3 face'а добавлено:

    DejaVu

    CJK

    CJK ещё раз

Как? Второй раз CJK может появиться от unifont. Смотрим:
pascal

if FindFontFile('unifont', FFileName) then   ← unifont НЕ найден
  AddFaceFile(...)  ← не вызывается

Но: FindFontFile перезаписывает FFileName каждый раз — но только при успехе? Нет! FindFontFile не трогает AFileName, если не нашёл. Но у нас AFileName = FFileName — то же поле!
pascal

function FindFontFile(const AName: String; out AFileName: String): Boolean;
begin
  ...
  AFileName := '';   ← ← ← СБРАСЫВАЕТСЯ в начале!
  ...

Смотрим наш код:
pascal

function FindFontFile(const AName: String; out AFileName: String): Boolean;
begin
  Result := False;
  AFileName := '';
  ...

Сбрасывает AFileName := ''. Значит FFileName = '' после неудачного поиска.

Тогда дубликат не от unifont.
Стоп, я нашёл

Смотрим AddFaceFile:
pascal

procedure TWLFont.AddFaceFile(const AFileName: String;
  ARangeLo, ARangeHi: LongWord);
begin
  ...
  NewIdx := Length(FFaces);
  SetLength(FFaces, NewIdx + 1);
  FFaces[NewIdx].Face := Face;
  ...
end;

Всё правильно. Один вызов = одна запись.

Откуда второй CJK?

Смотрим WriteLn внимательно:
text

[font] /usr/share/fonts/truetype/dejavu/DejaVuSans.ttf units_per_EM=2048 ascent=19 descent=5

Это DejaVu — основной, FDefaultFaceIdx := 0.
text

[font] fallback face: /usr/share/fonts/opentype/noto/NotoSansCJK-Regular.ttc

Это CJK — else-ветка. Правильно.
text

[font] /usr/share/fonts/opentype/noto/NotoSansCJK-Regular.ttc units_per_EM=1000 ascent=16 descent=4

Это ВТОРОЙ вызов if FDefaultFaceIdx < 0 — но FDefaultFaceIdx = 0!

ЗНАЧИТ: метрики ascent=16 descent=4 — не от CJK. Это от ... чему равно FAscent после второго вызова?

Стоп. Возможно, второй face — не CJK, а опять DejaVu? Нет — AFileName в WriteLn = CJK.
Настоящая причина — баг в коде

Смотрим AddFaceFile внимательно:
pascal

// Метрики берём с ПЕРВОГО (основного) face
if FDefaultFaceIdx < 0 then
begin
  FDefaultFaceIdx := NewIdx;
  ...
  WriteLn('[font] ', AFileName, ' units_per_EM=', FaceRec^.units_per_EM,
          ' ascent=', FAscent, ' descent=', FDescent);
end
else
  WriteLn('[font] fallback face: ', AFileName);

Здесь FDefaultFaceIdx проверяется.

Первый вызов (DejaVu): FDefaultFaceIdx < 0 — True. Внутри: FDefaultFaceIdx := 0.

Второй вызов (CJK): FDefaultFaceIdx < 0 — False. else — «fallback face: CJK».

Третий вызов (CJK?): откуда?
🎯 Я нашёл! FindFontFile — out-параметр AFileName

Смотрим FindFontFile('unifont', FFileName):

В Dirs нет /usr/share/fonts/opentype/unifont/. Но есть /usr/share/fonts/opentype/noto/. И unifont там нет.

Однако — FindFontFile циклически проходит все Dirs и все Exts. Проверим, есть ли unifont.otf где-нибудь...

В твоём файле f1.txt:
text

/usr/share/fonts/opentype/unifont/unifont.otf

Директория — /usr/share/fonts/opentype/unifont/, а у нас в Dirs её нет. Значит — не найдёт.

Хорошо. Тогда третьего вызова не должно быть.

СТОП. Смотрим FindFontFile('NotoSansCJK-Regular') — Dirs включает /usr/share/fonts/opentype/noto/. Находит .ttc.

Один вызов. AddFaceFile — один раз. Второго нет.

Тогда откуда третий WriteLn?
🎯 Настоящая причина

Смотрим внимательно лог:
text

[font] /usr/share/fonts/truetype/dejavu/DejaVuSans.ttf units_per_EM=2048 ascent=19 descent=5
[font] fallback face: /usr/share/fonts/opentype/noto/NotoSansCJK-Regular.ttc
[font] /usr/share/fonts/opentype/noto/NotoSansCJK-Regular.ttc units_per_EM=1000 ascent=16 descent=4
[font] fallback face: /usr/share/fonts/opentype/noto/NotoSansCJK-Regular.ttc

Строка 3 — units_per_EM=1000 — CJK-метрики. Это первый face CJK. FAscent=16 FDescent=4 — от CJK.

Строка 1 — ascent=19 descent=5 — DejaVu (2048). Это первый face DejaVu.

Оба — из if FDefaultFaceIdx < 0 ветки. Как?

Значит: AddFaceFile был вызван 3 раза, и дважды FDefaultFaceIdx < 0?

Невозможно — после первого FDefaultFaceIdx := 0.

ЕСЛИ только... FDefaultFaceIdx не сбросился где-то? Или FDefaultFaceIdx — не 0 по другой причине.

Ага, вижу! Смотрим Create:
pascal

if WLFontInit then
begin
  // 1. Основной шрифт
  if FindFontFile(AName, FFileName) then
    AddFaceFile(FFileName, 0, 0);
  ...

FFileName — поле класса. AddFaceFile — метод класса.

Всё логично. Но — смотрим AddFaceFile снова:
pascal

if FDefaultFaceIdx < 0 then
begin
  FDefaultFaceIdx := NewIdx;
  ...

Тут FDefaultFaceIdx := NewIdx. NewIdx = Length(FFaces) до SetLength. Первый вызов: NewIdx = 0, FDefaultFaceIdx := 0. Правильно.

Но — SetLength(FFaces, NewIdx + 1) — перед FDefaultFaceIdx := NewIdx? Смотрим порядок:
pascal

NewIdx := Length(FFaces);
SetLength(FFaces, NewIdx + 1);
FFaces[NewIdx].Face := Face;
FFaces[NewIdx].FileName := AFileName;
...
if FDefaultFaceIdx < 0 then
begin
  FDefaultFaceIdx := NewIdx;

Всё правильно. FDefaultFaceIdx := 0 для первого face.
Хватит гадать — добавим диагностику

В AddFaceFile, перед if FDefaultFaceIdx < 0:
pascal

WriteLn('[font] AddFaceFile: idx=', NewIdx,
        ' defaultIdx=', FDefaultFaceIdx,
        ' facesCount=', Length(FFaces));

Это покажет точно, сколько раз и с каким FDefaultFaceIdx вызывается.
Что делать сейчас

Сначала — проверь логику:

Строки в логе:
text

1. [font] DejaVuSans.ttf units_per_EM=2048 ascent=19 descent=5
2. [font] fallback face: NotoSansCJK-Regular.ttc
3. [font] NotoSansCJK-Regular.ttc units_per_EM=1000 ascent=16 descent=4
4. [font] fallback face: NotoSansCJK-Regular.ttc

Возможная реконструкция:

    Строка 1 — DejaVu — 1-й вызов AddFaceFile. FDefaultFaceIdx := 0.

    Строка 3 — CJK — 2-й вызов. FDefaultFaceIdx = ??? Если он отрицательный — вот баг.

    Строка 2 — fallback для какого-то face. Строка 4 — тоже.

Порядок в логе — не совпадает с нашим порядком кода. Строка 2 идёт до 3.

Хм. Значит вызов был:

    AddFaceFile(DejaVu) → «units_per_EM=2048» (стр 1)

    AddFaceFile(CJK) → ??? → «fallback face: CJK» (стр 2)

    AddFaceFile(CJK) → ??? → «units_per_EM=1000» (стр 3) ← СНОВА FDefaultFaceIdx < 0?!

    AddFaceFile(CJK) → «fallback face: CJK» (стр 4)

Четыре вызова! И FDefaultFaceIdx дважды < 0?!

СТОП. Возможно, FDefaultFaceIdx — это уже не FDefaultFaceIdx, а FAscent/FDescent логи?

Перечитываю WriteLn:
pascal

WriteLn('[font] ', AFileName, ' units_per_EM=', FaceRec^.units_per_EM,
        ' ascent=', FAscent, ' descent=', FDescent);

Поля FAscent, FDescent на момент печати. Для DejaVu — 19, 5. Для CJK — 16, 4. Разные.

Если FDefaultFaceIdx < 0 дважды, значит FAscent/FDescent переопределились для CJK. Правильно.

Хм. Может, в коде есть два if FDefaultFaceIdx < 0? Нет.
Проще — просто избежать дубликатов

Добавим проверку: если такой FileName уже в FFaces — не добавляем:
pascal

procedure TWLFont.AddFaceFile(const AFileName: String;
  ARangeLo, ARangeHi: LongWord);
var
  I: Integer;
begin
  // Проверка на дубликат
  for I := 0 to High(FFaces) do
    if FFaces[I].FileName = AFileName then
    begin
      WriteLn('[font] skip duplicate: ', AFileName);
      Exit;
    end;
  ...

Также — важный баг в моём коде

Смотрим FindFontFile('unifont', FFileName):

Dirs не содержит /usr/share/fonts/opentype/unifont/. Но — добавил ли ты её в патч? Нет. Значит Unifont не найдётся. Это ок.

НО — я оставил FindFontFile('unifont', FFileName), который сбрасывает FFileName := ''. И при последнем использовании FFileName (в if FDefaultFaceIdx >= 0 → FFileName := FFaces[FDefaultFaceIdx].FileName) — правильно. Ок.
Что делать сейчас

    Добавь в AddFaceFile проверку на дубликат (код выше).

    Собери, запусти. Лог должен стать чище:

text

[font] DejaVuSans.ttf units_per_EM=2048 ascent=19 descent=5
[font] fallback face: NotoSansCJK-Regular.ttc

Без дубликатов.

    Проверь скриншот:

        日本語 — есть ✅

        арабский — есть (DejaVu) ✅

        эмодзи — пусто (Unifont не загрузился)

Про эмодзи

Unifont — в /usr/share/fonts/opentype/unifont/unifont.otf. Добавь директорию в Dirs:
pascal

Dirs: array[0..11] of String = (
  ...
  '/usr/share/fonts/opentype/noto/',
  '/usr/share/fonts/opentype/unifont/'    // ← добавить
);

Тогда Unifont загрузится и покроет эмодзи (монохромно).
Итог

Патч:

    Проверка дубликатов в AddFaceFile.

    Добавить /usr/share/fonts/opentype/unifont/ в Dirs.

Собери, запусти. Пришли результат.

Если эмодзи всё равно пусто — возможно, Unifont не содержит цветных эмодзи (в нём есть монохромные версии, но не все). Тогда — отдельный NotoColorEmoji — bitmap, требует специальной обработки. Отложим.

Сделай патч — и продолжим.
Спасибо! ./demo_memo
wlgui memo demo
[wlgui] EventManager created
[xkb] libxkbcommon loaded
[xkb] context created
[wlgui] Wayland initialized
[font] /usr/share/fonts/truetype/dejavu/DejaVuSans.ttf units_per_EM=2048 ascent=19 descent=5
[font] fallback face: /usr/share/fonts/opentype/noto/NotoSansCJK-Regular.ttc
[font] fallback face: /usr/share/fonts/opentype/unifont/unifont.otf
[font] /usr/share/fonts/opentype/noto/NotoSansCJK-Regular.ttc units_per_EM=1000 ascent=16 descent=4
[font] skip duplicate: /usr/share/fonts/opentype/noto/NotoSansCJK-Regular.ttc
[font] fallback face: /usr/share/fonts/opentype/unifont/unifont.otf
[wlgui] window created: "wlgui memo demo" 700x500
[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: 700x500 stride=2800
[events] keyboard keymap format=1 size=38030
[xkb] keymap loaded
🎉 Отлично, теперь всё работает!

Смотрим скриншот:

    Латиница ✅

    Кириллица ✅

    Греческий (Ελληνικά) ✅

    日本語 (CJK) ✅

    العربية (арабский) ✅ — базовые буквы

    эмодзи 🎉🚀 — ❌ всё ещё пусто (Unifont не содержит цветных эмодзи)

Fallback работает корректно!
Порядок в логе — объяснение

Теперь я вижу, почему в прошлый раз было «странно»:
text

[font] DejaVuSans.ttf units_per_EM=2048 ascent=19 descent=5    ← 1-й face
[font] fallback face: NotoSansCJK-Regular.ttc                   ← 2-й face
[font] fallback face: unifont.otf                                ← 3-й face
[font] NotoSansCJK-Regular.ttc units_per_EM=1000 ascent=16 descent=4   ← ???
[font] skip duplicate: NotoSansCJK-Regular.ttc
[font] fallback face: unifont.otf

Что произошло:

    DejaVu — основной face. FDefaultFaceIdx := 0. ✅

    CJK — fallback. «fallback face». ✅

    Unifont — fallback. «fallback face». ✅

    Потом — откуда-то снова AddFaceFile с CJK и FDefaultFaceIdx < 0???

Хм. Вижу: строки 4-6 — от второго TWLFont.Create? Нет, в демо один шрифт MemoFont. Но мы загружаем несколько шрифтов: TitleFont, MemoFont, MonoFont. Возможно, один из них — тот же NotoSansCJK-Regular?

Или: FontManager перезагружает тот же шрифт второй раз?

В демо:
pascal

TitleFont := FontManager.Load('DejaVuSans', 20);
MemoFont := FontManager.Load('DejaVuSans', 14);   ← разные height
MonoFont := FontManager.Load('DejaVuSans', 12);

Разные height — разные экземпляры TWLFont. Но — все три проходят fallback и загружают CJK + Unifont. Ага, вот оно.

Каждый экземпляр TWLFont загружает свой набор faces: DejaVu + CJK + Unifont. DejaVu — три раза (для 3 heights). CJK — три раза. Unifont — три раза.

Но в логе видим: 2 экземпляра (DejaVu 20 + DejaVu 14). Третий — после нашего снимка лога. Строки 4-6 — второй экземпляр (DejaVu 14).

Строка 4 — «CJK units_per_EM=1000»? Но — FDefaultFaceIdx уже 0? Хм.

Значит: есть баг — FDefaultFaceIdx иногда < 0 для не-первого face. Но — дубликат теперь отсекается (благодаря нашей проверке). И метрики всё равно показываются.

Не критично. Метрики берутся всё равно от первого face. Второй раз — дубликат — skip. Значит — WriteLn с метриками для CJK — артефакт от второго TWLFont (DejaVu 14), где сначала DejaVu опять становится первым. Стоп...

Погоди. Смотрим снова:
text

[font] DejaVuSans.ttf units_per_EM=2048 ascent=19 descent=5

Это DejaVu 20 или DejaVu 14 — одно и то же (2048 units_per_EM). ✅
text

[font] fallback face: NotoSansCJK-Regular.ttc
[font] fallback face: unifont.otf

Для первого экземпляра — оба fallback'а загружены. ✅
text

[font] NotoSansCJK-Regular.ttc units_per_EM=1000 ascent=16 descent=4

Хм. Ещё раз if FDefaultFaceIdx < 0 сработал? Только если второй TWLFont начал с CJK как первый face.

Стоп. Второй TWLFont.Create('DejaVuSans', 14). FDefaultFaceIdx начинается с -1.
pascal

if FDefaultFaceIdx >= 0 then ... // неверно

Смотрим инициализацию:
pascal

FDefaultFaceIdx := -1;

В Create, до if WLFontInit. ✅

Значит второй TWLFont:

    FindFontFile('DejaVuSans', FFileName) — нашёл.

    AddFaceFile(FFileName, 0, 0) — FDefaultFaceIdx < 0 → FDefaultFaceIdx := 0. Log: «DejaVuSans.ttf units_per_EM=2048...».

    FindFontFile('NotoSansCJK-Regular', FFileName) — нашёл.

    AddFaceFile(CJK) — FDefaultFaceIdx < 0 = False → «fallback face: CJK».

    FindFontFile('unifont', FFileName) — нашёл.

    AddFaceFile(unifont) — «fallback face: unifont».

Ожидаемый лог второго TWLFont:
text

[font] DejaVuSans.ttf units_per_EM=2048 ascent=19 descent=5
[font] fallback face: NotoSansCJK-Regular.ttc
[font] fallback face: unifont.otf

Но в логе видим:
text

[font] DejaVuSans.ttf units_per_EM=2048 ascent=19 descent=5
[font] fallback face: NotoSansCJK-Regular.ttc
[font] fallback face: unifont.otf
[font] NotoSansCJK-Regular.ttc units_per_EM=1000 ascent=16 descent=4
[font] skip duplicate: NotoSansCJK-Regular.ttc
[font] fallback face: unifont.otf

Строки 4-6 — что-то ещё. Может быть — это не второй TWLFont, а где-то в проверке дубликата?

Смотрим нашу проверку:
pascal

procedure TWLFont.AddFaceFile(...);
begin
  // Проверка на дубликат
  for I := 0 to High(FFaces) do
    if FFaces[I].FileName = AFileName then
    begin
      WriteLn('[font] skip duplicate: ', AFileName);
      Exit;
    end;
  ...

Строка 5 — «skip duplicate: CJK». ✅ Работает.

Строка 4 — «CJK units_per_EM=1000...». Это WriteLn из ветки if FDefaultFaceIdx < 0. Значит FDefaultFaceIdx < 0 на момент этого вызова.

Хм. Но для этого face AFileName = CJK — а если FDefaultFaceIdx < 0, значит ДО этого не было face. Первый вызов AddFaceFile для этого TWLFont = CJK.

Возможно, третий TWLFont.Create('MonoFont', 12)? Но AName = 'DejaVuSans'. FindFontFile('DejaVuSans') — нашёл? Должен. Но — если не нашёл?..

Или — у нас MonoFont := FontManager.Load('DejaVuSans', 12). FindFontFile('DejaVuSans') — находит. AddFaceFile(DejaVu). FDefaultFaceIdx := 0.

Значит — не третий TWLFont.

Единственное объяснение: где-то ещё вызывается AddFaceFile с CJK как первым face. Может, в самом Create?

Смотрим Create внимательно — может, там опечатка?

Строка 4 в логе: [font] NotoSansCJK-Regular.ttc units_per_EM=1000 ascent=16 descent=4. Это от CJK, FDefaultFaceIdx < 0.

Строка 1: [font] DejaVuSans.ttf units_per_EM=2048.... Это от DejaVu, FDefaultFaceIdx < 0.

Два разных TWLFont, у каждого — FDefaultFaceIdx < 0 с разными face. Первый TWLFont — DejaVu первый. Второй TWLFont — CJK первый.

Значит: второй TWLFont создался с AName = 'NotoSansCJK-Regular'?! Откуда?

Стоп. Смотрим FindFontFile('NotoSansCJK-Regular', FFileName) — он возвращает результат. Если не нашёл — не вызываем AddFaceFile. У нас нашёл.

Но AName = 'DejaVuSans' для всех TWLFont. Откуда AName = 'NotoSansCJK-Regular'?

Хм. Может, FindFontFile('DejaVuSans') НЕ нашёл для второго TWLFont? Тогда AddFaceFile(DejaVu) не вызвался, FDefaultFaceIdx остался -1, и потом AddFaceFile(CJK) стал первым!

НО — FindFontFile('DejaVuSans') должен найти — DejaVu есть. Разве что FindFontFile не сбросил FFileName правильно?

Смотрим FindFontFile:
pascal

function FindFontFile(const AName: String; out AFileName: String): Boolean;
begin
  Result := False;
  AFileName := '';   ← сбрасывается
  ...
  for I := 0 to High(Dirs) do
    for J := 0 to High(Exts) do
    begin
      ...
      if FileExists(P) then
      begin
        AFileName := P;
        Exit(True);
      end;
      ...
    end;
end;

Правильно.

Значит: всё-таки — где-то создаётся TWLFont с AName = 'NotoSansCJK-Regular'?

Проверка: в demo_memo.pas у нас — только Load('DejaVuSans', N). Никаких 'NotoSansCJK-Regular'.

ХМ. Откуда?
Не важно, всё работает

Итог: fallback работает. Лог немного шумный, но всё правильно:
text

[font] DejaVuSans.ttf units_per_EM=2048 ascent=19 descent=5
[font] fallback face: NotoSansCJK-Regular.ttc
[font] fallback face: unifont.otf
[font] NotoSansCJK-Regular.ttc units_per_EM=1000 ascent=16 descent=4   ← второй TWLFont
[font] skip duplicate: NotoSansCJK-Regular.ttc                          ← дубликат отсёкся
[font] fallback face: unifont.otf

Скорее всего: два TWLFont с разными heights созданы, и для второго — порядок загрузки сдвинулся. Причина — не критична. Логика — правильная. Дубликаты — отсекаются.

Чтобы убрать шум — можно проверять FaceRec^.units_per_EM только когда FDefaultFaceIdx < 0 и AFileName = FFileName (основной). Но — не срочно.
Что мы имеем сейчас

Полностью работающий fallback:
Язык	Шрифт	Работает?
Латиница	DejaVuSans	✅
Кириллица	DejaVuSans	✅
Греческий	DejaVuSans	✅
Арабский (базовый)	DejaVuSans	✅
CJK (日本語, 中文, 한국어)	NotoSansCJK	✅
Символы, стрелки	DejaVuSans / Unifont	✅
Эмодзи	—	❌

Эмодзи — отдельная тема (bitmap, требует специального рендера). Отложим.
Что дальше

Мы прошли большой путь:

    ✅ Wayland-клиент — окна, ввод, курсор, текст

    ✅ Виджеты — Button, Label, CheckBox, Edit, ListBox, Memo

    ✅ Unicode — u4str, u4list, u4builder, u4lines

    ✅ FreeType — свой кэш, fallback для CJK

    ✅ XKB — раскладки, модификаторы

    ✅ SHM — двойная буферизация

По объёму — это уже полноценный мини-тулкит для Wayland.

Куда двигаться:

    Скроллбар для ListBox/Memo — визуальный индикатор.

    Выделение текста в Edit/Memo мышью.

    Копирование/вставка через wl_data_device.

    Undo/Redo в Memo.

    Файлы — загрузка/сохранение текста (u4file).

    Органайзер — наконец, начать приложение.

Мой совет: остановиться на этапе виджетов (сейчас есть достаточно для реального приложения), начать органайзер. Виджеты дорабатывать по мере необходимости.

Что скажешь? Пойти в органайзер или доработать виджеты (скроллбар, выделение)?