// TODO conditinal version for other rendering backends
unit DDrawFont2;

{$MODE FPC}
{$MODESWITCH DEFAULTPARAMETERS}
{$MODESWITCH OUT}
{$MODESWITCH RESULT}

interface

uses
  stb_rect_pack,
  derror,
  dstrnum,
  dutf8,
  dvector2f,
  dvector2i,
  drect2i,
  dresourcemanager,
  dstream,
  DEng,
  DDrawFont2Holder,
  DDrawVertexBuffer,
  DEngStreamAssets,
  DTextureHandle,
  dfont_plugin;

type
PFontParameters = ^TFontParameters;
TFontParameters = object
end;

PFontLoader = ^TFontLoader;
TFontLoader = object(TResourceType)
  function GetSingleton: PFontLoader; static; inline;
  function OnAllocHolder(ResourceRecord: PResourceRecord;
                         Parameters: Pointer;
                         out Holder: Pointer): Boolean; virtual;
  function OnAllocDefaultHolder(ResourceRecord: PResourceRecord;
                         out Holder: Pointer): Boolean; virtual;
  function OnAllocHotSwapingHolder(ResourceRecord: PResourceRecord;
                                   Original: Pointer;
                                   out Holder: Pointer): Boolean; virtual;
  function OnThreadedLoad(Holder: Pointer): Boolean; virtual;
  function OnLoad(Holder: Pointer): Boolean; virtual;
  function OnUnload(Holder: Pointer): Boolean; virtual;
  function OnThreadedUnload(Holder: Pointer): Boolean; virtual;
  function OnDeallocHolder(Holder: Pointer): Boolean; virtual;
  function OnHotSwap(Old, New: PResourceRecord): Boolean; virtual;
end;

PGlyph = ^TGlyph;
TGlyph = object
public // input parameters
  U: PtrUInt; // Unicode character
public // glyph's data
  Index, Count: PtrUInt; // indices in vertex buffer
  X, Y, W, H, AdvanceX, AdvanceY: Int32;
private // for internal usage only
  // BackendGlyph: PFontBackendGlyph;
  Refs, LastTime: PtrInt;
end;

TFontArgs = object
  Flags: UInt32;
  ResourceManager: PResourceManager; // nil means default
  AssetName: AnsiString;
  procedure Init;
  procedure Done;
end;

PFontHolder = ^TFontHolder;
TFontHolder = object
  FRecord: PResourceRecord;
  FBackend: PFontBackend;
  FArgs: TFontArgs;
// Cached data
  FGlyphs: array of TGlyph;
  FAtlas: TTexture2DHandle;
  FAtlasWidth, FAtlasHeight: UInt32;
  FAtlasData: array of UInt32;
// Use stb_rect_pack for packing glyphs to atlas
  FStb: record
    context: stbrp_context;
    nodes: Pstbrp_node;
    num_nodes: SizeUInt;
  end;
  procedure Init;
  procedure Done;
  function Ready: Boolean;
  function FindCachedGlyph(U: UInt32): PGlyph;
  procedure CacheCharacters(S, SEnd: PAnsiChar);
  procedure DrawGlyph(G: PGlyph; const P: TVec2f);
  property GetRecord: PResourceRecord read FRecord;
end;

PFont = ^TFont;
TFont = object
      //  Font object for using in client code.
public
  procedure Init; overload;
  procedure Done;
  procedure CopyFrom(const Font: TFont);
  procedure Load(const FontArgs: TFontArgs);
  function  Ready: Boolean;
public //private // TODO private
  FHolder: PFontHolder;
  FPriority: TResourcePriority;
end;

PTextLine = ^TTextLine;
TTextLine = object
private
  FDirty: Boolean;
  FFont: TFont;
  FBuffer: AnsiString; // TODO TAnsiBuffer
  function Cache: Boolean;
