unit KM_ResFonts;
{$I KaM_Remake.inc}
interface
uses
  SysUtils,
  KM_CommonTypes, KM_RenderTypes,
  KM_Points;


const
  FONT_TAB_WIDTH = 30;

type
  //* Font type
  TKMFont = (
    fntAntiqua,
    fntGame,
    fntGrey,
    fntMetal,
    fntMini,
    fntOutline,
    fntArial, // Arial for MP chat
    fntMonospaced // Debug overlay font (Consolas 8. Set WordSpacing to any Char.Width)
  );

const
  FontTypeName: array [TKMFont] of string = (
    // Used in:
    //  - data\gfx\fonts\filenames
    //  - utils\FontX Generator\fonts.xml

    'antiqua',
    'game',
    'grey',
    'metal',
    'mini',
    'outline',
    'arial',
    'consolas8'
  );

type
  TKMFontLoadLevel = (fllFull, fllMinimal);
  {
  Removed fonts that were in KaM:
  Adam (unused)
  Briefing (same typeface as Antiqua, just darker)
  Font01 (damaged)
  KMLobby (used for internet lobby in TPR)
  MainA (identical to MainMapGold in all game versions)
  MainA.old (probably never meant to be included in the release anyway)
  MainB (identical to Game)
  MainMapGold (same typeface as Metal, just with a goldish tint)
  Minimum (same as mini but with less characters)
  System (unused)
  Won (same typeface as Metal, just with a blueish tint)
  }

  TKMFontInfo = record
  public
    TexMode: TKMTexFormat; //Format font texture needs to be in
  end;

  TKMLetter = packed record
  public
    Width, Height: Word;
    YOffset: SmallInt;
    AtlasId: Word; //Was Unknown field, we use it for multi-atlas fonts to mark the letters location
    u1, v1, u2, v2: Single; //Location within texture atlas
  end;

  TKMFontAtlas = record
    TexID: Cardinal;
    GpuCurrent: Boolean;
    TexData: TKMCardinalArray;
  end;
  TKMFontAtlasArray = array of TKMFontAtlas;

  TKMFontSpec = class
  const
    DEFAULT_EXT = 'fntx';
    FNTX_HEAD: AnsiString = 'FNTX';
    FONTS_FOLDER = 'data' + PathDelim + 'gfx' + PathDelim + 'fonts' + PathDelim;
  private
    fFont: TKMFont;
    procedure LoadFontX(const aFileName: string; aLoadLevel: TKMFontLoadLevel;
      aAllowReuseAtlas0: Boolean; aPriorAtlas0ID: Cardinal); overload;
    function GetTexID(aIndex: Integer): Cardinal;
    function GetLineHeight: SmallInt;
  protected
    fTexSizeX, fTexSizeY: Word; //All atlases have same dimensions
    //Character atlases
    fAtlasCount: Byte;
    fAtlases: TKMFontAtlasArray;
    fCharCount: Word;
    fBaseHeight, fWordSpacing, fCharSpacing: SmallInt;
    fLineSpacing: Byte; //Not in KaM files, we use custom value that fits well
    fCodepage: Word;
    fIsUnicode: Boolean;

    fMaxWidth: Integer;
  public
    Used: array [0..High(Word)] of Byte;
    Letters: array [0..High(Word)] of TKMLetter;

    constructor Create(aFont: TKMFont);

    procedure LoadFontX(const aFileName: string; aLoadLevel: TKMFontLoadLevel = fllFull); overload;
    procedure GenerateTextures(aTexMode: TKMTexFormat);
    procedure Compact;

    function GetLetter(aChar: WideChar): TKMLetter;
    property AtlasCount: Byte read fAtlasCount;
    property TexID[aIndex: Integer]: Cardinal read GetTexID;

    property CharCount: Word read fCharCount;
    property CharSpacing: SmallInt read fCharSpacing;
    property LineSpacing: Byte read fLineSpacing;
    property LineHeight: SmallInt read GetLineHeight;
    property BaseHeight: SmallInt read fBaseHeight;
    property WordSpacing: SmallInt read fWordSpacing;

    function GetCharWidth(aChar: WideChar; aConsiderEolSymbol: Boolean = False): Integer;
    function WordWrap(aText: UnicodeString; aMaxPxWidth: Integer; aForced: Boolean; aIndentAfterNL: Boolean;
      aTabWidth: Integer = FONT_TAB_WIDTH): UnicodeString;
    function CharsThatFit(const aText: UnicodeString; aMaxPxWidth: Integer; aRound: Boolean = False;
      aConsiderEolSymbol: Boolean = False; aTabWidth: Integer = FONT_TAB_WIDTH): Integer;
    function GetTextSize(const aText: UnicodeString; var aLineCount: Integer; aCountMarkup: Boolean = False;
      aConsiderEolSymbol: Boolean = False; aTabWidth: Integer = FONT_TAB_WIDTH): TKMPoint; overload;
    function GetTextSize(const aText: UnicodeString; aCountMarkup: Boolean = False; aConsiderEolSymbol: Boolean = False;
      aTabWidth: Integer = FONT_TAB_WIDTH): TKMPoint; overload;
    function GetMaxPrintWidthOfStrings(aStrings: array of string): Integer;
  end;


  //Collection of fonts
  TKMResFonts = class
  private
    fContentSetValid: Boolean;
    fLoadLevel: TKMFontLoadLevel;
    fFontData: array [TKMFont] of TKMFontSpec;
    function GetFontData(aIndex: TKMFont): TKMFontSpec;
  public
    constructor Create;
    destructor Destroy; override;

    property FontData[aIndex: TKMFont]: TKMFontSpec read GetFontData; default;
    property LoadLevel: TKMFontLoadLevel read fLoadLevel;
    function HasContentLevel(aRequiredLevel: TKMFontLoadLevel): Boolean;
    function HasGPUAtlasLevel(aRequiredLevel: TKMFontLoadLevel): Boolean;
    procedure InvalidateGPUAtlasContext;
    procedure LoadFonts(aLoadLevel: TKMFontLoadLevel = fllFull);
    function EnsureGPUAtlasLevel(aRequiredLevel: TKMFontLoadLevel): Boolean;
  end;


