Apus.Engine.TextDraw.pas

// Text rendering
//
// Copyright (C) 2011-2021 Apus Software (ivan@apus-software.com)
// This file is licensed under the terms of BSD-3 license (see license.txt)
// This file is a part of the Apus Game Engine (https://github.com/Cooler2/ApusGameEngine)
unit Apus.Engine.TextDraw;
interface
 uses Types, Apus.Core, Apus.Types, Apus.Engine.Types, Apus.Engine.API;

 const
  MAGIC_TEXTCACHE = $01FF;
  DEFAULT_FONT_DOWNSCALE = 0.93;
  DEFAULT_FONT_UPSCALE = 1.1;
  TXT_TEXTURE_8BIT = false;

  // FT fonts have no "base" size, so scale is relative to an arbitrarily fixed size
  FTF_DEFAULT_LINE_HEIGHT = 24; // line height that corresponds to scale=100
  // Fallback for GetFont(name,0) when the best match is a vector font: those have no
  // native size, so "default font size" has to be an actual number. Same default as
  // DefaultStyle uses for a missing 'font-size'.
  DEFAULT_UI_FONT_SIZE = 9;

 type
  // Function that computes the color at a point (for text coloring)
  TColorFunc=function(x,y:single;color:cardinal):cardinal;
  // Procedure that modifies the link drawing style
  TTextLinkStyleProc=procedure(link:cardinal;var sUnderline:boolean;var color:cardinal);

  // Images inlined in text (8 bytes)
  TInlineImage=packed record
   width:byte;
   padTop,padBottom:byte;
   group:byte;
   ind:word; // INLINE\group\ind
  end;

  // Text rendering subsystem singleton.
  // Owns font registry and glyph cache texture, provides measurement and drawing via ITextDrawer.
  TTextDrawer=class(TInterfacedObject,ITextDrawer)
   class threadvar
    textMetrics:array of TRect; // results of text measurement (if requested)
    measuredText:TRect; // bounding rect of the whole (possibly multi-line) text (if toMeasure was set)

    textCaching:boolean;  // cache draw operations
    textBlockOptions:cardinal; // block-level options to add

    txtBuf:array of TVertex;
    txtInd:array of word;
    txtVertCount:integer; // number of vertices stored in textBuf
    textVB:TVertexBuffer;
    textIB:TIndexBuffer;

    textCache:TTexture; // texture with cached glyphs (textCacheWidth x 512, or another for new glyph cache structure)

    // Buffer for alternate text rendering
    textBufferBitmap:pointer;
    textBufferPitch:integer;
    globalScale:single;
    threadStateReady:boolean;
    pixelRatioOverride:single; // >0: used by PixelRatio instead of the render target ratio
    pixelK:single; // >0 while WritePixels lays the text out in real pixels (see WriteW)

   constructor Create;
   destructor Destroy; override;

   function LoadFont(fname:string;asName:string=''):string; overload; // returns the font name
   function LoadRasterFont(const font:TBuffer;asName:string=''):string; overload; // returns the font name
   function LoadVectorFont(const font:TBuffer;asName:string=''):string; overload; // returns the font name
   procedure SetScale(scale:single);
   function GetFont(name:string;size:single;flags:cardinal=0;effects:byte=0):TFontHandle; // returns the font handle
   function ScaleFont(const font:TFontHandle;scale:single):TFontHandle;
   procedure SetFontOption(handle:TFontHandle;option:cardinal;value:single);
   // Text output
   procedure Write(font:TFontHandle;x,y:single;color:cardinal;st:String8;align:TTextAlignment=taLeft;
      options:cardinal=0;targetWidth:integer=0;query:cardinal=0);
   procedure WriteW(font:TFontHandle;xx,yy:single;color:cardinal;st:String32;align:TTextAlignment=taLeft;
      options:cardinal=0;targetWidth:integer=0;query:cardinal=0);
   procedure WriteR(font:TFontHandle;x,y:single;color:cardinal;st:String8;options:cardinal=0);
   procedure WriteC(font:TFontHandle;x,y:single;color:cardinal;st:String8;options:cardinal=0);
   // Measure text dimensions
   function Width(font:TFontHandle;st:String8):integer; // text width in pixels
   function WidthW(font:TFontHandle;st:String32):integer; // text width in pixels
   function Height(font:TFontHandle):integer; // Height of capital letters (like 'A'..'Z','0'..'9') in pixels
   function Advance(font:TFontHandle;const st:String8):single;
   function AdvanceW(font:TFontHandle;const st:String32):single;
   procedure PenPositions(font:TFontHandle;const st:String32;var pos:SingleArray);
   // Text layout (see ITextDrawer)
   function WrapText(font:TFontHandle;const st:String8;width:single):Strings8; overload;
   function WrapText(font:TFontHandle;const st:String8;width:single;out widths:SingleArray):Strings8; overload;
   function FitText(font:TFontHandle;const st:String8;width:single;cut:TTextCut=TTextCut.atEnd):String8; overload;
   function FitText(font:TFontHandle;const st:String8;width:single;cut:TTextCut;const ellipsis:String8):String8; overload;
   function MeasuredCnt:integer;
   function MeasuredRect(idx:integer):TRect;
   function MeasuredBounds:TRect; // bounding rect of the last measured text (relative to its pen position)
   function Measure(font:TFontHandle;st:String8;options:cardinal=0):TRect; // measure text extent without drawing
   // Hyperlinks
   procedure ClearLink; // Clear current link (call before text render)
   function Link:integer; // get hyperlink under mouse (filled during text render)
   function LinkRect:TRect; // get active hyperlink rect
   // Cache / misc
   procedure BeginBlock(addOptions:cardinal=0); // optimize performance when drawing multiple text entries
   procedure EndBlock;   // finish buffering and perform actual render
   // Text render target
   procedure SetTarget(buf:pointer;pitch:integer); // set system memory target for text rendering (no clipping!)
   // Real pixels per virtual pixel of the text output: when the projection scales the
   // virtual area up, text is laid out and rasterized in real pixels (not stretched)
   class function PixelRatio:single;
   // The same font sized in real pixels for the given ratio (flags kept)
   function PixelFont(font:TFontHandle;ratio:single):TFontHandle;
   function HasGlyph(font:TFontHandle;ch:Char32):boolean; // the font has a glyph for ch
  private
   fonts:array of TObject;
   procedure EnsureThreadState;
   procedure CreateTextCache;
   procedure FlushTextCache;
   function GetFontObject(font:TFontHandle):TObject;
   // Text output and metrics in the pixels of the font handle (no ratio applied)
   procedure WritePixels(font:TFontHandle;xx,yy:single;color:cardinal;st:String32;align:TTextAlignment;
      options:cardinal;targetWidth:integer;query:cardinal);
   function RawWidthW(font:TFontHandle;st:String32):integer;
   function RawHeight(font:TFontHandle):integer;
   function RawAdvanceW(font:TFontHandle;const st:String32):single;
   function FitTextW(font:TFontHandle;const st:String8;width:single;cut:TTextCut;e:String32):String8;
  end;

 var
  maxGlyphBufferCount:integer=1000;
  // Default width (or height) for modern text cache (must be 512, 1024 or 2048)
  textCacheWidth:integer=512;
  textCacheHeight:integer=512;

  textDrawer:TTextDrawer;
  defaultFontHandle:cardinal; // first loaded font (unless overriden), used to substitute 0-handle

threadvar
 // Thread-local callbacks for text styling/coloring in multi-window render mode.
 textColorFunc:TColorFunc;
 textLinkStyleProc:TTextLinkStyleProc;
 // If a query with point coordinates is passed when drawing text and the point falls on a drawn link,
 // the number of that link is stored here. Reset before drawing a frame
 curTextLink:cardinal;
 curTextLinkRect:TRect;

implementation
 uses
   SysUtils,
   Apus.Colors,
   Apus.Images,
   Apus.UnicodeFont,
   Apus.GlyphCache,
   Apus.Engine.Graphics
   {$IFDEF FREETYPE},Apus.FreeTypeFont{$ENDIF},
  Apus.Conv,
  Apus.Files,
  Apus.Log,
  Apus.Strings;

const
 // Font handle flags (not affecting rendered glyphs)
 fhDontTranslate = $1000000;
 fhItalic        = $2000000;
 fhUnderline     = $4000000;
 fhBold          = $8000000;
 // Font handle flags (affecting rendered glyphs)
 fhNoHinting     = $200;
 fhAutoHinting   = $400;
 // Font handle flags (layout only)
 fhTabularDigits = fsTabularDigits;
 // Internal-only txt.Write option: don't apply BeginBlock textBlockOptions.
 // Used to avoid recursion when toWithShadow is expanded into nested WriteW calls.
 toInternalNoBlock = $40000000;

type
 {$IFNDEF FREETYPE}
 TFreeTypeFont=class // stub class
 end;
 {$ENDIF}

 // Extended raster-font descriptor used by text drawer for adaptive scaling and fallback.
 TUnicodeFontEx=class(TUnicodeFont)
  displayName:string; // runtime alias, separate from the fixed-size file header
  spareFont:integer; // use this font for missed characters
  spareScale:single; // scale difference: 2.0 means that spare font is 2 times smaller than this
  downscaleFactor:single; // scale glyphs down if scale is less than this value
  upscaleFactor:single; // scale glyphs up if scale is larger than this value
  procedure InitDefaults; override;
 end;

 // Pen steps of one font handle in its own pixels. Metrics and output share these rules,
 // so the measured text is the drawn one
 TPenMetrics=record
  uniFont:TUnicodeFontEx;
  {$IFDEF FREETYPE}
  ftFont:TFreeTypeFont;
  size:single;
  {$ENDIF}
  charScale:single; // raster font glyphs scaled
  tabular:boolean;  // digits take cells
  cell:single;      // width of a digit cell
  procedure Init(obj:TObject;font:TFontHandle);
  function IsCell(ch:Char32):boolean; inline; // ch takes a tabular cell
  function GlyphAdv(ch:Char32):single; // pen step after the glyph of ch, no kerning
  function Adv(ch:Char32):single; // pen step after ch at the end of a line (a cell for a digit)
  function Step(ch1,ch2:Char32):single; // pen step from ch1 to the next ch2
  function Shift(ch:Char32):single; // glyph offset from the pen (centered in its cell)
  // Width of a line counts from LeftEdge of the first char to RightEdge of the last one,
  // both relative to their pen positions. A line drawn at x starts its pen at x-LeftEdge
  function LeftEdge(ch:Char32):single;
  function RightEdge(ch:Char32):single;
  function LineWidth(const st:String32;first,last:integer):single; // st[first..last]
  function LineAdvance(const st:String32;first,last:integer):single; // st[first..last]
 end;

 threadvar
  glyphCache,altGlyphCache:TGlyphCache;

