Apus.Engine.TextEffects.pas

// Text with effect layers: glow, soft outline, shadow (R-33)
//
// For each layer the text shape is shifted by (dx,dy), grown by `spread` (round dilation),
// blurred (gaussian, `blur` = visible radius) and filled with the layer color; layers are
// stacked in order (the first one is the lowest), the text goes on top.
// The composite is baked once (on GPU, through the regular txt.Write path) and cached;
// the alpha of the text color modulates the whole composite at draw time, so fading
// text never re-bakes.
//
// Design: Work/R-33_text_effects_design.md
//
// Copyright (C) 2026 Ivan Polyacov, 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 (http://apus-software.com/engine/)
// -----------------------------------------------------
unit Apus.Engine.TextEffects;
interface
 uses Apus.Core, Apus.Engine.API;

 type
  // One effect layer under the text. Sizes are in virtual pixels of the current render
  // target (canvas units), like the text coordinates
  TTextEffectLayer=record
   color:cardinal; // layer color, alpha = layer opacity
   dx,dy:single; // offset
   spread:single; // grow the text shape (round dilation), 0..MAX_SPREAD: outlines, solid glow core
   blur:single; // gaussian blur, visible radius (sigma = blur/3), 0..MAX_BLUR
   // Soft light around the text
   class function Glow(color:cardinal;blur:single;spread:single=0):TTextEffectLayer; static;
   // Outline of the given width; softness = blur of its edge
   class function Outline(color:cardinal;width:single;softness:single=1):TTextEffectLayer; static;
   // Offset copy of the text under it
   class function Shadow(color:cardinal;dx,dy:single;blur:single=0):TTextEffectLayer; static;
  end;

 const
  MAX_SPREAD = 16;
  MAX_BLUR   = 64;

 // Draw text with effect layers (glow, outline, soft shadow).
 // x,y is the text anchor exactly as in txt.Write: the same call without layers
 // puts the glyphs at the same pixels. color.RGB = text color (baked);
 // color.alpha modulates the whole composite at draw time (fading is free).
 // The result is baked on GPU once and cached per (font,text,align,options,text RGB,layers).
 // Effect sizes are in virtual pixels of the current render target; a virtual area scaled
 // up by the projection is baked in real pixels, so it stays sharp. The text is not translated
 // separately for the cache key: call FlushTextFXCache after switching the dictionary.
 procedure DrawTextFX(font:TFontHandle;x,y:single;color:cardinal;const st:String8;
   align:TTextAlignment;const layers:array of TTextEffectLayer;options:cardinal=0);

 // Draw only the effect layers. The cache key does not contain the glyph color;
 // callers can draw normal text on top and animate its color without re-baking.
 // opacity modulates all layers, like the text color alpha in DrawTextFX.
 procedure DrawTextFXLayers(font:TFontHandle;x,y:single;opacity:byte;const st:String8;
   align:TTextAlignment;const layers:array of TTextEffectLayer;options:cardinal=0);

 // Drop all cached sprites of the calling render thread: call after SetFontOption,
 // font reload or dictionary switch (txt.SetScale is part of the cache key, no flush needed)
 procedure FlushTextFXCache;