const
  PLACEHOLDER_CHAR = 0; // Box, used for characters missing from font

  FONT_INFO: array [TKMFont] of TKMFontInfo = (
    (TexMode: tfRGB5A1),
    (TexMode: tfAlpha8),
    (TexMode: tfRGB5A1),
    (TexMode: tfRGB5A1),
    (TexMode: tfAlpha8),
    (TexMode: tfRGB5A1),
    (TexMode: tfRGBA8),
    (TexMode: tfRGBA8)
  );


implementation
uses
  Classes, Math,
  {$IFDEF FPC} zstream, {$ENDIF}
  {$IFDEF WDC} ZLib, {$ENDIF}
  KM_Render, KaMResourceInput;


{ TKMFontSpec }
constructor TKMFontSpec.Create(aFont: TKMFont);
begin
  inherited Create;

  fFont := aFont;
end;


procedure TKMFontSpec.LoadFontX(const aFileName: string; aLoadLevel: TKMFontLoadLevel = fllFull);
begin
  LoadFontX(aFileName, aLoadLevel, False, 0);
end;


procedure TKMFontSpec.LoadFontX(const aFileName: string; aLoadLevel: TKMFontLoadLevel;
  aAllowReuseAtlas0: Boolean; aPriorAtlas0ID: Cardinal);
var
  inputStream: TStream;
  decompressionStream: TDecompressionStream;
  head: AnsiString;
  sourceUsed, resultUsed: array of Byte;
  sourceLetters: array of TKMLetter;
  stagedAtlases: TKMFontAtlasArray;
  sourceAtlasCount, loadCount: Byte;
  texWidth, texHeight: Word;
  stagedBaseHeight, stagedWordSpacing, stagedCharSpacing: SmallInt;
  stagedLineSpacing: Byte;
  pixelCount, byteCount, remaining: UInt64;
  readCount, I: Integer;
  extraByte: Byte;
  discardBuffer: array[0..65535] of Byte;
  u1, v1, u2, v2: Single;
  oldIndex: Integer;
  reuseAtlas0: Boolean;