public
  procedure Init;
  procedure Done;
  procedure SetFont(const Font: TFont);
  procedure SetText(S: PAnsiChar);
  procedure Draw(X, Y: Single);
end;

implementation

var
  FontLoader: TFontLoader;

function TFontLoader.GetSingleton: PFontLoader; static; inline;
begin
  Exit(@FontLoader);
end;

function TFontLoader.OnAllocHolder(ResourceRecord: PResourceRecord;
                       Parameters: Pointer;
                       out Holder: Pointer): Boolean;
begin
  New(PFontHolder(Holder));
  PFontHolder(Holder)^.Init;
  PFontHolder(Holder)^.FRecord := ResourceRecord;
  PFontHolder(Holder)^.FBackend := nil;
  PFontHolder(Holder)^.FArgs := TFontArgs(Parameters^);
  Exit(True);
end;

function TFontLoader.OnAllocDefaultHolder(ResourceRecord: PResourceRecord;
                       out Holder: Pointer): Boolean;
begin
  New(PFontHolder(Holder));
  PFontHolder(Holder)^.Init;
  PFontHolder(Holder)^.FRecord := ResourceRecord;
  PFontHolder(Holder)^.FBackend := nil; // TODO get link to default font
  PFontHolder(Holder)^.FArgs.Init; //  TODO init default
  Exit(True);
end;

function TFontLoader.OnAllocHotSwapingHolder(ResourceRecord: PResourceRecord;
                                 Original: Pointer;
                                 out Holder: Pointer): Boolean;
begin
  Exit(False); // hot swaping is not supported for now
end;

function TFontLoader.OnThreadedLoad(Holder: Pointer): Boolean;
begin
  Exit(True);
end;

function TFontLoader.OnLoad(Holder: Pointer): Boolean;
var
  Stream: PStream;
  Error: TError;
begin
  Stream := Asset(PFontHolder(Holder)^.FArgs.AssetName);
  if not TryLoadFont(Stream, PFontHolder(Holder)^.FBackend, Error) then begin
    Log('FAILED LOADING ' + PFontHolder(Holder)^.FArgs.AssetName + ': '  + Error.Msg + ' (error: ' + HexStr(Error.Id, 4) + ')');
    Exit(False);
  end else
    Log('LOADED ' + PFontHolder(Holder)^.FArgs.AssetName);
  Dispose(Stream, Done);
  Exit(True);
end;

function TFontLoader.OnUnload(Holder: Pointer): Boolean;
begin
  Exit(True);
end;

function TFontLoader.OnThreadedUnload(Holder: Pointer): Boolean;
begin
  Exit(True);
end;

function TFontLoader.OnDeallocHolder(Holder: Pointer): Boolean;
begin
  Exit(True);
end;

function TFontLoader.OnHotSwap(Old, New: PResourceRecord): Boolean;
begin
  Exit(True); // not implemented
end;

procedure TFontArgs.Init;
begin
  Flags := 0;
  ResourceManager := nil;
  AssetName := '';
end;

procedure TFontArgs.Done;
begin
end;

procedure TFontHolder.Init;
begin
  FAtlas.Init;
  FAtlasWidth := 0;
  FAtlasHeight := 0;
end;

procedure TFontHolder.Done;
begin
  FAtlas.Done;
end;

function TFontHolder.Ready: Boolean;
begin
  Exit(FRecord^.State = TResourceRecord.STATE_LOADED);
end;

function TFontHolder.FindCachedGlyph(U: UInt32): PGlyph;
var
  I: LongInt;
begin
  for I := 0 to High(FGlyphs) do begin
    if FGlyphs[I].U = U then
      Exit(@FGlyphs[I]);
  end;
  Exit(nil);
end;

procedure TFontHolder.CacheCharacters(S, SEnd: PAnsiChar);
var
  U: UInt32;
  Count: SizeUInt;
  I: Int32;
  rects: array of stbrp_rect;
  W, H: SizeInt;