implementation
 uses Types, Apus.Images, Apus.Geom2D, Apus.Geom3D,
   Apus.Engine.Resources, Apus.Engine.Graphics, Apus.Engine.TextDraw;

 const
  MAX_ENTRIES = 64;              // cached sprites per render thread
  MAX_PIXELS  = 4*1024*1024;     // total cached area per render thread
  MAX_SIDE    = 2048;            // larger text is drawn without effects
  POOL_STEP   = 64;              // work render targets grow in these steps
  RT_FLAGS    = aiTexture+aiRenderTarget+aiClampUV+aiThreadLocal;

  // Shift by (dx,dy) + round dilation of the text alpha by `spread` (antialiased edge)
  SPREAD_SHADER=
   'uniform vec2 texel;'#13#10+
   'uniform vec2 shift;'#13#10+
   'uniform float spread;'#0+
   'vec2 uv = vTexCoord-shift;'#13#10+
   'float s = texture(tex0,uv).a;'#13#10+
   'int r = int(ceil(spread));'#13#10+
   'for (int j=-r; j<=r; j++)'#13#10+
   ' for (int i=-r; i<=r; i++) {'#13#10+
   '  float w = clamp(spread+0.5-length(vec2(float(i),float(j))),0.0,1.0);'#13#10+
   '  if (w>0.0) s = max(s,w*texture(tex0,uv+vec2(float(i),float(j))*texel).a);'#13#10+
   ' }'#13#10+
   'fragColor = vec4(1.0,1.0,1.0,s);';

  // Gaussian blur of the alpha along one axis, filled with layerColor
  GAUSS_SHADER=
   'uniform vec2 dir;'#13#10+
   'uniform float sigma;'#13#10+
   'uniform vec4 layerColor;'#0+
   'int r = int(ceil(3.0*sigma));'#13#10+
   'float s = 0.0;'#13#10+
   'float sum = 0.0;'#13#10+
   'for (int i=-r; i<=r; i++) {'#13#10+
   ' float w = exp(-float(i*i)/(2.0*sigma*sigma+1e-6));'#13#10+
   ' s += w*texture(tex0,vTexCoord+dir*float(i)).a;'#13#10+
   ' sum += w;'#13#10+
   '}'#13#10+
   'fragColor = vec4(layerColor.rgb,layerColor.a*s/sum);';

  // Premultiplied accumulator -> straight alpha (regular alpha blending when drawn)
  RESOLVE_SHADER=
   #0+
   'vec4 c = texture(tex0,vTexCoord);'#13#10+
   'if (c.a<=0.0) fragColor = vec4(0.0);'#13#10+
   ' else fragColor = vec4(min(c.rgb/c.a,vec3(1.0)),c.a);';

 type
  // Baked sprite
  TFXEntry=record
   key:String8;
   hash:cardinal;
   tex:TTexture;
   width,height:integer;
   ox,oy:integer; // text anchor inside the sprite
   lastUse:int64;
  end;

  // Per render thread state: work targets and the sprite cache
  TFXState=class
   pool:array[0..3] of TTexture; // text mask, 2 temp layers, premultiplied accumulator
   poolW,poolH:integer;
   entries:array of TFXEntry;
   count:integer;
   pixels:integer;
   useCounter:int64;
   destructor Destroy; override;
   procedure Clear;
   procedure FreePool;
   function EnsurePool(w,h:integer):boolean;
   function Find(const key:String8;hash:cardinal):integer;
   procedure Add(const entry:TFXEntry);
   procedure Evict(idx:integer);
   procedure MakeRoom(pixelsNeeded:integer);
  end;

 threadvar
  fxState:TFXState;

 function GetState:TFXState;
  begin
   if fxState=nil then fxState:=TFXState.Create;
   result:=fxState;
  end;

 { TFXState }

 destructor TFXState.Destroy;
  begin
   Clear;
   inherited;
  end;

 procedure TFXState.FreePool;
  var
   i:integer;
  begin
   for i:=0 to high(pool) do
    if pool[i]<>nil then begin
     FreeImage(pool[i]);
     pool[i]:=nil;
    end;
   poolW:=0; poolH:=0;
  end;

 procedure TFXState.Clear;
  begin
   while count>0 do Evict(count-1);
   FreePool;
  end;

 function TFXState.EnsurePool(w,h:integer):boolean;
  var
   i:integer;
  begin
   if (w<=poolW) and (h<=poolH) then exit(true);
   w:=Max(w,poolW); h:=Max(h,poolH);
   w:=(w+POOL_STEP-1) div POOL_STEP*POOL_STEP;
   h:=(h+POOL_STEP-1) div POOL_STEP*POOL_STEP;
   FreePool;
   for i:=0 to high(pool) do begin
    pool[i]:=AllocImage(w,h,pfRenderTargetAlpha,RT_FLAGS,'TextFX_Work');
    if pool[i]=nil then begin
     FreePool;
     exit(false);
    end;
   end;
   poolW:=w; poolH:=h;
   result:=true;
  end;

 function TFXState.Find(const key:String8;hash:cardinal):integer;
  var
   i:integer;
  begin
   for i:=0 to count-1 do
    if (entries[i].hash=hash) and (entries[i].key=key) then exit(i);
   result:=-1;
  end;

 procedure TFXState.Add(const entry:TFXEntry);
  begin
   MakeRoom(entry.width*entry.height);
   if count>=length(entries) then SetLength(entries,count+16);
   entries[count]:=entry;
   inc(count);
   inc(pixels,entry.width*entry.height);
  end;

 procedure TFXState.Evict(idx:integer);
  begin
   with entries[idx] do begin
    FreeImage(tex);
    dec(pixels,width*height);
   end;
   entries[idx]:=entries[count-1];
   entries[count-1]:=Default(TFXEntry);
   dec(count);
  end;

 // Drop least recently used entries until a new sprite fits the limits
 procedure TFXState.MakeRoom(pixelsNeeded:integer);
  var
   i,oldest:integer;
  begin
   while (count>0) and ((count>=MAX_ENTRIES) or (pixels+pixelsNeeded>MAX_PIXELS)) do begin
    oldest:=0;
    for i:=1 to count-1 do
     if entries[i].lastUse<entries[oldest].lastUse then oldest:=i;
    Evict(oldest);
   end;
  end;

 { Helpers }

 { TTextEffectLayer }

 class function TTextEffectLayer.Glow(color:cardinal;blur:single;spread:single=0):TTextEffectLayer;
  begin
   result:=Default(TTextEffectLayer);
   result.color:=color;
   result.blur:=blur;
   result.spread:=spread;
  end;

 class function TTextEffectLayer.Outline(color:cardinal;width:single;softness:single=1):TTextEffectLayer;
  begin
   result:=Default(TTextEffectLayer);
   result.color:=color;
   result.spread:=width;
   result.blur:=softness;
  end;

 class function TTextEffectLayer.Shadow(color:cardinal;dx,dy:single;blur:single=0):TTextEffectLayer;
  begin
   result:=Default(TTextEffectLayer);
   result.color:=color;
   result.dx:=dx;
   result.dy:=dy;
   result.blur:=blur;
  end;

 { Helpers }

 procedure AddBytes(var key:String8;const data;size:integer);
  var
   l:integer;
  begin
   l:=length(key);
   SetLength(key,l+size);
   move(data,key[l+1],size);
  end;

 // Everything that affects the baked pixels; the alpha of the text color does not
 function BuildKey(font:TFontHandle;rgb:cardinal;const st:String8;align:TTextAlignment;
   const layers:array of TTextEffectLayer;options:cardinal;layersOnly:boolean):String8;
  var
   i,layerCount:integer;
   b:byte;
   scale:single;
  begin
   result:='';
   AddBytes(result,font,sizeof(font));
   AddBytes(result,rgb,sizeof(rgb));
   AddBytes(result,layersOnly,sizeof(layersOnly));
   AddBytes(result,options,sizeof(options));
   b:=ord(align);
   AddBytes(result,b,1);
   scale:=TTextDrawer.globalScale;
   AddBytes(result,scale,sizeof(scale));
   layerCount:=length(layers);
   AddBytes(result,layerCount,sizeof(layerCount));
   // field by field: record padding may hold garbage
   for i:=0 to high(layers) do
    with layers[i] do begin
     AddBytes(result,color,sizeof(color));
     AddBytes(result,dx,sizeof(dx));
     AddBytes(result,dy,sizeof(dy));
     AddBytes(result,spread,sizeof(spread));
     AddBytes(result,blur,sizeof(blur));
    end;
   result:=result+st;
  end;

 function HashKey(const key:String8):cardinal;
  var
   i:integer;
  begin
   result:=2166136261; // FNV-1a
   for i:=1 to length(key) do
    result:=cardinal((UInt64(result xor byte(key[i]))*16777619) and $FFFFFFFF);
  end;

 // Smallest integer >= v for v>=0
 function CeilPos(v:single):integer;
  begin
   if v<=0 then exit(0);
   result:=trunc(v);
   if result<v then inc(result);
  end;

 // Extent of a layer outside the text mask on each side
 procedure LayerSpread(const l:TTextEffectLayer;out left,top,right,bottom:integer);
  var
   grow:single;
  begin
   grow:=l.spread+l.blur;
   left:=CeilPos(grow-l.dx);
   right:=CeilPos(grow+l.dx);
   top:=CeilPos(grow-l.dy);
   bottom:=CeilPos(grow+l.dy);
  end;

 // Bind a work target: BeginPaint + optional clear + blending
 procedure BeginPass(target:TTexture;clear:boolean;blend:TBlendingMode);
  begin
   gfx.BeginPaint(target);
   if clear then gfx.target.Clear(0,-1,-1);
   gfx.target.BlendMode(blend);
  end;

 // Draw the w x h part of src 1:1 with the current (customized) shader and close the pass
 procedure DrawPass(src:TTexture;w,h:integer);
  begin
   try
    draw.ImagePart(0,0,src,$FF808080,Rect(0,0,w,h));
    shader.Reset;
   finally
    gfx.EndPaint;
   end;
  end;

 procedure BakeLayer(const l:TTextEffectLayer;state:TFXState;w,h:integer;first:boolean);
  var
   mask:TTexture;
   tu,tv,sigma,spread:single;
  begin
   ASSERT((l.spread>=0) and (l.spread<=MAX_SPREAD),'TextFX: spread out of range');
   ASSERT((l.blur>=0) and (l.blur<=MAX_BLUR),'TextFX: blur out of range');
   mask:=state.pool[0];
   tu:=mask.stepU*2; tv:=mask.stepV*2; // texel size in UV
   spread:=Clamp(l.spread,0,MAX_SPREAD);
   sigma:=Clamp(l.blur,0,MAX_BLUR)/3;
   // shift + dilation: mask -> pool[1]
   BeginPass(state.pool[1],true,blMove);
   shader.UseCustomized(SPREAD_SHADER);
   shader.SetUniform('texel',TVec2.Init(tu,tv));
   shader.SetUniform('shift',TVec2.Init(l.dx*tu,l.dy*tv));
   shader.SetUniform('spread',spread);
   DrawPass(mask,w,h);
   // gaussian X: pool[1] -> pool[2]
   BeginPass(state.pool[2],true,blMove);
   shader.UseCustomized(GAUSS_SHADER);
   shader.SetUniform('dir',TVec2.Init(tu,0));
   shader.SetUniform('sigma',sigma);
   shader.SetUniform('layerColor',TQuat.Init(1,1,1,1));
   DrawPass(state.pool[1],w,h);
   // gaussian Y + layer color, blended over the accumulator
   BeginPass(state.pool[3],first,blAlpha);
   shader.UseCustomized(GAUSS_SHADER);
   shader.SetUniform('dir',TVec2.Init(0,tv));
   shader.SetUniform('sigma',sigma);
   shader.SetUniform('layerColor',TShader.VectorFromColor(l.color));
   DrawPass(state.pool[2],w,h);
  end;

 // Bake text with layers into a new texture; false if it can't be done
 function Bake(font:TFontHandle;rgb:cardinal;const st:String8;align:TTextAlignment;
   const layers:array of TTextEffectLayer;options:cardinal;layersOnly:boolean;out entry:TFXEntry):boolean;
  var
   state:TFXState;
   r:TRect;
   i,fh,shift,margin,pl,pt,pr,pb,sl,sTop,sr,sb,w,h:integer;
   first,wasBlock:boolean;
   blockOptions:cardinal;
   savedTransform:TTransformState;
   savedBlend:TBlendingMode;
  begin
   result:=false;
   entry:=Default(TFXEntry);
   if pfRenderTargetAlpha=ipfNone then exit;
   state:=GetState;
   // text extent relative to the anchor (Measure works as taLeft)
   r:=txt.Measure(font,st,options);
   case align of
    TTextAlignment.taRight:shift:=-r.Width;
    TTextAlignment.taCenter:shift:=-(r.Width div 2);
    else shift:=0;
   end;
   OffsetRect(r,shift,0);
   // measured box is ascent..baseline: leave room for descenders, accents and overhangs
   fh:=Max(txt.Height(font),1);
   margin:=fh div 4+2;
   pl:=0; pt:=0; pr:=0; pb:=0;
   for i:=0 to high(layers) do begin
    LayerSpread(layers[i],sl,sTop,sr,sb);
    pl:=Max(pl,sl); pt:=Max(pt,sTop); pr:=Max(pr,sr); pb:=Max(pb,sb);
   end;
   r.Left:=r.Left-margin-pl;
   r.Right:=r.Right+margin+pr;
   r.Top:=r.Top-fh div 2-pt-1;
   r.Bottom:=r.Bottom+fh div 2+2+pb;
   w:=r.Width; h:=r.Height;
   if (w<=0) or (h<=0) or (w>MAX_SIDE) or (h>MAX_SIDE) then exit;
   if not state.EnsurePool(w,h) then exit;

   entry.width:=w; entry.height:=h;
   entry.ox:=-r.Left; entry.oy:=-r.Top;
   entry.tex:=AllocImage(w,h,pfRenderTargetAlpha,RT_FLAGS,'TextFX');
   if entry.tex=nil then exit;

   // Nested render passes: EndPaint resets the caller's transform and blending, and
   // an open text block would swallow our text into the caller's batch
   savedTransform:=transformationAPI.SaveState;
   savedBlend:=renderTargetAPI.CurrentBlendMode;
   wasBlock:=TTextDrawer.textCaching;
   blockOptions:=TTextDrawer.textBlockOptions;
   if wasBlock then txt.EndBlock;
   try
    // text mask
    BeginPass(state.pool[0],true,blAlpha);
    try
     txt.Write(font,entry.ox,entry.oy,$FFFFFFFF,st,align,options);
    finally
     gfx.EndPaint;
    end;
    // layers, in order, into the accumulator
    first:=true;
    for i:=0 to high(layers) do begin
     BakeLayer(layers[i],state,w,h,first);
     first:=false;
    end;
    // Keep glyphs out of a layers-only sprite.
    if not layersOnly then begin
     BeginPass(state.pool[3],false,blAlpha);
     try
      txt.Write(font,entry.ox,entry.oy,rgb or $FF000000,st,align,options);
     finally
      gfx.EndPaint;
     end;
    end;
    // resolve into the entry texture
    BeginPass(entry.tex,true,blMove);
    shader.UseCustomized(RESOLVE_SHADER);
    DrawPass(state.pool[3],w,h);
    result:=true;
   finally
    transformationAPI.RestoreState(savedTransform);
    gfx.target.BlendMode(savedBlend);
    if wasBlock then txt.BeginBlock(blockOptions);
    if not result then FreeImage(entry.tex);
   end;
  end;

 procedure DrawCachedTextFX(font:TFontHandle;x,y:single;color:cardinal;const st:String8;
   align:TTextAlignment;const layers:array of TTextEffectLayer;options:cardinal;layersOnly:boolean);
  var
   key:String8;
   hash,rgb:cardinal;
   i,idx,px,py:integer;
   state:TFXState;
   entry:TFXEntry;
   k:single;
   textFont:TFontHandle; // the font as given (fx font is in real pixels when k<>1)
   lay:array of TTextEffectLayer;
   baked:boolean;
  begin
   ASSERT(options and (toDrawToBitmap or toMeasure)=0,'TextFX: bitmap/measure options are not allowed');
   if st='' then exit;
   if length(layers)=0 then begin
    if not layersOnly then txt.Write(font,x,y,color,st,align,options);
    exit;
   end;
   if font=0 then font:=game.defaultFont;
   if layersOnly then rgb:=0 else rgb:=color and $FFFFFF;
   // The projection scales the virtual area up: bake in real pixels, draw scaled down
   k:=TTextDrawer.PixelRatio;
   SetLength(lay,length(layers));
   for i:=0 to high(layers) do begin
    lay[i]:=layers[i];
    if k=1 then continue;
    lay[i].dx:=layers[i].dx*k;
    lay[i].dy:=layers[i].dy*k;
    lay[i].spread:=Clamp(layers[i].spread*k,0,MAX_SPREAD);
    lay[i].blur:=Clamp(layers[i].blur*k,0,MAX_BLUR);
   end;
   textFont:=font;
   if k<>1 then font:=textDrawer.PixelFont(font,k);
   key:=BuildKey(font,rgb,st,align,lay,options,layersOnly);
   hash:=HashKey(key);
   state:=GetState;
   idx:=state.Find(key,hash);
   if idx<0 then begin
    // the font is already in real pixels: measure it without the ratio
    TTextDrawer.pixelRatioOverride:=1;
    try
     baked:=Bake(font,rgb,st,align,lay,options,layersOnly,entry);
    finally
     TTextDrawer.pixelRatioOverride:=0;
    end;
    if not baked then begin
     if not layersOnly then txt.Write(textFont,x,y,color,st,align,options);
     exit;
    end;
    entry.key:=key;
    entry.hash:=hash;
    state.Add(entry);
    idx:=state.count-1;
   end;
   inc(state.useCounter);
   with state.entries[idx] do begin
    lastUse:=state.useCounter;
    if k=1 then
     // same rounding as txt.Write, so the glyphs land on the same pixels
     draw.ImagePart(SRound(x)-ox,SRound(y)-oy,tex,$808080+color and $FF000000,Rect(0,0,width,height))
    else begin
     // the sprite is in real pixels: its texel centers go back to virtual units
     // (a virtual pixel v is centered at the real pixel (v+0.5)*k-0.5)
     px:=SRound((x+0.5)*k-0.5)-ox; py:=SRound((y+0.5)*k-0.5)-oy;
     draw.Scaled((px+0.5)/k-0.5,(py+0.5)/k-0.5,(px+width-0.5)/k-0.5,(py+height-0.5)/k-0.5,
       tex,$808080+color and $FF000000);
    end;
   end;
  end;

 procedure DrawTextFX(font:TFontHandle;x,y:single;color:cardinal;const st:String8;
   align:TTextAlignment;const layers:array of TTextEffectLayer;options:cardinal);
  begin
   DrawCachedTextFX(font,x,y,color,st,align,layers,options,false);
  end;

 procedure DrawTextFXLayers(font:TFontHandle;x,y:single;opacity:byte;const st:String8;
   align:TTextAlignment;const layers:array of TTextEffectLayer;options:cardinal);
  begin
   DrawCachedTextFX(font,x,y,cardinal(opacity) shl 24,st,align,layers,options,true);
  end;

 procedure FlushTextFXCache;
  begin
   if fxState<>nil then fxState.Clear;
  end;

end.