begin
  inputStream := KaMOpenResourceStream(aFileName);
  if inputStream = nil then
    raise Exception.Create('Font resource returned no stream');
  try
    decompressionStream := TDecompressionStream.Create(inputStream);
    try
      SetLength(sourceUsed, 65536);
      SetLength(resultUsed, 65536);
      SetLength(sourceLetters, 65536);
      SetLength(head, 4);
      decompressionStream.ReadBuffer(head[1], 4);
      if head <> FNTX_HEAD then
        raise Exception.Create('Invalid FNTX header');

      decompressionStream.ReadBuffer(stagedBaseHeight, SizeOf(stagedBaseHeight));
      decompressionStream.ReadBuffer(stagedWordSpacing, SizeOf(stagedWordSpacing));
      decompressionStream.ReadBuffer(stagedCharSpacing, SizeOf(stagedCharSpacing));
      decompressionStream.ReadBuffer(stagedLineSpacing, SizeOf(stagedLineSpacing));
      decompressionStream.ReadBuffer(sourceUsed[0], Length(sourceUsed));
      for I := 0 to High(Word) do
        if sourceUsed[I] <> 0 then
          decompressionStream.ReadBuffer(sourceLetters[I], SizeOf(TKMLetter));

      decompressionStream.ReadBuffer(sourceAtlasCount, SizeOf(sourceAtlasCount));
      decompressionStream.ReadBuffer(texWidth, SizeOf(texWidth));
      decompressionStream.ReadBuffer(texHeight, SizeOf(texHeight));
      if sourceAtlasCount = 0 then
        raise Exception.Create('FNTX contains no atlases');
      if (texWidth = 0) or (texHeight = 0) then
        raise Exception.Create('FNTX has invalid atlas dimensions');
      pixelCount := UInt64(texWidth) * UInt64(texHeight);
      byteCount := pixelCount * SizeOf(Cardinal);
      if (pixelCount > UInt64(High(SizeInt))) or (byteCount > UInt64(High(LongInt))) then
        raise Exception.Create('FNTX atlas dimensions exceed supported size');

      for I := 0 to High(Word) do
        if sourceUsed[I] <> 0 then
        begin
          if sourceLetters[I].AtlasId >= sourceAtlasCount then
            raise Exception.Create('FNTX glyph references an invalid atlas');
          u1 := sourceLetters[I].u1;
          v1 := sourceLetters[I].v1;
          u2 := sourceLetters[I].u2;
          v2 := sourceLetters[I].v2;
          if IsNan(u1) or IsInfinite(u1) or IsNan(v1) or IsInfinite(v1)
            or IsNan(u2) or IsInfinite(u2) or IsNan(v2) or IsInfinite(v2)
            or (u1 < 0) or (u1 > 1) or (v1 < 0) or (v1 > 1)
            or (u2 < 0) or (u2 > 1) or (v2 < 0) or (v2 > 1)
            or (u1 > u2) or (v1 > v2) then
            raise Exception.Create('FNTX glyph has invalid atlas coordinates');
        end;

      if aLoadLevel = fllMinimal then
        loadCount := 1
      else
        loadCount := sourceAtlasCount;
      if (sourceUsed[PLACEHOLDER_CHAR] <> 0)
        and (sourceLetters[PLACEHOLDER_CHAR].AtlasId >= loadCount) then
        raise Exception.Create('FNTX fallback glyph is absent from selected atlas level');
      for I := 0 to High(Word) do
        if (sourceUsed[I] <> 0)
          and ((aLoadLevel = fllFull) or (sourceLetters[I].AtlasId = 0)) then
          resultUsed[I] := sourceUsed[I];

      SetLength(stagedAtlases, loadCount);
      for I := 0 to loadCount - 1 do
      begin
        stagedAtlases[I].TexID := 0;
        stagedAtlases[I].GpuCurrent := False;
        SetLength(stagedAtlases[I].TexData, SizeInt(pixelCount));
      end;
      for I := 0 to sourceAtlasCount - 1 do
        if I < loadCount then
          decompressionStream.ReadBuffer(stagedAtlases[I].TexData[0], LongInt(byteCount))
        else
        begin
          remaining := byteCount;
          while remaining > 0 do
          begin
            if remaining > SizeOf(discardBuffer) then
              readCount := SizeOf(discardBuffer)
            else
              readCount := Integer(remaining);
            decompressionStream.ReadBuffer(discardBuffer[0], readCount);
            Dec(remaining, UInt64(readCount));
          end;
        end;

      if decompressionStream.Read(extraByte, 1) <> 0 then
        raise Exception.Create('FNTX contains trailing decoded data');
    finally
      decompressionStream.Free;
    end;
  finally
    inputStream.Free;
  end;

  reuseAtlas0 := aAllowReuseAtlas0 and (aPriorAtlas0ID <> 0)
    and (Length(fAtlases) > 0) and (fAtlases[0].TexID = aPriorAtlas0ID)
    and fAtlases[0].GpuCurrent and TKMRender.TextureBackendReady;
  for oldIndex := 0 to High(fAtlases) do
  begin
    if (oldIndex = 0) and reuseAtlas0 then
      Continue;
    if fAtlases[oldIndex].GpuCurrent and (fAtlases[oldIndex].TexID <> 0)
      and TKMRender.TextureBackendReady then
      TKMRender.DeleteTexture(fAtlases[oldIndex].TexID);
    fAtlases[oldIndex].TexID := 0;
    fAtlases[oldIndex].GpuCurrent := False;
  end;
  if reuseAtlas0 and (Length(stagedAtlases) > 0) then
  begin
    stagedAtlases[0].TexID := aPriorAtlas0ID;
    stagedAtlases[0].GpuCurrent := True;
  end;

  for I := 0 to High(Word) do
  begin
    Used[I] := resultUsed[I];
    Letters[I] := sourceLetters[I];
  end;
  fBaseHeight := stagedBaseHeight;
  fWordSpacing := stagedWordSpacing;
  fCharSpacing := stagedCharSpacing;
  fLineSpacing := stagedLineSpacing;
  fCodepage := 0;
  fIsUnicode := True;
  fCharCount := 65535;
  fAtlasCount := loadCount;
  fTexSizeX := texWidth;
  fTexSizeY := texHeight;
  fAtlases := stagedAtlases;
  stagedAtlases := nil;