begin
  if FRecord^.State <> TResourceRecord.STATE_LOADED then
    Exit;
  rects := nil;

  // Add new characters to the glyphs list
  Count := Length(FGlyphs);
  while DecodeUTF8CharIgnore(S, SEnd, U) do begin
    if FindCachedGlyph(U) = nil then begin
      SetLength(FGlyphs, Length(FGlyphs) + 1);
      FGlyphs[High(FGlyphs)].U := U;

      SetLength(rects, Length(rects) + 1);
      rects[High(rects)].id := High(FGlyphs);
      FBackend^.SetSize(32); // TODO
      FBackend^.SetGlyph(U);

      FBackend^.GetGlyphSizes(W, H);
      FGlyphs[High(FGlyphs)].W := W;
      FGlyphs[High(FGlyphs)].H := H;
      rects[High(rects)].w := W;
      rects[High(rects)].h := H;

      FBackend^.GetGlyphAdvance(W, H);
      FGlyphs[High(FGlyphs)].AdvanceX := W;
      FGlyphs[High(FGlyphs)].AdvanceY := H;
    end;
  end;

  // Create atlas
  if (FAtlasWidth = 0) or (FAtlasHeight = 0) then begin
    FAtlasWidth := 1024;
    FAtlasHeight := 1024;
    SetLength(FAtlasData, FAtlasWidth * FAtlasHeight);
    FStb.num_nodes := FAtlasWidth;
    FStb.nodes := GetMem(FStb.num_nodes * SizeOf(stbrp_node));
    stbrp_init_target(@FStb.context, FAtlasWidth, FAtlasHeight, FStb.nodes, FStb.num_nodes);
  end;

  // Place glyphs to the atlas
  if not stbrp_pack_rects(@FStb.context, @rects[0], Length(rects)) then begin
    Log('ERROR not all glyphs placed on atlas:');
  end;
  for I := 0 to High(rects) do begin
    FGlyphs[rects[I].id].X := 0;
    FGlyphs[rects[I].id].Y := 0;
    if rects[I].was_packed then begin
      FGlyphs[rects[I].id].X := rects[I].x;
      FGlyphs[rects[I].id].Y := rects[I].y;
      Log('  ' + IntToStr(FGlyphs[rects[I].id].W) + 'x' + IntToStr(FGlyphs[rects[I].id].H) + ' -> ' + IntToStr(FGlyphs[rects[I].id].X) + ',' + IntToStr(FGlyphs[rects[I].id].Y));
    end else begin
      Log('  glyph ' + IntToStr(FGlyphs[rects[I].id].W) + 'x' + IntToStr(FGlyphs[rects[I].id].H) + ' for U=' + IntToStr(FGlyphs[rects[I].id].U) + ' was not packed');
    end;
  end;

  // Rasterize the glyphs
  for I := Count to High(FGlyphs) do begin
    FBackend^.SetSize(32); // TODO
    FBackend^.SetGlyph(FGlyphs[I].U);
    FBackend^.RasterizeRGBA(FGlyphs[I].U,
                            FGlyphs[I].X, FGlyphs[I].Y,
                            FAtlasWidth, FAtlasHeight,
                            @FAtlasData[0]);
  end;

  // Load atlas to GPU
  FAtlas.UploadRGBATexture(FAtlasWidth, FAtlasHeight, @FAtlasData[0]);
end;

procedure TFontHolder.DrawGlyph(G: PGlyph; const P: TVec2f);
var
  VertexBuffer: TVertexBuffer;
  V, T: array[0 .. 6 - 1] of TVec2f;