procedure DefaultTextLinkStyle(link:cardinal;var sUnderline:boolean;var col:cardinal);
 begin
  sUnderline:=true;
  if link=curTextLink then begin
   col:=Color.Add(col,$604030);
  end;
 end;

function ApplyTextColor(x,y:single;color:cardinal):cardinal;
var
 f:TColorFunc;
begin
 f:=textColorFunc;
 if Assigned(f) then
  result:=f(x,y,color)
 else
  result:=color;
end;

procedure ApplyLinkStyle(link:cardinal;var sUnderline:boolean;var color:cardinal);
var
 p:TTextLinkStyleProc;
begin
 p:=textLinkStyleProc;
 if Assigned(p) then
  p(link,sUnderline,color);
end;

const
 // Vector fonts are rendered no larger than the size at which every glyph (font bounding box)
 // fits the glyph cache: its top (dy) is stored in a signed byte (2 px left for hinting), and
 // its height must fit the room the cache keeps free (see GLYPH_KEEP_MIN_ROWS, minus padding)
 MAX_GLYPH_TOP = 125;
 MAX_GLYPH_HEIGHT = GLYPH_KEEP_MIN_ROWS-4;

var
 limitedFonts:array of TObject; // vector fonts already reported as size-limited
 glyphFailures:integer; // glyphs dropped because the glyph cache could not take them

{$IFDEF FREETYPE}
// Limit the handle scale of a vector font (FreeType size = 20*scale) to what the glyph cache can hold
function LimitVectorScale(ftFont:TFreeTypeFont;scale:single):single;
var
 i:integer;
 maxScale:single;
begin
 result:=scale;
 maxScale:=ftFont.MaxSizeForBox(MAX_GLYPH_TOP,MAX_GLYPH_HEIGHT)/20;
 if scale<=maxScale then exit;
 result:=maxScale;
 for i:=0 to high(limitedFonts) do
  if limitedFonts[i]=ftFont then exit;
 SetLength(limitedFonts,length(limitedFonts)+1);
 limitedFonts[high(limitedFonts)]:=ftFont;
 // both sizes are GetFont size multiplied by the SetScale factor
 Log.Warn('Font "%s": size %.0f exceeds the glyph cache limit %.0f (GetFont size * text scale), drawn at the limit',
   [ftFont.faceName,scale*15,maxScale*15]);
end;
{$ELSE}
function LimitVectorScale(ftFont:TFreeTypeFont;scale:single):single;
begin
 result:=scale;
end;
{$ENDIF}

function ScaleFromHandle(font:TFontHandle):single;
 var
  b:byte;
 begin
  b:=(font shr 16) and $FF;
  if b=0 then exit(1.0);
  result:=sqr((b+30)/100);
 end;

function PixelToVirtual(v,k:single):single; inline;
 begin
  result:=(v+0.5)/k-0.5;
 end;

function PixelRectToVirtual(const r:TRect;k:single):TRect;
 begin
  result:=types.Rect(round(PixelToVirtual(r.Left,k)),round(PixelToVirtual(r.Top,k)),
    round(PixelToVirtual(r.Right,k)),round(PixelToVirtual(r.Bottom,k)));
 end;

function VirtualToPixel(v,k:single):single;
 begin
  result:=(v+0.5)*k-0.5;
 end;

procedure EncodeScale(scale:single;var font:TFontHandle);
 var
  b:byte;
 begin
  scale:=Clamp(sqrt(scale),0.31,2.85);
  b:=round(scale*100)-30;
  font:=(font and $FF00FFFF)+b shl 16;
 end;

{ TTextDrawer }

procedure TTextDrawer.EnsureThreadState;
 var
  i:integer;
  pw:^word;
 begin
  if threadStateReady then exit;
  globalScale:=1.0;
  if not Assigned(textLinkStyleProc) then
   textLinkStyleProc:=DefaultTextLinkStyle;
  textCache:=nil;
  textVB:=nil;
  textIB:=nil;
  SetLength(txtBuf,4*MaxGlyphBufferCount);
  SetLength(txtInd,6*MaxGlyphBufferCount);
  pw:=@txtInd[0];
  for i:=0 to MaxGlyphBufferCount-1 do begin
   pw^:=i*4; inc(pw);
   pw^:=i*4+1; inc(pw);
   pw^:=i*4+2; inc(pw);
   pw^:=i*4; inc(pw);
   pw^:=i*4+2; inc(pw);
   pw^:=i*4+3; inc(pw);
  end;
  // GPU buffers come with the first flush: metrics and layout need no graphics
  txtVertCount:=0;
  textCaching:=false;
  curTextLink:=0;
  curTextLinkRect:=types.Rect(-1,-1,-1,-1);
  threadStateReady:=true;
 end;

procedure TTextDrawer.FlushTextCache;
 var
  idxCount,triCount:integer;
 begin
  EnsureThreadState;
  if txtVertCount=0 then exit;
  if textVB=nil then begin
   textVB:=gfx.resMan.AllocVertexBuffer(TVertex.layoutTex,4*MaxGlyphBufferCount,TBufferUsage.buDynamic,abThreadLocal);
   textVB.debugName:='textVB';
   textIB:=gfx.resMan.AllocIndexBuffer(6*MaxGlyphBufferCount,2,TBufferUsage.buStatic,abThreadLocal);
   textIB.debugName:='textIB';
   textIB.Upload(0,6*MaxGlyphBufferCount,@txtInd[0]);
   textIB.MakeImmutable;
  end;
  shader.UseTexture(textCache);
  if txtVertCount>0 then begin
    idxCount:=txtVertCount*3 div 2; // 6 indices per 4 vertices
    triCount:=idxCount div 3;
    if (textVB<>nil) and (textIB<>nil) then begin
      textVB.Upload(0,txtVertCount,@txtBuf[0]);
      gfx.resman.UseVertexBuffer(textVB);
      gfx.resman.UseIndexBuffer(textIB);
      renderDevice.DrawIndexed(TRG_LIST,nil,nil,TVertex.layoutTex,0,txtVertCount,0,triCount);
      gfx.resman.UseVertexBuffer(nil);
      gfx.resman.UseIndexBuffer(nil);
    end else
      renderDevice.DrawIndexed(TRG_LIST,txtBuf,txtInd,TVertex.layoutTex,0,txtVertCount,0,triCount);
    txtVertCount:=0;
  end;
 end;

function TTextDrawer.LoadRasterFont(const font:TBuffer;asName:string=''):string;
 var
  fontObj:TUnicodeFontEx;
 begin
  ASSERT(length(fonts)<32);
  fontObj:=TUnicodeFontEx.LoadFromMemory(font,true);
  if asName<>'' then fontObj.displayName:=asName
   else fontObj.displayName:=string(fontObj.header.FontName);
  result:=fontObj.displayName;
  fonts:=fonts+[fontObj];
  if defaultFontHandle=0 then
   defaultFontHandle:=(100 shl 16)+high(fonts);
 end;

function TTextDrawer.LoadVectorFont(const font:TBuffer;asName:string=''):string;
 {$IFDEF FREETYPE}
 var
  ftf:TFreeTypeFont;
 {$ENDIF}
 begin
  result:='';
  ASSERT(length(fonts)<32);
  {$IFDEF FREETYPE}
   ftf:=TFreeTypeFont.LoadFromMemory(font,0);
   if asName<>'' then ftf.faceName:=asName;
   result:=ftf.faceName;
   fonts:=fonts+[ftf];
   if defaultFontHandle=0 then
     defaultFontHandle:=GetFont(result,8*game.screenScale);
   exit;
  {$ENDIF}
  raise EError.Create('FREETYPE required to load vector font');
 end;

function TTextDrawer.LoadFont(fName:string;asName:string=''):string;
 var
  font:ByteArray;
 begin
  font:=Files.LoadAsBytes(Files.FixName(fname));
  if pos('.fnt',fname)>0 then begin
   result:=LoadRasterFont(TBuffer.CreateFrom(font),asName);
  end else begin
   {$IFNDEF FREETYPE}
   raise EError.Create('FREETYPE required to load a vector font: '+fName);
   {$ENDIF}
   result:=LoadVectorFont(TBuffer.CreateFrom(font),asName);
  end;
 end;

function TTextDrawer.Link: integer;
 begin
  result:=curTextLink;
 end;

function TTextDrawer.LinkRect: TRect;
 begin
  result:=curTextLinkRect;
 end;

procedure TTextDrawer.SetScale(scale:single);
 begin
  if globalScale=0 then globalScale:=1.0;
  globalScale:=scale;
 end;