end;


// After font has been loaded and texture generated we can flush temp data
procedure TKMFontSpec.Compact;
var
  I: Integer;
begin
  //Discard texture data to save mem
  for I := 0 to fAtlasCount - 1 do
    SetLength(fAtlases[I].TexData, 0);

  fTexSizeX := 0;
  fTexSizeY := 0;
end;


// Generate color texture from prepared data
procedure TKMFontSpec.GenerateTextures(aTexMode: TKMTexFormat);
var
  I: Integer;
  pixelCount: UInt64;
  textureID: Cardinal;
begin
  if not TKMRender.TextureBackendReady then
    raise Exception.Create('Cannot upload font atlases without a ready texture backend');

  for I := 0 to fAtlasCount - 1 do
  begin
    if fAtlases[I].GpuCurrent and (fAtlases[I].TexID <> 0) then
      Continue;

    if not TKMRender.TextureBackendReady then
      raise Exception.Create('Texture backend became unavailable during font atlas upload');
    fAtlases[I].GpuCurrent := False;
    fAtlases[I].TexID := 0;
    pixelCount := UInt64(fTexSizeX) * UInt64(fTexSizeY);
    if (fTexSizeX = 0) or (fTexSizeY = 0)
      or (pixelCount = 0) or (pixelCount > UInt64(High(SizeInt)))
      or (pixelCount * SizeOf(Cardinal) > UInt64(High(LongInt)))
      or (UInt64(Length(fAtlases[I].TexData)) <> pixelCount) then
      raise Exception.Create('Font atlas pixels are unavailable or have invalid dimensions');

    textureID := TKMRender.GenTexture(fTexSizeX, fTexSizeY, @fAtlases[I].TexData[0], aTexMode, ftNearest, ftNearest);
    if textureID = 0 then
      raise Exception.Create('Font atlas texture upload returned no texture ID');
    if not TKMRender.TextureBackendReady then
      raise Exception.Create('Texture backend became unavailable during font atlas upload');

    fAtlases[I].TexID := textureID;
    fAtlases[I].GpuCurrent := True;
  end;
end;


function TKMFontSpec.GetLetter(aChar: WideChar): TKMLetter;
begin
  if Used[Ord(aChar)] <> 0 then
    Result := Letters[Ord(aChar)]
  else
    Result := Letters[PLACEHOLDER_CHAR];
end;


function TKMFontSpec.GetTexID(aIndex: Integer): Cardinal;
begin
  Result := fAtlases[aIndex].TexID;
end;


{ TKMResFonts }
constructor TKMResFonts.Create;
var
  F: TKMFont;
begin
  inherited;

  fContentSetValid := False;
  fLoadLevel := fllMinimal;

  for F := Low(TKMFont) to High(TKMFont) do
    fFontData[F] := TKMFontSpec.Create(F);
end;


destructor TKMResFonts.Destroy;
var
  F: TKMFont;
  I: Integer;
  firstDeleteError: string;
  deleteFailed: Boolean;
begin
  firstDeleteError := '';
  deleteFailed := False;
  try
    for F := Low(TKMFont) to High(TKMFont) do
      if fFontData[F] <> nil then
        for I := 0 to High(fFontData[F].fAtlases) do
          if (fFontData[F].fAtlases[I].TexID <> 0)
            and fFontData[F].fAtlases[I].GpuCurrent then
          begin
            if TKMRender.TextureBackendReady then
              try
                TKMRender.DeleteTexture(fFontData[F].fAtlases[I].TexID);
              except
                on E: Exception do
                  if not deleteFailed then
                  begin
                    firstDeleteError := E.Message;
                    deleteFailed := True;
                  end;
              end;
            fFontData[F].fAtlases[I].TexID := 0;
            fFontData[F].fAtlases[I].GpuCurrent := False;
          end;
  finally
    for F := Low(TKMFont) to High(TKMFont) do
      fFontData[F].Free;
  end;

  inherited;
  if deleteFailed then
    raise Exception.Create(firstDeleteError);