begin
  V[0] := P;
  V[1] := Add2f(P, Vec2f(G^.W, 0));
  V[2] := Add2f(P, Vec2f(G^.W, G^.H));
  V[3] := P;
  V[4] := Add2f(P, Vec2f(G^.W, G^.H));
  V[5] := Add2f(P, Vec2f(0, G^.H));
  T[0] := Vec2f(G^.X / FAtlasWidth, G^.Y / FAtlasHeight);
  T[1] := Add2f(T[0], Vec2f(G^.W / FAtlasWidth, 0));
  T[2] := Add2f(T[0], Vec2f(G^.W / FAtlasWidth, G^.H / FAtlasWidth));
  T[3] := T[0];
  T[4] := Add2f(T[0], Vec2f(G^.W / FAtlasWidth, G^.H / FAtlasWidth));
  T[5] := Add2f(T[0], Vec2f(0, G^.H / FAtlasWidth));
  FAtlas.Bind;
  VertexBuffer.Init(V);
  VertexBuffer.SetTexCoords(T);
  VertexBuffer.DrawTriangles;
  VertexBuffer.Done;
  FAtlas.Unbind;
end;

procedure TFont.Init;
var
  R: PResourceRecord;
begin
  if ResourceManager.GetDefaultResource(TFontLoader.GetSingleton, R) then begin
    FHolder := R^.Holder;
  end else
    FHolder := nil;
  FPriority := PRIORITY_NORMAL;
end;

procedure TFont.Done;
begin
  FHolder^.GetRecord^.Unref(FPriority);
end;

procedure TFont.CopyFrom(const Font: TFont);
begin
  Done;
  FHolder := Font.FHolder;
  FPriority := Font.FPriority;
  FHolder^.GetRecord^.IncRef(FPriority);
end;

procedure TFont.Load(const FontArgs: TFontArgs);
var
  ResourceId: TResourceId;
  R: PResourceRecord;
begin
  FHolder^.GetRecord^.Unref(FPriority);
  ResourceId.Init(@FontLoader, FontArgs.AssetName);
  if ActualResourceManager(FontArgs.ResourceManager)^.GetResource(@ResourceId, @FontArgs, R) then begin
    FHolder := R^.Holder;
    FPriority := PRIORITY_NORMAL;
    R^.IncRef(FPriority);
  end else begin
    // TODO Switch to default
  end;
end;

function  TFont.Ready: Boolean;
begin
  Exit(FHolder^.FRecord^.State = TResourceRecord.STATE_LOADED);
end;

function TTextLine.Cache: Boolean;
begin
  FDirty := True;
  if FFont.Ready then begin
    FFont.FHolder^.CacheCharacters(@FBuffer[1], @FBuffer[1] + Length(FBuffer)); // TODO do not access the holder
    FDirty := False;
  end;
  Exit(True);
end;

procedure TTextLine.Init;
begin
  FDirty := True;
  FFont.Init;
end;

procedure TTextLine.Done;
begin
  FFont.Done;
end;

procedure TTextLine.SetFont(const Font: TFont);
begin
  FFont.CopyFrom(Font);
end;

procedure TTextLine.SetText(S: PAnsiChar);
begin
  FBuffer := S;
  // TODO AnsiBuffer or glyphs array
end;

procedure TTextLine.Draw(X, Y: Single);
var
  S, SEnd: PAnsiChar;
  U: UInt32;
  G: PGlyph;
begin
  if FDirty then begin
    if not Cache then begin
      // may be font is invalid or not loaded yet, do some default action
      Eng.Draw^.RectFilled(Rect2i(Vec2i(Round(X), Round(Y)),
                                  Vec2i(Round(X + Length(FBuffer) * 16), Round(Y + 16))));
      Exit;
    end;
  end;
  S := @FBuffer[1];
  SEnd := S + Length(FBuffer);
  while DecodeUTF8CharIgnore(S, SEnd, U) do begin
    G := FFont.FHolder^.FindCachedGlyph(U);
    if G <> nil then begin
      FFont.FHolder^.DrawGlyph(G, Vec2f(X, Y));
      X := X + G^.AdvanceX;
      Y := Y + G^.AdvanceY;
    end;
  end;
end;

initialization
  FontLoader.Init;
finalization
  FontLoader.Done;
end.