function TTextDrawer.GetFont(name:string;size:single;flags:cardinal=0;effects:byte=0):cardinal;
 var
  i,best,rate,bestRate,matchRate:integer;
  realsize,scale:single;
 begin
  if globalScale=0 then globalScale:=1.0;
  best:=-1; bestRate:=0;
  realsize:=size;
  matchRate:=800;
  name:=LowerCase {TODO: use st.ToLower}(name);
  if Bits.HasAll(flags,fsStrictMatch) then matchRate:=10000;
  if (globalScale<>1) and not Bits.HasAll(flags,fsIgnoreScale) then realSize:=realSize*globalScale;
  // Browse
  for i:=0 to high(fonts) do
   if fonts[i]<>nil then begin
    rate:=0;
    if fonts[i] is TUnicodeFont then
     with fonts[i] as TUnicodeFontEx do begin
      if LowerCase(displayName)=name then rate:=matchRate;
      // size=0 means "native size, no size preference" (see ITextDrawer.GetFont), so the
      // size term is skipped entirely: with realsize=0 it would be a division by zero.
      if realsize>0 then
       rate:=rate+round(3000-600*(0.1*header.width/realsize+realsize/(0.1*header.width)));
      if rate>bestRate then begin
       bestRate:=rate;
       best:=i;
      end;
     end;
    {$IFDEF FREETYPE}
    if fonts[i] is TFreeTypeFont then
     with fonts[i] as TFreeTypeFont do begin
      if lowercase {TODO: use st.ToLower}(faceName)=name then rate:=matchRate*3 else rate:=1;
      if rate>bestRate then begin
        bestRate:=rate;
        best:=i;
      end;
     end;
    {$ENDIF}
   end;
  // Fill the result
  if best>=0 then begin
   if fonts[best] is TUnicodeFont then begin
    if realsize>0 then
     scale:=Clamp(realsize/(0.1*TUnicodeFont(fonts[best]).header.width),0,6.5)
    else
     scale:=1;
    result:=best;
    EncodeScale(scale,result);
   end else
   if fonts[best] is TFreeTypeFont then begin
    result:=best;
    // A vector font has no native size, so size=0 cannot mean scale=1 here: it would
    // encode a zero scale and the text would not be drawn at all.
    if realsize<=0 then begin
     Log.Warn('GetFont("%s",0): a vector font has no native size, using %d',
       [name,DEFAULT_UI_FONT_SIZE]);
     realSize:=DEFAULT_UI_FONT_SIZE*globalScale;
    end;
    // drawn at FreeType size 20*scale = realSize*4/3 points (see ITextDrawer.GetFont)
    EncodeScale(LimitVectorScale(TFreeTypeFont(fonts[best]),realSize/15),result);
    if flags and fsNoHinting>0 then result:=result or fhNoHinting;
    if flags and fsAutoHinting>0 then result:=result or fhAutoHinting;
   end
   else
    result:=0;

   if flags and fsDontTranslate>0 then result:=result or fhDontTranslate;
   if flags and fsItalic>0 then result:=result or fhItalic;
   if flags and fsBold>0 then result:=result or fhBold;
   if flags and fsUnderline>0 then result:=result or fhUnderline;
   if flags and fsTabularDigits>0 then result:=result or fhTabularDigits;
  end
   else result:=0;
 end;

function TTextDrawer.GetFontObject(font:TFontHandle):TObject;
 var
  fontIdx:integer;
 begin
  if font=0 then font:=defaultFontHandle;
  fontIdx:=Bits.GetByte(font,0);
  ASSERT(fontIdx<=high(fonts),'Invalid font handle: '+IntToStr(font));
  result:=fonts[fontIdx];
  ASSERT(result<>nil,'Invalid font object at '+IntToStr(fontIdx));
 end;

procedure TTextDrawer.SetFontOption(handle:TFontHandle;option:cardinal;value:single);
 var
  obj:TObject;
 begin
  obj:=GetFontObject(handle);
  if obj is TUnicodeFontEx then
   case option of
    foDownscaleFactor:TUnicodeFontEx(obj).downscaleFactor:=value;
    foUpscaleFactor:TUnicodeFontEx(obj).upscaleFactor:=value;
    else raise EWarning.Create('SFO: invalid option');
   end;
  {$IFDEF FREETYPE}
  if obj is TFreeTypeFont then
   case option of
    foGlobalScale:TFreeTypeFont(obj).globalScale:=value;
   end;
  {$ENDIF}
 end;

function TTextDrawer.ScaleFont(const font:TFontHandle;scale:single):TFontHandle;
 var
  s,size:single;
  obj:TObject;
 begin
  s:=ScaleFromHandle(font);
  obj:=GetFontObject(font);
  if obj is TFreeTypeFont then begin
   result:=font;
   EncodeScale(LimitVectorScale(TFreeTypeFont(obj),s*scale),result);
  end else
  if obj is TUnicodeFont then begin
   size:=s*TUnicodeFont(obj).header.width/10;
   result:=GetFont(TUnicodeFontEx(obj).displayName,size*scale,fsIgnoreScale);
  end else
   raise EWarning.Create('Not implemented for '+obj.ClassName);
 end;

procedure TTextDrawer.SetTarget(buf:pointer;pitch:integer);
 begin
  TextBufferBitmap:=buf;
  TextBufferPitch:=pitch;
 end;

procedure TTextDrawer.BeginBlock(addOptions:cardinal=0);
 begin
  if not textCaching then begin
   textCaching:=true;
   textBlockOptions:=addOptions;
  end;
 end;

procedure TTextDrawer.ClearLink;
 begin
  curTextLink:=0;
  curTextLinkRect:=types.Rect(-1,-1,-1,-1);
 end;

{ TPenMetrics }

procedure TPenMetrics.Init(obj:TObject;font:TFontHandle);
 var
  d:integer;
  scale:single;
 begin
  uniFont:=nil;
  {$IFDEF FREETYPE}
  ftFont:=nil;
  size:=0;
  {$ENDIF}
  charScale:=1;
  tabular:=false;
  cell:=0;
  if obj is TUnicodeFont then begin
   uniFont:=TUnicodeFontEx(obj);
   scale:=ScaleFromHandle(font);
   if (scale<uniFont.downscaleFactor) or (scale>uniFont.upscaleFactor) then charScale:=scale;
  end
  {$IFDEF FREETYPE}
  else
  if obj is TFreeTypeFont then begin
   ftFont:=TFreeTypeFont(obj);
   size:=20*ScaleFromHandle(font);
  end
  {$ENDIF};
  if Bits.HasAny(font,fhTabularDigits) then begin
   for d:=ord('0') to ord('9') do cell:=Max(cell,GlyphAdv(d));
   tabular:=true;
  end;
 end;

function TPenMetrics.IsCell(ch:Char32):boolean;
 begin
  result:=tabular and (ch>=ord('0')) and (ch<=ord('9'));
 end;

function TPenMetrics.GlyphAdv(ch:Char32):single;
 begin
  result:=0;
  if uniFont<>nil then result:=uniFont.Advance(ch)*charScale
  {$IFDEF FREETYPE}
  else
  if ftFont<>nil then result:=ftFont.Advance(ch,size)
  {$ENDIF};
 end;

function TPenMetrics.Adv(ch:Char32):single;
 begin
  if IsCell(ch) then result:=cell
   else result:=GlyphAdv(ch);
 end;

function TPenMetrics.Step(ch1,ch2:Char32):single;
 begin
  if IsCell(ch1) then exit(cell);
  if IsCell(ch2) then ch2:=ord('0'); // the same step before any digit
  result:=0;
  if uniFont<>nil then result:=uniFont.Interval(ch1,ch2)*charScale
  {$IFDEF FREETYPE}
  else
  if ftFont<>nil then result:=ftFont.Interval(ch1,ch2,size)
  {$ENDIF};
 end;

function TPenMetrics.Shift(ch:Char32):single;
 begin
  if IsCell(ch) then result:=(cell-GlyphAdv(ch))/2
   else result:=0;
 end;

function TPenMetrics.LeftEdge(ch:Char32):single;
 begin
  result:=0; // a raster font counts from the pen
  {$IFDEF FREETYPE}
  if (ftFont<>nil) and not IsCell(ch) then result:=ftFont.CharPadding(ch,size);
  {$ENDIF}
 end;

function TPenMetrics.RightEdge(ch:Char32):single;
 begin
  {$IFDEF FREETYPE}
  if ftFont<>nil then begin // a vector font counts to the last ink pixel, inclusive
   if IsCell(ch) then exit(cell-1);
   exit(ftFont.InkRight(ch,size)-1);
  end;
  {$ENDIF}
  if IsCell(ch) then exit(cell);
  result:=0;
  if uniFont<>nil then result:=uniFont.InkRight(ch)*charScale;
 end;

function TPenMetrics.LineWidth(const st:String32;first,last:integer):single;
 var
  i:integer;
 begin
  result:=0;
  for i:=first to last-1 do result:=result+Step(st[i],st[i+1]);
  result:=result+RightEdge(st[last])-LeftEdge(st[first]);
 end;

function TPenMetrics.LineAdvance(const st:String32;first,last:integer):single;
 var
  i:integer;
 begin
  result:=0;
  for i:=first to last-1 do result:=result+Step(st[i],st[i+1]);
  result:=result+Adv(st[last]);
 end;

// Next line of st from pos: [first..last], pos moves past its line break. False when no
// lines left. CR, LF and CRLF break lines; an empty line gives last<first
function NextLine(const st:String32;var pos:integer;out first,last:integer):boolean;
 begin
  result:=pos<=length(st);
  if not result then exit;
  first:=pos;
  while (pos<length(st)) and (st[pos]<>10) and (st[pos]<>13) do inc(pos);
  last:=pos-1;
  if (pos<length(st)) and (st[pos]=13) and (pos+1<length(st)) and (st[pos+1]=10) then inc(pos);
  inc(pos); // past the break (or past the end: no more lines)
 end;