end;


function TKMResFonts.GetFontData(aIndex: TKMFont): TKMFontSpec;
begin
  Result := fFontData[aIndex];
end;


procedure TKMResFonts.LoadFonts(aLoadLevel: TKMFontLoadLevel = fllFull);
type
  TReuseCandidate = record
    CanReuse: Boolean;
    PriorAtlas0ID: Cardinal;
  end;
  TNewFontAtlasID = record
    Font: TKMFont;
    AtlasIndex: Integer;
    TexID: Cardinal;
  end;
var
  F: TKMFont;
  I, decodedCount, atlasCount: Integer;
  relativeIdentity, fntRef: string;
  reuseCandidate: array[TKMFont] of TReuseCandidate;
  beforeID: array of Cardinal;
  newIDs: array of TNewFontAtlasID;
  newID: TNewFontAtlasID;
  seen: Boolean;

  procedure RecordCreatedIDs(aFont: TKMFont);
  var
    J, K: Integer;
  begin
    for J := 0 to High(beforeID) do
      if (beforeID[J] = 0) and (fFontData[aFont].fAtlases[J].TexID <> 0)
        and fFontData[aFont].fAtlases[J].GpuCurrent then
      begin
        seen := False;
        for K := 0 to High(newIDs) do
          if (newIDs[K].Font = aFont) and (newIDs[K].AtlasIndex = J)
            and (newIDs[K].TexID = fFontData[aFont].fAtlases[J].TexID) then
            begin
              seen := True;
              Break;
            end;
        if not seen then
        begin
          newID.Font := aFont;
          newID.AtlasIndex := J;
          newID.TexID := fFontData[aFont].fAtlases[J].TexID;
          SetLength(newIDs, Length(newIDs) + 1);
          newIDs[High(newIDs)] := newID;
        end;
      end;
  end;

  procedure CleanupNewIDs;
  var
    J, fontIndex, atlasIndex: Integer;
    savedID: Cardinal;
  begin
    for J := High(newIDs) downto 0 do
    begin
      fontIndex := Ord(newIDs[J].Font);
      atlasIndex := newIDs[J].AtlasIndex;
      if (atlasIndex >= 0) and (atlasIndex < Length(fFontData[newIDs[J].Font].fAtlases))
        and (fFontData[newIDs[J].Font].fAtlases[atlasIndex].TexID = newIDs[J].TexID)
        and fFontData[newIDs[J].Font].fAtlases[atlasIndex].GpuCurrent then
      begin
        savedID := newIDs[J].TexID;
        if TKMRender.TextureBackendReady then
          try
            TKMRender.DeleteTexture(savedID);
          except
            // Preserve the original LoadFonts failure while continuing safe cleanup.
          end;
        fFontData[newIDs[J].Font].fAtlases[atlasIndex].TexID := 0;
        fFontData[newIDs[J].Font].fAtlases[atlasIndex].GpuCurrent := False;
      end;
    end;
  end;

  procedure ReleaseAttemptPixels;
  var
    FontIndex, AtlasIndex: Integer;
  begin
    for FontIndex := Ord(Low(TKMFont)) to Ord(High(TKMFont)) do
      for AtlasIndex := 0 to High(fFontData[TKMFont(FontIndex)].fAtlases) do
        SetLength(fFontData[TKMFont(FontIndex)].fAtlases[AtlasIndex].TexData, 0);
  end;

begin
  for F := Low(TKMFont) to High(TKMFont) do
  begin
    reuseCandidate[F].CanReuse := False;
    reuseCandidate[F].PriorAtlas0ID := 0;
  end;
  if (aLoadLevel = fllFull) and HasContentLevel(fllMinimal)
    and (fLoadLevel = fllMinimal) and TKMRender.TextureBackendReady then
    for F := Low(TKMFont) to High(TKMFont) do
      if (Length(fFontData[F].fAtlases) > 0)
        and (fFontData[F].fAtlases[0].TexID <> 0)
        and fFontData[F].fAtlases[0].GpuCurrent then
      begin
        reuseCandidate[F].CanReuse := True;
        reuseCandidate[F].PriorAtlas0ID := fFontData[F].fAtlases[0].TexID;
      end;

  fContentSetValid := False;
  fLoadLevel := fllMinimal;
  decodedCount := 0;
  try
    for F := Low(TKMFont) to High(TKMFont) do
    begin
      relativeIdentity := 'data/gfx/fonts/' + FontTypeName[F] + '.' + TKMFontSpec.DEFAULT_EXT;
      fntRef := KaMResolvePackagedResource(relativeIdentity);
      fFontData[F].LoadFontX(fntRef, aLoadLevel, reuseCandidate[F].CanReuse,
        reuseCandidate[F].PriorAtlas0ID);
      Inc(decodedCount);
      if decodedCount = Ord(High(TKMFont)) - Ord(Low(TKMFont)) + 1 then
      begin
        fLoadLevel := aLoadLevel;
        fContentSetValid := True;
      end;

      if TKMRender.TextureBackendReady then
      begin
        SetLength(beforeID, fFontData[F].fAtlasCount);
        for I := 0 to High(beforeID) do
          beforeID[I] := fFontData[F].fAtlases[I].TexID;
        try
          fFontData[F].GenerateTextures(FONT_INFO[F].TexMode);
        finally
          RecordCreatedIDs(F);
        end;
        if aLoadLevel = fllMinimal then
          atlasCount := 1
        else
          atlasCount := fFontData[F].fAtlasCount;
        seen := True;
        for I := 0 to atlasCount - 1 do
          if (fFontData[F].fAtlases[I].TexID = 0)
            or not fFontData[F].fAtlases[I].GpuCurrent then
            seen := False;
        if seen then
          fFontData[F].Compact;
      end;
    end;
  except
    CleanupNewIDs;
    ReleaseAttemptPixels;
    raise;
  end;
end;

function TKMResFonts.HasContentLevel(aRequiredLevel: TKMFontLoadLevel): Boolean;
begin
  if not fContentSetValid then
    Exit(False);

  case fLoadLevel of
    fllFull: Result := (aRequiredLevel = fllFull) or (aRequiredLevel = fllMinimal);
    fllMinimal: Result := aRequiredLevel = fllMinimal;
  end;
end;


function TKMResFonts.HasGPUAtlasLevel(aRequiredLevel: TKMFontLoadLevel): Boolean;
var
  F: TKMFont;
  I, requiredAtlasCount: Integer;
begin
  if not TKMRender.TextureBackendReady or not HasContentLevel(aRequiredLevel) then
    Exit(False);

  for F := Low(TKMFont) to High(TKMFont) do
  begin
    if (fFontData[F] = nil) or (fFontData[F].fAtlasCount < 1)
      or (Length(fFontData[F].fAtlases) < fFontData[F].fAtlasCount) then
      Exit(False);

    if aRequiredLevel = fllMinimal then
      requiredAtlasCount := 1
    else
      requiredAtlasCount := fFontData[F].fAtlasCount;

    for I := 0 to requiredAtlasCount - 1 do
      if (fFontData[F].fAtlases[I].TexID = 0)
        or not fFontData[F].fAtlases[I].GpuCurrent then
        Exit(False);
  end;

  Result := True;
end;


function TKMResFonts.EnsureGPUAtlasLevel(aRequiredLevel: TKMFontLoadLevel): Boolean;
begin
  if HasGPUAtlasLevel(aRequiredLevel) then
    Exit(True);
  if not TKMRender.TextureBackendReady then
    Exit(False);

  LoadFonts(aRequiredLevel);
  Result := HasGPUAtlasLevel(aRequiredLevel);
end;


procedure TKMResFonts.InvalidateGPUAtlasContext;
var
  F: TKMFont;
  I: Integer;
begin
  for F := Low(TKMFont) to High(TKMFont) do
    if fFontData[F] <> nil then
      for I := 0 to High(fFontData[F].fAtlases) do
      begin
        fFontData[F].fAtlases[I].GpuCurrent := False;
        fFontData[F].fAtlases[I].TexID := 0;
      end;
end;


function TKMFontSpec.GetLineHeight: SmallInt;
begin
  Result := BaseHeight + LineSpacing;
end;