// A mark that belongs to the word before it: a break between characters never puts it
// at the start of a line
function IsTrailingMark(c:cardinal):boolean;
 begin
  case c of
   ord('.'),ord(','),ord(';'),ord(':'),ord('!'),ord('?'),ord(')'),ord(']'),ord('}'),
   ord('%'),ord(''''),ord('"'),ord('-'),
   $BB,$2019,$201D,$203A, // closing quotes: » ’ ” ›
   $2010..$2015,$2026, // hyphens, dashes, …
   $3001,$3002,$FF01,$FF09,$FF0C,$FF0E,$FF1A,$FF1B,$FF1F: result:=true; // CJK / fullwidth
   else result:=false;
  end;
 end;

constructor TTextDrawer.Create;
 begin
  EnsureThreadState;
  textDrawer:=self;
 end;

destructor TTextDrawer.Destroy;
 var
  i:integer;
begin
  // Should execute before GL context is destroyed: textCache is a GL texture.
  DebugMsg('[LIFECYCLE] Destroy %s',[ClassName]);
  Log.Msg('[LIFECYCLE] Destroy '+ClassName);
  if (textCache<>nil) and textCache.IsLocked then
   textCache.Unlock;
  txtVertCount:=0;
  ClearLink;
  for i:=0 to high(fonts) do
   FreeAndNil(fonts[i]);
  SetLength(fonts,0);
  FreeAndNil(glyphCache);
  FreeAndNil(altGlyphCache);
  FreeImage(textCache);
  if textVB<>nil then begin
   textVB.Free;
   textVB:=nil;
  end;
  if textIB<>nil then begin
   textIB.Free;
   textIB:=nil;
  end;

  defaultFontHandle:=0;
  // TODO: coordinate txt/textDrawer global reset with graphics-system shutdown
  // so engine teardown cannot leave stale singleton references behind.
  inherited;
 end;

procedure TTextDrawer.CreateTextCache;
 var
  i,w:integer;
  format:TImagePixelFormat;
begin
  EnsureThreadState;
  // Adjust text cache texture size
  i:=round(gfx.target.width*gfx.target.height*sqr(gfx.target.pixelRatio)); // screen pixels
  if i>2500000 then textCacheHeight:=Max(textCacheHeight,1024);
  if i>3500000 then textCacheWidth:=Max(textCacheWidth,1024);
  //if i>5500000 then textCacheHeight:=Max(textCacheHeight,2048);
   {$IF TXT_TEXTURE_8BIT}
   format:=ipfA8;
   {$ELSE}
   format:=ipfARGB;
   {$ENDIF}
  textCache:=AllocImage(textCacheWidth,textCacheHeight,format,aiTexture or aiThreadLocal,'textCache');
  // DEBUG: opaque magenta, so any atlas area a glyph shows without having written it is easy to spot
  if format=ipfARGB then textCache.Clear({$IFDEF DEBUG}$FFFF00FF{$ELSE}$808080{$ENDIF});
  Log.Msg('TextCache: %d x %d, %s',[textCacheWidth,textCacheHeight,PixFmt2Str(format)]);

  w:=textCacheWidth div 8+textCacheWidth div 16;
  if glyphCache=nil then glyphCache:=TDynamicGlyphCache.Create(textCacheWidth-w,textCacheHeight);
  if altGlyphCache=nil then begin
   altGlyphCache:=TDynamicGlyphCache.Create(w,textCacheHeight);
   altGlyphCache.relX:=textCacheWidth-w;
  end;
 end;

procedure TTextDrawer.EndBlock;
 begin
  EnsureThreadState;
  FlushTextCache;
  textCaching:=false;
 end;

function TTextDrawer.MeasuredCnt:integer;
 begin
  result:=length(textMetrics);
 end;

function TTextDrawer.MeasuredRect(idx:integer):TRect;
 begin
  result:=textMetrics[clamp(idx,0,high(textMetrics))];
 end;

function TTextDrawer.MeasuredBounds:TRect;
 begin
  result:=measuredText;
 end;

function TTextDrawer.Measure(font:cardinal;st:String8;options:cardinal):TRect;
 begin
  measuredText:=types.Rect(0,0,0,0);
  if length(st)=0 then exit(measuredText);
  WriteW(font,0,0,0,Str32(st),taLeft,options or toMeasure or toDontDraw); // pure geometry: toDontDraw skips clipping/rasterization
  result:=measuredText;
 end;

function TTextDrawer.Width(font:cardinal;st:string8):integer;
 begin
  result:=WidthW(font,UTF8.Decode(st));
 end;

class function TTextDrawer.PixelRatio:single;
 begin
  if pixelRatioOverride>0 then exit(pixelRatioOverride);
  result:=1;
  if renderTargetAPI<>nil then result:=renderTargetAPI.pixelRatio;
  if abs(result-1)<0.001 then result:=1;
 end;

function TTextDrawer.PixelFont(font:TFontHandle;ratio:single):TFontHandle;
 begin
  if font=0 then font:=defaultFontHandle;
  // ScaleFont of a raster font gives only the face and the size: keep the flags
  result:=ScaleFont(font,ratio) or (font and $FF00FF00);
 end;

function TTextDrawer.WidthW(font:cardinal;st:String32):integer;
 var
  k:single;
 begin
  k:=PixelRatio;
  if k=1 then exit(RawWidthW(font,st));
  result:=round(RawWidthW(PixelFont(font,k),st)/k);
 end;

function TTextDrawer.Height(font:cardinal):integer;
 var
  k:single;
 begin
  k:=PixelRatio;
  if k=1 then exit(RawHeight(font));
  result:=round(RawHeight(PixelFont(font,k))/k);
 end;

function TTextDrawer.RawWidthW(font:cardinal;st:String32):integer;
 var
  pm:TPenMetrics;
  pos,first,last:integer;
  w:single;
  width:integer;
  obj:TObject;
  uniFont:TUnicodeFontEx;
  {$IFDEF FREETYPE}
  ftFont:TFreeTypeFont;
  {$ENDIF}
  scale:single;
 begin
  if length(st)=0 then begin
   result:=0; exit;
  end;
  obj:=GetFontObject(font);
  if Bits.HasAny(font,fhTabularDigits) then begin // digits in cells: by the pen rules
   pm.Init(obj,font);
   pos:=0; w:=0;
   while NextLine(st,pos,first,last) do
    if last>=first then w:=Max(w,pm.LineWidth(st,first,last));
   exit(round(w));
  end;
  scale:=ScaleFromHandle(font);
  if obj is TUnicodeFont then begin
   unifont:=obj as TUnicodeFontEx;
   width:=uniFont.GetTextWidth(st);
   if (scale>=unifont.downscaleFactor) and
      (scale<=unifont.upscaleFactor) then scale:=1;
   result:=round(width*scale);
   exit;
  end else
  {$IFDEF FREETYPE}
  if obj is TFreeTypeFont then begin
   ftFont:=obj as TFreeTypeFont;
   result:=ftFont.GetTextWidth(st,20*scale);
   exit;
  end else
  {$ENDIF}
   raise EWarning.Create('GTW 1');
 end;

function TTextDrawer.RawAdvanceW(font:TFontHandle;const st:String32):single;
 var
  pm:TPenMetrics;
  pos,first,last:integer;
 begin
  result:=0;
  if length(st)=0 then exit;
  pm.Init(GetFontObject(font),font);
  pos:=0;
  while NextLine(st,pos,first,last) do
   if last>=first then result:=Max(result,pm.LineAdvance(st,first,last));
 end;

function TTextDrawer.Advance(font:TFontHandle;const st:String8):single;
 begin
  result:=AdvanceW(font,UTF8.Decode(st));
 end;

function TTextDrawer.AdvanceW(font:TFontHandle;const st:String32):single;
 var
  k:single;
 begin
  if font=0 then font:=defaultFontHandle;
  k:=PixelRatio;
  if k=1 then exit(RawAdvanceW(font,st));
  result:=RawAdvanceW(PixelFont(font,k),st)/k;
 end;

procedure TTextDrawer.PenPositions(font:TFontHandle;const st:String32;var pos:SingleArray);
 var
  pm:TPenMetrics;
  i,n:integer;
  k:single;
 begin
  if font=0 then font:=defaultFontHandle;
  k:=PixelRatio;
  if k<>1 then font:=PixelFont(font,k);
  n:=length(st);
  SetLength(pos,n+1);
  pos[0]:=0;
  if n=0 then exit;
  pm.Init(GetFontObject(font),font);
  pos[0]:=-pm.LeftEdge(st[0]);
  for i:=1 to n-1 do pos[i]:=pos[i-1]+pm.Step(st[i-1],st[i]);
  pos[n]:=pos[n-1]+pm.Adv(st[n-1]);
  if k<>1 then
   for i:=0 to n do pos[i]:=pos[i]/k;
 end;

function TTextDrawer.HasGlyph(font:TFontHandle;ch:Char32):boolean;
 var
  obj:TObject;
 begin
  obj:=GetFontObject(font);
  result:=false;
  if obj is TUnicodeFont then result:=TUnicodeFont(obj).HasGlyph(ch)
  {$IFDEF FREETYPE}
  else
  if obj is TFreeTypeFont then result:=TFreeTypeFont(obj).HasGlyph(ch)
  {$ENDIF};
 end;

function TTextDrawer.WrapText(font:TFontHandle;const st:String8;width:single):Strings8;
 var
  widths:SingleArray;
 begin
  result:=WrapText(font,st,width,widths);
 end;

function TTextDrawer.WrapText(font:TFontHandle;const st:String8;width:single;out widths:SingleArray):Strings8;
 var
  s:String32;
  pos:SingleArray;
  cnt,p,first,last:integer;
 procedure AddLine(a,b:integer); // s[a..b)
  var
   line:String32;
  begin
   if cnt>=length(result) then begin
    SetLength(result,cnt*2+4);
    SetLength(widths,cnt*2+4);
   end;
   line:=copy(s,a,b-a);
   result[cnt]:=UTF8.Encode(line);
   widths[cnt]:=WidthW(font,line);
   inc(cnt);
  end;
 function Fits(a,b:integer):boolean; // s[a..b) by Width
  begin
   result:=WidthW(font,copy(s,a,b-a))<=width;
  end;
 procedure WrapParagraph(a,b:integer); // s[a..b)
  var
   start,e,sp,lineEnd,next:integer;
  begin
   if (width<=0) or (b=a) or Fits(a,b) then begin
    AddLine(a,b); exit;
   end;
   PenPositions(font,copy(s,a,b-a),pos); // the pen finds the cut, Width checks it
   start:=a;
   while start<b do begin
    if Fits(start,b) then begin
     AddLine(start,b); break;
    end;
    e:=start+1; // at least one character per line
    while (e<b) and (pos[e+1-a]-pos[start-a]<=width) do inc(e);
    while (e<b) and Fits(start,e+1) do inc(e); // the ink may end before the pen
    while (e>start+1) and not Fits(start,e) do dec(e);
    next:=e;
    if (e<b) and (s[e]<>32) and (s[e-1]<>32) then begin // the cut is inside a word
     sp:=e-1;
     while (sp>start) and (s[sp]<>32) do dec(sp);
     lineEnd:=sp;
     while (lineEnd>start) and (s[lineEnd-1]=32) do dec(lineEnd);
     if (s[sp]=32) and (lineEnd>start) then next:=sp // break at the last space
     else begin // a word longer than the line: break between characters
      while (e>start+1) and IsTrailingMark(s[e]) and (s[e-1]<>32) do dec(e); // the marks go with a letter
      lineEnd:=e; next:=e;
     end;
    end else begin
     lineEnd:=e;
     while (lineEnd>start) and (s[lineEnd-1]=32) do dec(lineEnd);
    end;
    if lineEnd>start then AddLine(start,lineEnd);
    while (next<b) and (s[next]=32) do inc(next); // spaces at the break are dropped
    start:=next;
   end;
  end;
 begin
  result:=nil;
  widths:=nil;
  cnt:=0;
  s:=UTF8.Decode(st);
  p:=0;
  while NextLine(s,p,first,last) do WrapParagraph(first,last+1);
  SetLength(result,cnt);
  SetLength(widths,cnt);
 end;

function TTextDrawer.FitText(font:TFontHandle;const st:String8;width:single;cut:TTextCut=TTextCut.atEnd):String8;
 var
  e:String32;
 begin
  SetLength(e,1);
  e[0]:=$2026;
  result:=FitTextW(font,st,width,cut,e);
 end;

function TTextDrawer.FitText(font:TFontHandle;const st:String8;width:single;cut:TTextCut;const ellipsis:String8):String8;
 begin
  result:=FitTextW(font,st,width,cut,UTF8.Decode(ellipsis));
 end;

function TTextDrawer.FitTextW(font:TFontHandle;const st:String8;width:single;cut:TTextCut;e:String32):String8;
 var
  s:String32;
  n,lo,hi,k:integer;
 // st with k characters kept and the ellipsis at the cut
 function Compose(k:integer):String32;
  var
   head,tail,tailStart:integer;
  begin
   case cut of
    TTextCut.atEnd:begin head:=k; tail:=0; end;
    TTextCut.atStart:begin head:=0; tail:=k; end;
    else begin head:=(k+1) div 2; tail:=k div 2; end;
   end;
   while (head>0) and (s[head-1]=32) do dec(head); // no spaces at the cut
   tailStart:=n-tail;
   while (tailStart<n) and (s[tailStart]=32) do inc(tailStart);
   tail:=n-tailStart;
   result:=nil;
   SetLength(result,head+length(e)+tail);
   if head>0 then Move(s[0],result[0],head*sizeof(Char32));
   if length(e)>0 then Move(e[0],result[head],length(e)*sizeof(Char32));
   if tail>0 then Move(s[tailStart],result[head+length(e)],tail*sizeof(Char32));
  end;
 begin
  s:=UTF8.Decode(st);
  if WidthW(font,s)<=width then exit(st);
  if (length(e)=1) and (e[0]=$2026) and not HasGlyph(font,$2026) then e:=UTF8.Decode('...');
  if (length(e)>0) and (WidthW(font,e)>width) then exit('');
  n:=length(s);
  // the most characters kept that fit (the width grows with them); 0 - the ellipsis alone
  lo:=0; hi:=n-1;
  while lo<hi do begin
   k:=(lo+hi+1) div 2;
   if WidthW(font,Compose(k))<=width then lo:=k
    else hi:=k-1;
  end;
  result:=UTF8.Encode(Compose(lo));
 end;

function TTextDrawer.RawHeight(font:cardinal):integer;
 var
  uniFont:TUnicodeFontEx;
  {$IFDEF FREETYPE}
  ftFont:TFreeTypeFont;
  {$ENDIF}
  scale:single;
  obj:TObject;
 begin
  obj:=GetFontObject(font);
  scale:=ScaleFromHandle(font);
  if obj is TUnicodeFont then begin
   unifont:=obj as TUnicodeFontEx;
   if (scale>=unifont.downscaleFactor) and
      (scale<=unifont.upscaleFactor) then scale:=1;
    result:=round(uniFont.GetHeight*scale);
   exit;
  end else
  {$IFDEF FREETYPE}
  if obj is TFreeTypeFont then begin
   ftFont:=obj as TFreeTypeFont;
   result:=ftFont.GetHeight(20*scale);
  end else
  {$ENDIF}
  raise EWarning.Create('FH 1');
 end;

procedure TTextDrawer.Write(font:cardinal;x,y:single;color:cardinal;st:string8;
   align:TTextAlignment=taLeft;options:cardinal=0;targetWidth:integer=0;query:cardinal=0);
 begin
  WriteW(font,x,y,color,Str32(st),align,options,targetWidth,query);
 end;

procedure TTextDrawer.WriteR(font:TFontHandle;x,y:single;color:cardinal;st:String8;options:cardinal=0);
 begin
  WriteW(font,x,y,color,Str32(st),taRight,options);
 end;

procedure TTextDrawer.WriteC(font:TFontHandle;x,y:single;color:cardinal;st:String8;options:cardinal=0);
 begin
  WriteW(font,x,y,color,Str32(st),taCenter,options);
 end;


procedure TTextDrawer.WriteW(font:cardinal;xx,yy:single;color:cardinal;st:String32;
   align:TTextAlignment=taLeft;options:cardinal=0;targetWidth:integer=0;query:cardinal=0);
 var
  k:single;
  i:integer;
  oldLinkRect:TRect;
 begin
  EnsureThreadState;
  k:=1;
  if (font<>MAGIC_TEXTCACHE) and not Bits.HasAny(options,toDrawToBitmap) then k:=PixelRatio;
  if k=1 then begin
   WritePixels(font,xx,yy,color,st,align,options,targetWidth,query);
   exit;
  end;
  // The projection scales the virtual area up: the text is laid out and rasterized in
  // real pixels, so the glyphs are not stretched; the results go back in virtual pixels
  if font=0 then font:=game.defaultFont;
  if query<>0 then
   query:=cardinal(round(VirtualToPixel(query and $FFFF,k))) and $FFFF+
     cardinal(round(VirtualToPixel(query shr 16,k))) shl 16;
  oldLinkRect:=curTextLinkRect;
  pixelK:=k;
  try
   WritePixels(PixelFont(font,k),VirtualToPixel(xx,k),VirtualToPixel(yy,k),color,st,align,options,
     round(targetWidth*k),query);
  finally
   pixelK:=0;
  end;
  if Bits.HasAny(options,toMeasure) then begin
   for i:=0 to high(textMetrics) do
    textMetrics[i]:=PixelRectToVirtual(textMetrics[i],k);
   measuredText:=PixelRectToVirtual(measuredText,k);
  end;
  if not EqualRect(curTextLinkRect,oldLinkRect) then
   curTextLinkRect:=PixelRectToVirtual(curTextLinkRect,k);
 end;

procedure TTextDrawer.WritePixels(font:cardinal;xx,yy:single;color:cardinal;st:String32;
   align:TTextAlignment;options:cardinal;targetWidth:integer;query:cardinal);
var
 x,y,ofs:integer;
 invK,pixOfs:single; // real pixel position P -> output units: P*invK+pixOfs (see pixelK)

 width:integer; //text width in pixels
 uniFont:TUnicodeFontEx;
 {$IFDEF FREETYPE}
 ftFont:TFreeTypeFont;
 ftHintMode:integer;
 size:single;
 {$ENDIF}
 scale,charScaleX,charScaleY,charSpacing,spaceSpacing:single;
 stepU,stepV:single;
 updList:array[1..20] of TRect;
 updCount:integer;
 drawToBitmap:boolean;
 italicStyle,underlineStyle,boldStyle:boolean;
 link:cardinal;
 linkStart:integer; // x position for link rect
 queryX,queryY:integer;
 activeGlyphCache:TGlyphCache;
 pm:TPenMetrics; // pen steps: the same as in the metrics

 // For complex text
 stack:array[0..7,0..31] of cardinal; // stack of current attributes (0 - default value)
 stackPos:array[0..7] of integer; // pointer to the free element in the stack
 cmdList:array[0..127] of cardinal; // bits 0..7 - what to change, bits 8..9= 0 - clear, 1 - set, 2 - pop
 cmdIndex:array of byte; // total number of commands that must be executed before i-th character
 // Underlined
 linePoints:array[0..63] of TVec2d; // x,y
 lineColors:array[0..31] of cardinal;
 lpCount:integer;

 // Fills cmdList and cmdIndex arrays
 procedure ParseSML;
  var
   i,len,cnt,cmdPos,prefix:integer;
   res:String32;
   tagMode:boolean;
   v:cardinal;
   vst:String8;
   isColor:boolean;
   ch,nextCh:AnsiChar;
  function IsHexChar(ch:AnsiChar):boolean; inline;
   begin
    result:=((ch>='0') and (ch<='9')) or
            ((ch>='a') and (ch<='f')) or
            ((ch>='A') and (ch<='F'));
   end;
  begin
   lpCount:=0;
   len:=length(st);
   SetLength(res,len);
   Setlength(cmdIndex,len+1);
   i:=0; cnt:=0; tagMode:=false; prefix:=1;
   cmdPos:=0;
   while i<len do begin
    ch:=st.AnsiChar(i,#0);
    nextCh:=st.AnsiChar(i+1,#0);
     if tagmode then begin
      // inside {}
      case ch of
       '}':tagmode:=false;
       'B','b','I','i','U','u':begin
        case ch of
         'B','b':v:=0;
         'I','i':v:=1;
         'U','u':v:=2;
        end;
       cmdList[cmdPos]:=prefix shl 8+v; inc(cmdPos);
      end;
      'C','c','L','l','F','f':begin
       case ch of
        'C','c':v:=4;
        'F','f':v:=5;
        'L','l':v:=6;
       end;
       isColor:=v=4;
       cmdList[cmdPos]:=prefix shl 8+v; inc(cmdPos);
       if (i+1<len) and (nextCh='=') then begin
        inc(i,2); vst:='';
        while (i<len) and IsHexChar(st.AnsiChar(i,#0)) do begin
         vst:=vst+st.AnsiChar(i,#0);
         inc(i);
        end;
        v:=Conv.HexToInt(vst);
        if isColor then begin
         if length(vst)=3 then begin                  // 'rgb' -> FFrrggbb
          v:=v and $F+(v and $F0) shl 4+(v and $F00) shl 8;
          v:=v or v shl 4 or $FF000000;
         end else
         if length(vst)=6 then v:=$FF000000 or v; // 'rrggbb' -> FFrrggbb, '00rrggbb' -> 00rrggbb
        end;
        dec(i);
       end else
        v:=0;
       cmdList[cmdPos]:=v; inc(cmdPos);
      end;
      '!':prefix:=0;
      '/':prefix:=2;
     end;
    end else begin
     // outside {}
     if (ch='{') and (i<len-1) and
        (nextCh in ['!','/','B','b','I','i','U','u','C','c','G','g','L','l','F','f']) then begin
      tagmode:=true;
      prefix:=1;
     end else begin
      res[cnt]:=st[i];
      cmdIndex[cnt]:=cmdPos;
      inc(cnt);
      // double '{{'
      if (ch='{') and (i<len-1) and (nextCh='{') then inc(i);
     end;
    end;
    inc(i);
   end;
   SetLength(res,cnt);
   cmdIndex[cnt]:=cmdPos;
   SetLength(cmdIndex,cnt+1);
   st:=res;
  end;

 procedure Initialize;
  var
   i,numSpaces:integer;
   obj:TObject;
  begin
   // Object initialization
   uniFont:=nil;
   {$IFDEF FREETYPE}
   ftFont:=nil;
   {$ENDIF}
   obj:=GetFontObject(font);
   scale:=1; charScaleX:=1; charScaleY:=1;

   boldStyle:=Bits.HasAny(options,toBold) or Bits.HasAny(font,fhBold);
   italicStyle:=Bits.HasAny(options,toItalic) or Bits.HasAny(font,fhItalic);
   underlineStyle:=Bits.HasAny(options,toUnderline) or Bits.HasAny(font,fhUnderline);

   if Bits.HasAny(options,toComplexText) then begin
    Mem.Fill(stackPos,sizeof(stackPos),0);
    ParseSML;
    link:=0; linkStart:=-1;
   end;

   if Bits.HasAny(options,toMeasure) then begin
    SetLength(textMetrics,length(st)+1);
    queryX:=query and $FFFF;
    queryY:=query shr 16;
   end;

   {$IFDEF FREETYPE}
   if obj is TFreeTypeFont then begin
     ftFont:=obj as TFreeTypeFont;
     size:=20*ScaleFromHandle(font);
     ftHintMode:=0;
     if Bits.HasAny(options,toNoHinting) or Bits.HasAny(font,fhNoHinting) then begin
       ftHintMode:=ftHintMode or FTF_NO_HINTING;
       font:=font or fhNoHinting;
     end;
     if Bits.HasAny(options,toAutoHinting) or Bits.HasAny(font,fhAutoHinting) then begin
       ftHintMode:=ftHintMode or FTF_AUTO_HINTING;
       font:=font or fhAutoHinting;
     end;
   end else
   {$ENDIF}
   if obj is TUnicodeFont then begin
     unifont:=obj as TUnicodeFontEx;
     scale:=ScaleFromHandle(font);
     charScaleX:=1; charScaleY:=1;
     if (scale<unifont.downscaleFactor) or
        (scale>unifont.upscaleFactor) then begin
       charScaleX:=scale; charScaleY:=scale;
     end;
   end;

   if Bits.HasAny(options,toTabularDigits) then font:=font or fhTabularDigits; // measured the same way
   pm.Init(obj,font);

   width:=0;
   charSpacing:=0; // extra spacing between regular characters
   spaceSpacing:=0; // extra width of spaces
   {$IFDEF FREETYPE}
   if Bits.HasAny(options,toLetterSpacing) or Bits.HasAny(font,fsLetterSpacing) then
    if ftFont<>nil then charSpacing:=round(ftFont.GetHeight(size)*0.1);
   {$ENDIF}

   drawToBitmap:=Bits.HasAny(options,toDrawToBitmap);

   // Adjust color
{   if textCache.PixelFormat<>ipfA8 then begin
     if not drawToBitmap then // Convert color to FF808080 range
       color:=(color and $FF000000)+((color and $FEFEFE shr 1));
   end;}

   // Alignment
   if Bits.HasAny(options,toAddBaseline) then begin
     if uniFont<>nil then inc(y,round(uniFont.header.baseline*scale));
     {$IFDEF FREETYPE}
     if ftFont<>nil then inc(y,round(1.25+ftFont.GetHeight(size)));
     {$ENDIF}
   end;
   numSpaces:=0;
   for i:=0 to length(st)-1 do
     if st[i]=ord(' ') then inc(numSpaces);

   width:=RawWidthW(font,st); // text width in real pixels
   case align of
    taRight:begin
     if targetWidth>0 then x:=x+targetWidth;
     dec(x,width);
    end;
    taCenter:x:=x+(targetWidth-width) div 2;
    taJustify:if (length(st)>0) and not ((st[length(st)-1]=10) or (st[length(st)-1]=13)) then begin
     i:=width;
     if i<round(targetWidth*0.95-10) then SpaceSpacing:=0
      else SpaceSpacing:=targetWidth-i;
     if numSpaces>0 then SpaceSpacing:=SpaceSpacing/numSpaces;
    end;
   end;
   {$IFDEF FREETYPE}
   if (align=taCenter) and (obj is TFreeTypeFont) and (length(st)>0) and not pm.IsCell(st[0]) then begin // indent is ignored when centering
    dec(x,ftFont.CharPadding(st[0],size));
   end;
   {$ENDIF}
  end;

 // Fills specified area in textCache with glyph image
 // Don't forget about 1px padding BEFORE glyph (mode: true=4bpp, false - 8bpp)
 // The whole allocated cell is written (padding, bold column), so no previous atlas content stays there
 procedure UnpackGlyph(x,y,width,height:integer;glyphData:PByte;mode:boolean);
  var
   row:array[0..GLYPH_MAX_CELL_WIDTH-1] of byte; // the glyph cache doesn't accept wider cells
   tX,tY,bpp,cellWidth:integer;
   pLine:PByte;
   v:byte;
  procedure StoreRow;
   var
    i:integer;
    pData:PByte;
   begin
    pData:=pLine;
    if bpp=4 then begin
     for i:=0 to cellWidth-1 do begin
      PCardinal(pData)^:=row[i] shl 24+$808080; // ARGB with neutral color
      inc(pData,4);
     end;
    end else
    if bpp=1 then
     move(row,pLine^,cellWidth)
    else
    if bpp=2 then begin
     for i:=0 to cellWidth-1 do begin
      PWord(pData)^:=(row[i] and $F0) shl 8+$888; // 4-4-4-4 texture
      inc(pData,2);
     end;
    end;
    inc(pLine,textCache.pitch);
   end;
  begin
   cellWidth:=width+2+byte(boldStyle); // as allocated in AllocGlyph
   ASSERT(cellWidth<=length(row));
   pLine:=textCache.data;
   bpp:=PixelSize[textCache.pixelFormat] div 8; // 1,2 or 4 bytes per pixel in target texture
   inc(pLine,X*bpp+Y*textCache.pitch);
   // Top padding (glyph rows below overwrite only row[1..width])
   Mem.Fill(row,cellWidth,0);
   StoreRow;
   // Glyph image
   for tY:=0 to Height-1 do begin
    // Unpack row
    if mode then begin // 4 bits per pixel
     for tX:=1 to Width do begin
       if tX and 1=0 then begin
        v:=glyphData^ shr 4;
        inc(glyphData);
       end else
        v:=glyphData^ and $F;
       row[tX]:=v*17;
     end;
     if width and 1=1 then inc(glyphData); // alignment
    end else begin // 8 bits per pixel - just move
     move(glyphData^,row[1],width);
     inc(glyphData,width);
    end;
    StoreRow;
   end;
   // bottom padding
   Mem.Fill(row,cellWidth,0);
   StoreRow;
  end;

 // Applies bold effect to given area in textCache
 procedure MakeItBold(x,y,width,height:integer);
  var
   pLine,pixelData:PByte;
   tx,ty,bpp:integer;
   v,r,prev:integer;
  begin
   pLine:=textCache.data;
   bpp:=PixelSize[textCache.pixelFormat] div 8;
   inc(pLine,X*bpp+Y*textCache.pitch);
   for ty:=0 to height-1 do begin
    inc(pLine,textCache.pitch);
    pixelData:=pLine; prev:=0;
    inc(pixelData,bpp-1);
    for tX:=0 to Width do begin // make it 1 pixel wider
     inc(pixelData,bpp);
     v:=pixelData^;
     r:=v+prev;
     if r>255 then r:=255;
     prev:=v;
     pixelData^:=r;
    end;
   end;
  end;

 // Allocate cache space and copy glyph image to the cache texture
 // chardata - glyph image hash
 // imageWidth,imageHeight - glyph dimension
 // dX,dY - glyph relative position (for FT)
 // glyphType - 1 = 4bpp, 2 = 8bpp
 // data - pointer to glyph data
 // pitch - glyph image pitch (for 8bpp images only)
 function AllocGlyph(chardata:cardinal;imageWidth,imageHeight,dX,dY:integer;
     glyphType:integer;data:pointer;pitch:integer):TPoint;
  var
   i:integer;
   fl:boolean;
   r:TRect;
  begin
   // 1 transparent pixel in padding
   // A glyph the cache cannot take is dropped (result.x<0): the rest of the text is still drawn
   try
    result:=activeGlyphCache.Alloc(imageWidth+2+byte(boldStyle),imageHeight+2,dX,dY,chardata);
   except
    on e:Exception do begin
     inc(glyphFailures);
     if glyphFailures<=5 then
      Log.Warn('Glyph dropped: '+String8(e.Message));
     if glyphFailures=5 then
      Log.Warn('Further dropped glyphs are not logged');
     exit(Point(-1,-1));
    end;
   end;
   if not textCache.IsLocked then textCache.Lock(0,TLockMode.lmCustomUpdate);
   UnpackGlyph(result.x,result.Y,imageWidth,imageHeight,data,glyphType=1);
   if boldStyle then MakeItBold(result.x,result.Y,imageWidth,imageHeight);
   fl:=true;
   r:=types.Rect(result.X,result.y,result.x+imageWidth+1+byte(boldStyle),result.y+imageHeight+1); // inclusive
   for i:=1 to updCount do
    if updList[i].Top=result.y then begin
     UnionRect(updList[i],updList[i],r);
     fl:=false;
     break;
    end;
   if fl then begin
    if updCount>=High(updList) then
     raise EWarning.Create('Too many glyph-cache update rows at once');
    inc(updCount);
    updList[updCount]:=r;
   end;
   inc(result.X); inc(result.Y); // padding
  end;

 // chardata - hash for glyph caching (the character itself, font, size, style)
 // pnt - glyph position in the texture cache
 // x,y - screen coordinates of the cursor point
 // imageX, imageY - glyph position relative to the cursor point
 // imageWIdth, imageHeight - glyph size
 procedure AddVertices(chardata:cardinal;pnt:TPoint;x,y:integer;imageX,imageY,imageWidth,imageHeight:integer;
   var data:PVertex;var counter:integer);
  var
   u1,u2,v1,v2:single;
   x1,y1,x2,y2,dx1,dx2:single;
  procedure AddVertex(var data:PVertex;vx,vy,u,v:single;color:cardinal); inline;
   begin
    data.x:=vx;
    data.y:=vy;
    data.z:=0;
    data.color:=ApplyTextColor(data.x,data.y,color);
    data.u:=u; data.v:=v;
    inc(data);
   end;
  begin
    u1:=pnt.X*stepU;
    u2:=(pnt.X+imageWidth)*stepU;
    v1:=pnt.Y*stepV;
    v2:=(pnt.Y+imageHeight)*stepV;

    x1:=x+(imageX-0.5)*charScaleX;
    x2:=x+(imageX+imageWidth-0.5)*charScaleX;
    y1:=y-(imageY+0.5)*charScaleY;
    y2:=y-(imageY-imageHeight+0.5)*charScaleY;
    // faux italics: slant proportional to the height above the baseline
    dx1:=(y-y1)*0.25;
    dx2:=(y-y2)*0.25;
    // real pixels -> output units
    x1:=x1*invK+pixOfs; x2:=x2*invK+pixOfs;
    y1:=y1*invK+pixOfs; y2:=y2*invK+pixOfs;
    dx1:=dx1*invK; dx2:=dx2*invK;
    if not italicStyle then begin
     AddVertex(data,x1,y1,u1,v1,color);
     AddVertex(data,x2,y1,u2,v1,color);
     AddVertex(data,x2,y2,u2,v2,color);
     AddVertex(data,x1,y2,u1,v2,color);
    end else begin
     AddVertex(data,x1+dx1,y1,u1,v1,color);
     AddVertex(data,x2+dx1,y1,u2,v1,color);
     AddVertex(data,x2+dx2,y2,u2,v2,color);
     AddVertex(data,x1+dx2,y2,u1,v2,color);
    end;
    inc(counter);
  end;

 procedure ExecuteCmd(var cmdPos:integer);
  var
   v,cmd,idx:cardinal;
  begin
   v:=cmdList[cmdPos];
   idx:=v and 15;
   cmd:=v shr 8;
   if cmd<2 then begin
    // push and set new value
    case idx of
     0:v:=byte(boldStyle);
     1:v:=byte(italicStyle);
     2:v:=byte(underlineStyle);
     4:v:=color;
     6:v:=link;
    end;
    stack[idx,stackPos[idx]]:=v;
    inc(stackPos[idx]);
    if idx>=4 then begin
     inc(cmdPos);
     v:=cmdList[cmdPos];
    end;
    case idx of
     0:boldStyle:=(cmd=1);
     1:italicStyle:=(cmd=1);
     2:underlineStyle:=(cmd=1);
     4:color:=v;
     6:begin
        link:=v;
        stack[2,stackpos[2]]:=byte(underlineStyle);
        inc(stackpos[2]);
        stack[4,stackpos[4]]:=color;
        inc(stackpos[4]);
        ApplyLinkStyle(link,underlineStyle,color);
       end;
    end;
   end else begin
    // pop value
    if stackPos[idx]>0 then dec(stackPos[idx]);
    v:=stack[idx,stackpos[idx]];
    case idx of
     0:boldStyle:=(v<>0);
     1:italicStyle:=(v<>0);
     2:underlineStyle:=(v<>0);
     4:color:=v;
     6:begin link:=v;
        if stackpos[4]>0 then dec(stackpos[4]);
        color:=stack[4,stackPos[4]];
        if stackpos[2]>0 then dec(stackpos[2]);
        underlineStyle:=stack[2,stackPos[2]]<>0;
       end;
    end;
   end;
   inc(cmdPos);
  end;

 procedure BuildVertexData;
  var
   i,cnt,idx,w:integer;
   {$IFDEF FREETYPE}
   dx,dy,imgW,imgH,pitch:integer;
   {$ENDIF}
   px,advance:single;
   chardata:cardinal;
   outVertex:PVertex;
   gl:TGlyphInfoRec;
   pnt:TPoint;
   {$IFDEF FREETYPE}
   pb:PByte;
   fl,oldUL:boolean;
   {$ELSE}
   oldUL:boolean;
   {$ENDIF}
   oldColor,oldLink:cardinal;
   cmdPos:integer;
   fHeight:integer;
  begin
   px:=x; // coordinate in real screen pixels
   if Bits.HasAny(options,toMeasure) then begin
    fHeight:=round(RawHeight(font)*1.1);
    textMetrics[0]:=types.Rect(x,y-fHeight,x+1,y);
   end;
   cnt:=0;
   updCount:=0;
   cmdPos:=0;
   lpCount:=0;
   {$IFDEF FREETYPE}
   dx:=0; dy:=0;
   {$ENDIF}
   try
   activeGlyphCache.Keep;
   stepU:=textCache.stepU*2;
   stepV:=textCache.stepV*2;
   oldUL:=false; oldColor:=color; oldLink:=0;
   outVertex:=@txtBuf[txtVertCount];
   for i:=0 to length(st)-1 do begin
    if st[i]=$FEFF then continue; // Skip BOM
    // Complex text
    if Bits.HasAny(options,toComplexText) then begin
     oldLink:=link;
     while cmdPos<cmdIndex[i] do ExecuteCmd(cmdPos);
    end;
    if (oldLink=0) and (link<>0) then linkStart:=round(px);
    // Go to next character
    if i>0 then begin
     advance:=pm.Step(st[i-1],st[i]);
     px:=px+advance+charSpacing;
     if st[i-1]=ord(' ') then px:=px+spaceSpacing;
     // Metrics
     if Bits.HasAny(options,toMeasure) then begin
       textMetrics[i]:=types.Rect(round(px),y-fHeight,round(px)+1,y);
       textMetrics[i-1].Right:=round(px)-1;
       if (oldLink<>0) and
          (queryX>=textMetrics[i-1].left) and (queryX<px) and
          (queryY<y+fHeight shr 1) and (queryY>=y-fHeight) then begin
        curTextLink:=oldLink;
        curTextLinkRect.Left:=linkStart;
       curTextLinkRect.Right:=-1;
       curTextLinkRect.Top:=y-fHeight;
       curTextLinkRect.Bottom:=y+fHeight shr 1;
      end;
     end;
    end;
    if (oldLink<>0) and (link=0) and
       (curTextLinkRect.left>=0) and (curTextLinkRect.Right<0) then curTextLinkRect.Right:=round(px);
    // Underline support
    if (underlineStyle<>oldUL) or (underlineStyle and (oldColor<>color)) then begin
     linePoints[lpCount].x:=round(px);
     linePoints[lpCount].y:=y+2;
     if underlineStyle then
      lineColors[lpCount shr 1]:=color;
     inc(lpCount);
     if oldUL and underlineStyle then begin
      linePoints[lpCount].x:=round(px);
      linePoints[lpCount].y:=y+2;
      if underlineStyle then lineColors[lpCount shr 1]:=color;
      inc(lpCount);
     end else
      oldUL:=underlineStyle;
     oldColor:=color;
     if lpCount>=high(linePoints) then dec(lpCount,2);
    end;

    if Bits.HasAny(options,toDontDraw) then begin
     if i=0 then px:=px-pm.LeftEdge(st[0]); // as the glyph would shift the pen below
     continue;
    end;
    if st[i]=32 then continue; // space -> no glyph => skip drawing

    if uniFont<>nil then begin // Unicode raster font
     idx:=unifont.IndexOfChar(st[i]);
     with unifont.chars[idx] do
      if imageWidth>0 then begin // char has glyph image
       chardata:=cardinal(st[i] and $FFFF)+font shl 16;
       gl:=activeGlyphCache.Find(chardata);
       inc(gl.x); inc(gl.y); // padding
       if gl.x=0 then begin
        pnt:=AllocGlyph(charData,imageWidth,imageHeight,0,0,1,@unifont.glyphs[offset],0);
        w:=imageWidth+byte(boldStyle); // faux bold makes the image 1 pixel wider
       end else begin
        pnt:=Point(gl.x,gl.y);
        w:=gl.width-2;
       end;
       if pnt.x>=0 then
        AddVertices(chardata,pnt,round(px+pm.Shift(st[i])),y,imageX,imageY,w,imageHeight,outVertex,cnt);
      end;
    end
    {$IFDEF FREETYPE}
    else
    if ftFont<>nil then begin     // FreeType font
     fl:=false; // does glyph exist for this symbol?
     // find glyph image location in cache
     chardata:=cardinal(st[i]) xor ((font and $3F) shl 16) xor ((font and $FF0F00) shl 8) xor (cardinal(byte(boldStyle)) shl 23);
     gl:=activeGlyphCache.Find(chardata);
     inc(gl.x); inc(gl.y); // padding
     if gl.x=0 then begin // glyph is not cached
      pb:=ftFont.RenderGlyph(st[i],size,ftHintMode,dx,dy,imgW,imgH,pitch);
      if pb<>nil then begin
       pnt:=AllocGlyph(charData,imgW,imgH,dx,dy,2,pb,pitch);
       fl:=pnt.x>=0;
       inc(imgW,byte(boldStyle)); // same width as gl.width-2 on a cache hit
      end;
     end else begin
      // glyph is cached
      pnt:=Point(gl.x,gl.y);
      imgW:=gl.width-2;
      imgH:=gl.height-2;
      dx:=gl.dx;
      dy:=gl.dy;
      fl:=true;
     end;
     if (i=0) and not pm.IsCell(st[0]) then px:=px-dx; // remove any x-padding for the 1-st character
     if fl then
      AddVertices(chardata,pnt,round(px+pm.Shift(st[i])),y,dX,dY,imgW,imgH,outVertex,cnt);
    end
    {$ENDIF};
   end; // FOR

   // Metrics
   if Bits.HasAny(options,toMeasure) and (length(st)>0) then begin
     i:=round(x)+width;
     textMetrics[length(st)]:=types.rect(i,y-fHeight,i,y);
     if (link>0) and
        (queryX>=textMetrics[length(st)-1].left) and (queryX<i) and
       (queryY<y+fHeight shr 1) and (queryY>=y-fHeight) then begin
      curTextLink:=link;
      curTextLinkRect.Left:=linkStart;
       curTextLinkRect.Right:=i-1;
      curTextLinkRect.Top:=y-fHeight;
      curTextLinkRect.Bottom:=y+fHeight shr 1;
    end;
    // whole-line bounding rect (top=ascent line, bottom=baseline), relative to pen position
    measuredText:=types.Rect(round(x),y-fHeight,round(x)+width,y);
   end;

    if (curTextLinkRect.Left>=0) and (curTextLinkRect.Right<0) then curTextLinkRect.Right:=round(x)+width;

   // last underline
   if lpCount and 1=1 then begin
     linePoints[lpCount].x:=round(x)+width;
    linePoints[lpCount].y:=y+2;
    inc(lpCount);
   end;

   for i:=1 to updCount do
    textCache.AddDirtyRect(updList[i]);

   finally
    activeGlyphCache.Release;
    if textCache.IsLocked then textCache.Unlock;
   end;
   inc(txtVertCount,4*cnt);
  end;

 function DefineRectAndSetState:boolean;
  var
   r:TRect;
   {$IFDEF FREETYPE}
   height:integer;
   {$ENDIF}
  begin
   if unifont<>nil then
    r:=types.Rect(x, y-unifont.header.baseline,x+width+1,y+unifont.header.baseline div 2)
   {$IFDEF FREETYPE}
   else
   if ftFont<>nil then begin
    height:=ftFont.GetHeight(size);
    r:=types.Rect(x, y-height-height div 2,x+width+1,y+height div 2);
   end
   {$ENDIF};
   if invK=1 then begin
    if not clippingAPI.Prepare(r) then exit(false);
   end else
    if not clippingAPI.Prepare(r.Left*invK+pixOfs,r.Top*invK+pixOfs,
      r.Right*invK+pixOfs,r.Bottom*invK+pixOfs) then exit(false);

    {$IF TXT_TEXTURE_8BIT}
    shader.TexMode(0,tblKeep,tblReplace);
    {$ELSE}
    shader.TexMode(0,tblModulate2x,tblModulate);
    {$ENDIF}
   result:=true;
  end;

 procedure DrawUnderlines;
  var
   i:integer;
  begin
   i:=0;
   // draw.Line puts a coordinate c on the real pixel c*k itself (TDrawer.HairlineShift)
   while i<lpCount do begin
    draw.Line(linePoints[i].x*invK,linePoints[i].y*invK,
      linePoints[i+1].x*invK,linePoints[i+1].y*invK,lineColors[i shr 1]);
    inc(i,2);
   end;
  end;

  // Render/measure a string broken by '\r\n', '\n' or '\r' into separate lines.
  // Each line goes through the single-line WriteW path; in toMeasure mode the
  // per-line bounding rects are unioned into measuredText (relative to pen position).
  procedure DrawMultiline;
   var
    i,j,lineHeight,fHeight,emptyTop,emptyBottom:integer;
    drawOptions:cardinal;
    measuring,firstLine:boolean;
    acc,lineRect:TRect;
   procedure EmitLine(lineStart,lineEnd:integer); // [lineStart,lineEnd)
    begin
     if lineEnd>lineStart then begin
      WritePixels(font,x,y,color,copy(st,lineStart,lineEnd-lineStart),align,drawOptions,targetWidth,query);
      lineRect:=measuredText; // set by the single-line call above (toMeasure path)
     end else
      lineRect:=types.Rect(round(x),y+emptyTop,round(x),y+emptyBottom); // empty line: zero width, full height
     if measuring then begin
      if firstLine then acc:=lineRect
       else UnionRect(acc,acc,lineRect);
      firstLine:=false;
     end;
     inc(y,lineHeight);
    end;
  begin
   measuring:=Bits.HasAny(options,toMeasure);
   fHeight:=round(RawHeight(font)*1.1);
   emptyTop:=-fHeight; emptyBottom:=0;
   lineHeight:=round(RawHeight(font)*1.65);
   drawOptions:=options or toDontTranslate;
   acc:=types.Rect(round(x),y,round(x),y);
   firstLine:=true;
   i:=0; j:=0;
   while j<length(st) do
    if (st[j]=13) or (st[j]=10) then begin
     EmitLine(i,j);
     if (st[j]=13) and (j+1<length(st)) and (st[j+1]=10) then inc(j,2) // CRLF
      else inc(j);
     i:=j;
    end else
     inc(j);
   EmitLine(i,length(st)); // trailing line (after the last break)
   if measuring then measuredText:=acc;
  end;

 procedure DrawTextCache;
  const
   backColors:array[0..3] of cardinal=($FF000000,$FFFFFFFF,$FF80C000,$FF008000);
   frontColors:array[0..3] of cardinal=($FFFFFFFF,$FF000000,$FFC04080,$FFFFFFFF);
  var
   n:integer;
  begin
   n:=(window.frameStartMs div 2000) mod 4;
   draw.FillRect(x,y,x+textCache.width,y+textCache.height,backColors[n]);
   draw.Image(x,y,textCache,frontColors[n]);
  end;

begin // -----------------------------------------------------------
 EnsureThreadState;
 if pixelK>0 then invK:=1/pixelK else invK:=1;
 pixOfs:=0.5*invK-0.5; // pixel centers -> virtual pixel centers (0 when not scaled)
 if textCache=nil then CreateTextCache;
 x:=SRound(xx); y:=SRound(yy);
 // Special value to display font cache texture
 if font=MAGIC_TEXTCACHE then begin
  DrawTextCache;
  exit;
 end;

 if textCaching and not Bits.HasAny(options,toInternalNoBlock) then
  Bits.SetFlag(options,textBlockOptions);

 if font=0 then font:=game.defaultFont;
 // Empty or too long string
 if (length(st)=0) or (length(st)>1000) then exit;

 // Translation
 if not Bits.HasAny(font,fhDontTranslate) and not Bits.HasAny(options,toDontTranslate) then
  st:=translate32(st);

 // Multiline? (any of CRLF, bare LF or bare CR acts as a line break)
 if st.Contains(UCS4Char(10)) or st.Contains(UCS4Char(13)) then begin
  DrawMultiline;
  exit;
 end;

 // Special option: draw twice with offset
 if Bits.HasAny(options,toWithShadow) then begin
  Bits.Clear(options,toWithShadow);
  ofs:=Max(1,round(RawHeight(font)/12));
  WritePixels(font,x+ofs,y+ofs,color and $FE000000 shr 1,st,align,options or toInternalNoBlock,targetWidth,0);
  WritePixels(font,x,y,color,st,align,options or toInternalNoBlock,targetWidth,0);
  exit;
 end;

 activeGlyphCache:=glyphCache;
 if Bits.HasAny(options,toDontCache) then
  activeGlyphCache:=altGlyphCache; // keep dynamic glyph sizes out of the main atlas

 // Set up variables, adjust parameters, alignment
 Initialize;

 // RENDER TO BITMAP?
 if drawToBitmap then begin
  if unifont<>nil then begin
   unifont.RenderText(textBufferBitmap,textBufferPitch,x,y,st,color,charScaleX);
   exit;
  end;
  {$IFDEF FREETYPE}
  if ftFont<>nil then begin
   ftFont.RenderText(textBufferBitmap,textBufferPitch,x,y,st,color,size,
     ftHintMode+FTF_ITALIC*byte(italicStyle));
   exit;
  end;
  {$ENDIF}
  exit;
 end;

 // NORMAL TEXT RENDERING
 if not Bits.HasAny(options,toDontDraw) then begin
  if not DefineRectAndSetState then exit;  // Clipping (broken for multiline text)

  // Prevent text cache overflow
  if txtVertCount+length(st)*4>=4*MaxGlyphBufferCount then FlushTextCache;
 end;

 // Fill vertex buffer and update glyphs in cache when needed
 BuildVertexData;

 // DRAW IF NEEDED
 if not textCaching or (lpCount>0) then FlushTextCache;

 // Underlines
 if (lpCount>0) and not Bits.HasAny(options,toDontDraw) then DrawUnderlines;
end;

{ TUnicodeFontEx }
procedure TUnicodeFontEx.InitDefaults;
 begin
  inherited;
  downscaleFactor:=DEFAULT_FONT_DOWNSCALE;
  upscaleFactor:=DEFAULT_FONT_UPSCALE;
 end;

initialization
 textLinkStyleProc:=DefaultTextLinkStyle;
end.