function TKMFontSpec.GetCharWidth(aChar: WideChar; aConsiderEolSymbol: Boolean = False): Integer;
begin
  if (not aConsiderEolSymbol and (aChar = #124)) or (aChar = #9) then
    Result := 0
  else
  if aChar = #32 then
    Result := WordSpacing
  else
    Result := GetLetter(aChar).Width + CharSpacing;

  // CharSpacing could be negative
  Result := Max(0, Result);
end;


function TKMFontSpec.WordWrap(aText: UnicodeString; aMaxPxWidth: Integer; aForced: Boolean; aIndentAfterNL: Boolean;
                              aTabWidth: Integer = FONT_TAB_WIDTH): UnicodeString;
const
  INDENT = '   ';
var
  I, lineWrapPos: Integer;
  lastWrappable: Integer;
  lastWrappableIsSpace: Boolean;
  lastColorMarkup, afterWrapClMarkup: UnicodeString;
  dx, prevX: Integer;
  tmpColor: Integer;
begin
  Assert(aMaxPxWidth > 0);

  if aText = '' then Exit ('');

  dx := 0;
  prevX := 0;
  lastWrappable := -1;
  lastWrappableIsSpace := False;
  lastColorMarkup := '';
  afterWrapClMarkup := '';

  I := 1;
  while I <= Length(aText) do
  begin
    //Chinese/Japanese characters (not punctuation) can always be wrapped before
    //Check this before we update dx since we are allowing wrapping before this char
    if ((Ord(aText[I]) >= 19968) and (Ord(aText[I]) <= 40870))
      or ((Ord(aText[I]) >= $3040) and (Ord(aText[I]) <= $30ff)) then
    begin
      lastWrappable := I;
      afterWrapClMarkup := lastColorMarkup;
      prevX := dx; //dx does not include this char yet, since we are wrapping before it
      lastWrappableIsSpace := False;
    end;

    //Ignore color markups [$FFFFFF][]
    if (aText[I] = '[') and (I+1 <= Length(aText)) and (aText[I+1] = ']') then
    begin
      lastColorMarkup := '';
      Inc(I); //Skip past end of color markup
    end else
      if (aText[I] = '[') and (I+8 <= Length(aText))
        and (aText[I+1] = '$') and (aText[I+8] = ']')
        and TryStrToInt(Copy(aText, I+1, 7), tmpColor) then
      begin
        lastColorMarkup := Copy(aText, I, 9);
        Inc(I,8); //Skip past start of color markup
      end else if (aText[I] = #9) then
        dx := (Floor(dx / aTabWidth) + 1) * aTabWidth
      else
        Inc(dx, GetCharWidth(aText[I]));

    if SysUtils.CharInSet(aText[I], [#9,#32,#124]) then
    begin
      lastWrappable := I;
      afterWrapClMarkup := lastColorMarkup;
      prevX := dx;
      lastWrappableIsSpace := True;
    end;

    //This algorithm is not perfect, somehow line width is not within SizeX, but very rare
    if ((dx > aMaxPxWidth) and (lastWrappable <> -1)) or (aText[I] = #124) then
    begin
      if lastWrappableIsSpace then
        aText[lastWrappable] := #124 //Replace last whitespace with EOL
      else begin
        Inc(lastWrappable);
        Insert(#124, aText, lastWrappable); //Insert EOL after last wrappable char
      end;

      if afterWrapClMarkup <> '' then
      begin
        Insert('[]', aText, lastWrappable);
        Inc(I, 2);
        Inc(lastWrappable, 2);
      end;

      if (aText[I] <> #124) and aIndentAfterNL then
      begin
        Insert(INDENT, aText, lastWrappable+1);
        Inc(I, Length(INDENT));
        Inc(dx, Length(INDENT) * WordSpacing);
      end;

      if afterWrapClMarkup <> '' then
      begin
        Insert(afterWrapClMarkup, aText, lastWrappable+1);
        Inc(I, Length(afterWrapClMarkup));
      end;

      Dec(dx, prevX); //Subtract width since replaced whitespace

      lastWrappable := -1;
    end;
    //Force an EOL part way through a word
    if aForced and (dx > aMaxPxWidth) and (lastWrappable = -1) then
    begin
      Insert(#124, aText, I); //Insert an EOL before this character
      dx := 0;

      if lastColorMarkup <> '' then
      begin
        Insert('[]', aText, I);
        Inc(I, 2);
      end;

      lineWrapPos := I;

      if aIndentAfterNL then
      begin
        Insert(INDENT, aText, I+1);
        Inc(I, Length(INDENT));
        Inc(dx, Length(INDENT) * WordSpacing);
      end;

      if lastColorMarkup <> '' then
      begin
        Insert(lastColorMarkup, aText, lineWrapPos+1);
        Inc(I, Length(lastColorMarkup));
      end;

      lastWrappable := -1;
    end;
    Inc(I);
  end;
  Result := aText;
end;


function TKMFontSpec.CharsThatFit(const aText: UnicodeString; aMaxPxWidth: Integer; aRound: Boolean = False;
                                  aConsiderEolSymbol: Boolean = False; aTabWidth: Integer = FONT_TAB_WIDTH): Integer;
var
  I, dx, prevX, lastCharW: Integer;
begin
  dx := 0;
  Result := Length(aText);

  for I := 1 to Length(aText) do
  begin
    lastCharW := GetCharWidth(aText[I], aConsiderEolSymbol);
    prevX := dx;
    if aText[I] = #9 then
      dx := (Floor(dx / aTabWidth) + 1) * aTabWidth
    else
      Inc(dx, lastCharW);

    if (dx > aMaxPxWidth) then
    begin
      // If we want to get approximate result, then check if total width is closer to prev width or to current
      if aRound and (dx - aMaxPxWidth < aMaxPxWidth - prevX) then
        Result := I
      else
        Result := I - 1; //Previous character fits, this one does not
      Exit;
    end;
  end;
end;


function TKMFontSpec.GetTextSize(const aText: UnicodeString; aCountMarkup: Boolean = False; aConsiderEolSymbol: Boolean = False;
                                 aTabWidth: Integer = FONT_TAB_WIDTH): TKMPoint;
var
  lineCount: Integer;
begin
  Result := GetTextSize(aText, lineCount, aCountMarkup, aConsiderEolSymbol, aTabWidth);
end;


function TKMFontSpec.GetTextSize(const aText: UnicodeString; var aLineCount: Integer; aCountMarkup: Boolean = False;
                                 aConsiderEolSymbol: Boolean = False; aTabWidth: Integer = FONT_TAB_WIDTH): TKMPoint;
var
  I: Integer;
  lineWidthInc, tmpColor: Integer;
  lineWidth: array of Integer; // Some fonts may have negative CharSpacing
begin
  Result.X := 0;
  Result.Y := 0;

  if aText = '' then Exit;

  aLineCount := 1;
  if not aConsiderEolSymbol then
    for I := 1 to Length(aText) do
      if aText[I] = #124 then Inc(aLineCount);

  SetLength(lineWidth, aLineCount+2); //1..n+1 (for last line)

  aLineCount := 1;
  I := 1;
  while I <= Length(aText) do
  begin
    lineWidthInc := 0;
    if aCountMarkup then
    begin
      //Count all characters including markup
      if aText[I] = #9 then // Tab char
        lineWidthInc := (Floor(lineWidth[aLineCount] / aTabWidth) + 1) * aTabWidth - lineWidth[aLineCount]
      else
        lineWidthInc := GetCharWidth(aText[I], aConsiderEolSymbol);
      Inc(lineWidth[aLineCount], lineWidthInc);
    end else
      //Ignore color markups [$FFFFFF][]
      if (aText[I]='[') and (I+1 <= Length(aText)) and (aText[I+1]=']') then
        Inc(I) //Skip past this markup
      else
        if (aText[I]='[') and (I+8 <= Length(aText))
          and (aText[I+1] = '$') and (aText[I+8]=']')
          and TryStrToInt(Copy(aText, I+1, 7), tmpColor) then
          Inc(I,8) //Skip past this markup
        else begin
          //Not markup so count width normally
          if aText[I] = #9 then // Tab char
            lineWidthInc := (Floor(lineWidth[aLineCount] / aTabWidth) + 1) * aTabWidth - lineWidth[aLineCount]
          else
            lineWidthInc := GetCharWidth(aText[I], aConsiderEolSymbol);
          Inc(lineWidth[aLineCount], lineWidthInc);
        end;

    if (not aConsiderEolSymbol and (aText[I] = #124)) or (I = Length(aText)) then
    begin // If EOL or aText end
      if aText[I] <> #9 then       // for Tab reduce line width for CharSpacing and also for TAB 'jump'
        lineWidthInc := 0;
      lineWidth[aLineCount] := Math.Max(0, lineWidth[aLineCount] - CharSpacing - lineWidthInc);
      // Remove last interletter space and negate double EOLs
      Inc(aLineCount);
    end;
    Inc(I);
  end;

  Dec(aLineCount);
  Result.Y := LineHeight * aLineCount;
  for I := 1 to aLineCount do
    Result.X := Math.Max(Result.X, lineWidth[I]);
end;


// Return maximum of the width of specified strings when printed on screen with specified font.
function TKMFontSpec.GetMaxPrintWidthOfStrings(aStrings: array of string): Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := Low(aStrings) to High(aStrings) do
    Result := Max(Result, GetTextSize(aStrings[I]).X);
end;


end.