Complete BigTask

code/KM_Render_Mobile.pas

@@ -211,7 +211,8 @@ begin
         and Assigned(glTexParameteri)
         and Assigned(glTexImage2D)
         and Assigned(glGetIntegerv)
-        and Assigned(glPixelStorei)) then
+        and Assigned(glPixelStorei)
+        and Assigned(CastleGLES.glGetError)) then
       raise Exception.Create('Texture backend initialization failed');
     gTextureBackendReady := True;
   except
@@ -221,6 +222,50 @@ begin
 end;
 
 
+function DrainTextureGLErrors: string;
+var
+  ErrorCode: CastleGLES.GLenum;
+begin
+  Result := '';
+  repeat
+    ErrorCode := CastleGLES.glGetError();
+    if ErrorCode <> CastleGLES.GL_NO_ERROR then
+    begin
+      if Result <> '' then Result := Result + ', ';
+      Result := Result + '0x' + IntToHex(ErrorCode, 8);
+    end;
+  until ErrorCode = CastleGLES.GL_NO_ERROR;
+end;
+
+
+procedure RequireTextureNoGLError(const aOperation, aStage: string);
+var
+  Errors: string;
+begin
+  Errors := DrainTextureGLErrors;
+  if Errors <> '' then
+  begin
+    KMRenderMobileInvalidateTextureBindingCache;
+    raise Exception.Create(Format('texture %s — current GLES error at %s: %s',
+      [aOperation, aStage, Errors]));
+  end;
+end;
+
+
+procedure RequireNoPreexistingTextureGLError(const aOperation: string);
+var
+  Errors: string;
+begin
+  Errors := DrainTextureGLErrors;
+  if Errors <> '' then
+  begin
+    KMRenderMobileInvalidateTextureBindingCache;
+    raise Exception.Create(Format('texture %s — pre-existing GLES error(s): %s',
+      [aOperation, Errors]));
+  end;
+end;
+
+
 procedure KMRenderMobileBindTexture(aTexId: Cardinal);
 begin
   RequireTextureBackendReady;
@@ -243,14 +288,90 @@ var
   alphaData: array of Byte;
   pixelCount, I: Cardinal;
   unpackAlignment: CastleGLES.GLint;
-  restoreUnpackAlignment: Boolean;
+  alignmentKnown, alignmentSetAttempted, bindAttempted: Boolean;
+  operationUnverified: Boolean;
+  finalizeErrors, finalizeEntryErrors: string;
+
+  procedure AddFinalizeError(const aStage, aMessage: string);
+  begin
+    if finalizeErrors <> '' then finalizeErrors := finalizeErrors + '; ';
+    finalizeErrors := finalizeErrors + aStage + ': ' + aMessage;
+  end;
+
+  procedure CollectFinalizePending(const aStage: string);
+  var
+    Errors: string;
+  begin
+    if not gTextureBackendReady then Exit;
+    try
+      Errors := DrainTextureGLErrors;
+      if Errors <> '' then AddFinalizeError(aStage, Errors);
+    except
+      on E: Exception do AddFinalizeError(aStage, E.Message);
+    end;
+  end;
+
+  procedure FinalizeUpdate(aCheckPending: Boolean);
+  begin
+    finalizeEntryErrors := '';
+    if aCheckPending and operationUnverified and gTextureBackendReady then
+      try
+        finalizeEntryErrors := DrainTextureGLErrors;
+        if finalizeEntryErrors <> '' then
+          AddFinalizeError('update/finalize-entry', finalizeEntryErrors);
+      except
+        on E: Exception do
+          AddFinalizeError('update/finalize-entry', E.Message);
+      end;
+
+    if bindAttempted then
+      if gTextureBackendReady then
+        try
+          operationUnverified := True;
+          KMRenderMobileBindTexture(0);
+          RequireTextureNoGLError('update', 'unbind');
+          operationUnverified := False;
+        except
+          on E: Exception do
+          begin
+            operationUnverified := False;
+            AddFinalizeError('update/unbind', E.Message);
+            CollectFinalizePending('update/unbind');
+          end;
+        end
+      else
+        AddFinalizeError('update/unbind', 'current texture context is unavailable');
+
+    if alignmentKnown and alignmentSetAttempted and (unpackAlignment <> 1) then
+      if gTextureBackendReady then
+        try
+          operationUnverified := True;
+          CastleGLES.glPixelStorei(CastleGLES.GL_UNPACK_ALIGNMENT, unpackAlignment);
+          RequireTextureNoGLError('update', 'restore-unpack');
+          operationUnverified := False;
+        except
+          on E: Exception do
+          begin
+            operationUnverified := False;
+            AddFinalizeError('update/restore-unpack', E.Message);
+            CollectFinalizePending('update/restore-unpack');
+          end;
+        end
+      else
+        AddFinalizeError('update/restore-unpack', 'current texture context is unavailable');
+  end;
+
 begin
+  try
     RequireTextureBackendReady;
     if (aTexture = 0) or (aWidth = 0) or (aHeight = 0)
        or not IsPowerOfTwo(aWidth) or not IsPowerOfTwo(aHeight)
        or (aData = nil) then
       raise Exception.Create('Invalid texture upload parameters');
+    if not (aMode in [tfRGB5A1, tfRGBA8, tfAlpha8]) then
+      raise Exception.Create('Unsupported texture upload format');
 
+    RequireNoPreexistingTextureGLError('update');
     if aMode = tfAlpha8 then
     begin
       pixelCount := Cardinal(aWidth) * Cardinal(aHeight);
@@ -259,45 +380,111 @@ begin
         alphaData[I] := Byte((PCardinal(aData)[I] shr 24) and $FF);
     end;
 
+    alignmentKnown := False;
+    alignmentSetAttempted := False;
+    bindAttempted := False;
+    operationUnverified := False;
+    finalizeErrors := '';
+    try
+      operationUnverified := True;
       CastleGLES.glGetIntegerv(CastleGLES.GL_UNPACK_ALIGNMENT, @unpackAlignment);
-  restoreUnpackAlignment := unpackAlignment <> 1;
-  if restoreUnpackAlignment then
+      RequireTextureNoGLError('update', 'glGetIntegerv');
+      operationUnverified := False;
+      alignmentKnown := True;
+
+      if unpackAlignment <> 1 then
+      begin
+        alignmentSetAttempted := True;
+        operationUnverified := True;
         CastleGLES.glPixelStorei(CastleGLES.GL_UNPACK_ALIGNMENT, 1);
-  try
-    KMRenderMobileBindTexture(aTexture);
-    try
-      case aMode of
-        tfRGB5A1:
-          begin
-            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_R, CastleGLES.GL_RED);
-            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_G, CastleGLES.GL_GREEN);
-            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_B, CastleGLES.GL_BLUE);
-            CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_A, CastleGLES.GL_ALPHA);
-            CastleGLES.glTexImage2D(CastleGLES.GL_TEXTURE_2D, 0, CastleGLES.GL_RGB5_A1, aWidth, aHeight, 0, CastleGLES.GL_RGBA, CastleGLES.GL_UNSIGNED_BYTE, aData);
+        RequireTextureNoGLError('update', 'glPixelStorei(1)');
+        operationUnverified := False;
       end;
-        tfRGBA8:
+
+      bindAttempted := True;
+      operationUnverified := True;
+      KMRenderMobileBindTexture(aTexture);
+      RequireTextureNoGLError('update', 'glBindTexture');
+      operationUnverified := False;
+
+      case aMode of
+        tfRGB5A1, tfRGBA8:
           begin
+            operationUnverified := True;
             CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_R, CastleGLES.GL_RED);
+            RequireTextureNoGLError('update', 'glTexParameteri(GL_TEXTURE_SWIZZLE_R)');
+            operationUnverified := False;
+            operationUnverified := True;
             CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_G, CastleGLES.GL_GREEN);
+            RequireTextureNoGLError('update', 'glTexParameteri(GL_TEXTURE_SWIZZLE_G)');
+            operationUnverified := False;
+            operationUnverified := True;
             CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_B, CastleGLES.GL_BLUE);
+            RequireTextureNoGLError('update', 'glTexParameteri(GL_TEXTURE_SWIZZLE_B)');
+            operationUnverified := False;
+            operationUnverified := True;
             CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_A, CastleGLES.GL_ALPHA);
-            CastleGLES.glTexImage2D(CastleGLES.GL_TEXTURE_2D, 0, CastleGLES.GL_RGBA8, aWidth, aHeight, 0, CastleGLES.GL_RGBA, CastleGLES.GL_UNSIGNED_BYTE, aData);
+            RequireTextureNoGLError('update', 'glTexParameteri(GL_TEXTURE_SWIZZLE_A)');
+            operationUnverified := False;
+            if aMode = tfRGB5A1 then
+            begin
+              operationUnverified := True;
+              CastleGLES.glTexImage2D(CastleGLES.GL_TEXTURE_2D, 0, CastleGLES.GL_RGB5_A1,
+                aWidth, aHeight, 0, CastleGLES.GL_RGBA, CastleGLES.GL_UNSIGNED_BYTE, aData);
+              RequireTextureNoGLError('update', 'glTexImage2D');
+              operationUnverified := False;
+            end
+            else
+            begin
+              operationUnverified := True;
+              CastleGLES.glTexImage2D(CastleGLES.GL_TEXTURE_2D, 0, CastleGLES.GL_RGBA8,
+                aWidth, aHeight, 0, CastleGLES.GL_RGBA, CastleGLES.GL_UNSIGNED_BYTE, aData);
+              RequireTextureNoGLError('update', 'glTexImage2D');
+              operationUnverified := False;
+            end;
           end;
         tfAlpha8:
           begin
+            operationUnverified := True;
             CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_R, CastleGLES.GL_ONE);
+            RequireTextureNoGLError('update', 'glTexParameteri(GL_TEXTURE_SWIZZLE_R)');
+            operationUnverified := False;
+            operationUnverified := True;
             CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_G, CastleGLES.GL_ONE);
+            RequireTextureNoGLError('update', 'glTexParameteri(GL_TEXTURE_SWIZZLE_G)');
+            operationUnverified := False;
+            operationUnverified := True;
             CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_B, CastleGLES.GL_ONE);
+            RequireTextureNoGLError('update', 'glTexParameteri(GL_TEXTURE_SWIZZLE_B)');
+            operationUnverified := False;
+            operationUnverified := True;
             CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_SWIZZLE_A, CastleGLES.GL_RED);
-            CastleGLES.glTexImage2D(CastleGLES.GL_TEXTURE_2D, 0, CastleGLES.GL_R8, aWidth, aHeight, 0, CastleGLES.GL_RED, CastleGLES.GL_UNSIGNED_BYTE, @alphaData[0]);
+            RequireTextureNoGLError('update', 'glTexParameteri(GL_TEXTURE_SWIZZLE_A)');
+            operationUnverified := False;
+            operationUnverified := True;
+            CastleGLES.glTexImage2D(CastleGLES.GL_TEXTURE_2D, 0, CastleGLES.GL_R8,
+              aWidth, aHeight, 0, CastleGLES.GL_RED, CastleGLES.GL_UNSIGNED_BYTE, @alphaData[0]);
+            RequireTextureNoGLError('update', 'glTexImage2D');
+            operationUnverified := False;
           end;
       end;
-    finally
-      KMRenderMobileBindTexture(0);
+    except
+      on E: Exception do
+      begin
+        KMRenderMobileInvalidateTextureBindingCache;
+        FinalizeUpdate(True);
+        if finalizeErrors <> '' then
+          E.Message := E.Message + '; secondary finalize failure(s): ' + finalizeErrors;
+        raise;
       end;
-  finally
-    if restoreUnpackAlignment then
-      CastleGLES.glPixelStorei(CastleGLES.GL_UNPACK_ALIGNMENT, unpackAlignment);
+    end;
+
+    FinalizeUpdate(False);
+    if finalizeErrors <> '' then
+      raise Exception.Create('texture update failed: ' + finalizeErrors);
+  except
+    KMRenderMobileInvalidateTextureBindingCache;
+    raise;
   end;
 end;
 
@@ -314,24 +501,111 @@ end;
 function KMRenderMobileCreateTexture(aMinFilter, aMagFilter: TKMFilterType): Cardinal;
 var
   texture: CastleGLES.GLuint;
+  cleanupErrors, cleanupEntryErrors, cleanupFailure: string;
+  cleanupReady, cleanupFailed: Boolean;
 begin
   RequireTextureBackendReady;
+  RequireNoPreexistingTextureGLError('create');
   texture := 0;
+  try
     CastleGLES.glGenTextures(1, @texture);
+    RequireTextureNoGLError('create', 'glGenTextures');
     if texture = 0 then
       raise Exception.Create('Texture generation failed');
-  try
     KMRenderMobileBindTexture(Cardinal(texture));
+    RequireTextureNoGLError('create', 'glBindTexture');
     CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_MIN_FILTER, TextureFilter(aMinFilter));
+    RequireTextureNoGLError('create', 'glTexParameteri(GL_TEXTURE_MIN_FILTER)');
     CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_MAG_FILTER, TextureFilter(aMagFilter));
+    RequireTextureNoGLError('create', 'glTexParameteri(GL_TEXTURE_MAG_FILTER)');
     CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_WRAP_S, CastleGLES.GL_CLAMP_TO_EDGE);
+    RequireTextureNoGLError('create', 'glTexParameteri(GL_TEXTURE_WRAP_S)');
     CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_WRAP_T, CastleGLES.GL_CLAMP_TO_EDGE);
+    RequireTextureNoGLError('create', 'glTexParameteri(GL_TEXTURE_WRAP_T)');
     CastleGLES.glTexParameteri(CastleGLES.GL_TEXTURE_2D, CastleGLES.GL_TEXTURE_MAX_LEVEL, 0);
+    RequireTextureNoGLError('create', 'glTexParameteri(GL_TEXTURE_MAX_LEVEL)');
     Result := Cardinal(texture);
   except
+    on E: Exception do
+    begin
+      KMRenderMobileInvalidateTextureBindingCache;
+      try
+        cleanupErrors := '';
+        cleanupEntryErrors := '';
+        cleanupFailure := '';
+        cleanupFailed := False;
+        if texture <> 0 then
+        begin
+          cleanupReady := False;
+          try
+            RequireTextureBackendReady;
+            cleanupReady := True;
+          except
+            on CleanupE: Exception do
+            begin
+              cleanupFailed := True;
+              cleanupFailure := 'cleanup unavailable: ' + CleanupE.Message;
+            end;
+          end;
+          if cleanupReady then
+          begin
+            try
+              cleanupEntryErrors := DrainTextureGLErrors;
+            except
+              on CleanupE: Exception do
+              begin
+                cleanupFailed := True;
+                cleanupFailure := 'cleanup-entry drain failed: ' + CleanupE.Message;
+              end;
+            end;
+            try
               KMRenderMobileDeleteTexture(Cardinal(texture));
+            except
+              on CleanupE: Exception do
+              begin
+                cleanupFailed := True;
+                if cleanupFailure <> '' then cleanupFailure := cleanupFailure + '; ';
+                cleanupFailure := cleanupFailure + 'glDeleteTextures failed: ' + CleanupE.Message;
+              end;
+            end;
+            try
+              cleanupErrors := DrainTextureGLErrors;
+              if cleanupErrors <> '' then
+              begin
+                cleanupFailed := True;
+                if cleanupFailure <> '' then cleanupFailure := cleanupFailure + '; ';
+                cleanupFailure := cleanupFailure + 'glDeleteTextures GLES error(s): ' + cleanupErrors;
+              end;
+            except
+              on CleanupE: Exception do
+              begin
+                cleanupFailed := True;
+                if cleanupFailure <> '' then cleanupFailure := cleanupFailure + '; ';
+                cleanupFailure := cleanupFailure + 'cleanup drain failed: ' + CleanupE.Message;
+              end;
+            end;
+            if cleanupEntryErrors <> '' then
+            begin
+              if cleanupFailed then
+              begin
+                if cleanupFailure <> '' then cleanupFailure := cleanupFailure + '; ';
+                cleanupFailure := cleanupFailure + 'cleanup-entry GLES error(s): ' + cleanupEntryErrors;
+              end;
+            end;
+          end;
+        end;
+        KMRenderMobileInvalidateTextureBindingCache;
+        if cleanupFailed then
+          try
+            E.Message := E.Message + '; texture create cleanup failed: ' + cleanupFailure;
+          except
+          end;
+      except
+        KMRenderMobileInvalidateTextureBindingCache;
+      end;
       raise;
     end;
+  end;
 end;
 
 

config/extra-paths.json

@@ -29,7 +29,8 @@
     "src/render/KM_RenderPool.pas",
     "src/gui/KM_InterfaceGame.pas",
     "src/render/KM_RenderTerrain.pas",
-    "src/res/KM_ResInterpolation.pas"
+    "src/res/KM_ResInterpolation.pas",
+    "src/res/KM_ResFonts.pas"
   ],
   "source_paths": [
     "code/resource"

config/runtime-resources.json

@@ -9,6 +9,14 @@
     {"kind": "file", "path": "data/defines/tiles.json"},
     {"kind": "file", "path": "data/gfx/pal0.bbm"},
     {"kind": "file", "path": "data/defines/mapelem.dat"},
-    {"kind": "file", "path": "data/locales.txt"}
+    {"kind": "file", "path": "data/locales.txt"},
+    {"kind": "file", "path": "data/gfx/fonts/antiqua.fntx"},
+    {"kind": "file", "path": "data/gfx/fonts/game.fntx"},
+    {"kind": "file", "path": "data/gfx/fonts/grey.fntx"},
+    {"kind": "file", "path": "data/gfx/fonts/metal.fntx"},
+    {"kind": "file", "path": "data/gfx/fonts/mini.fntx"},
+    {"kind": "file", "path": "data/gfx/fonts/outline.fntx"},
+    {"kind": "file", "path": "data/gfx/fonts/arial.fntx"},
+    {"kind": "file", "path": "data/gfx/fonts/consolas8.fntx"}
   ]
 }

port-source/kam_remake/src/KM_GameApp.pas

@@ -190,6 +190,8 @@ uses
 // Creating everything needed for MainMenu, game stuff is created on StartGame
 constructor TKMGameApp.Create(aScreenX, aScreenY: Word; aVSync: Boolean; aOnLoadingStep: TKMEvent;
                               aOnLoadingText: TUnicodeStringEvent; aOnStatusBarUpdate: TProc<TKMStatusBarPanel, string>; NoMusic: Boolean = False);
+var
+  candidateGeneration: QWord;
 begin
   inherited Create;
 
@@ -225,6 +227,24 @@ begin
   gRes := TKMResource.Create(aOnLoadingStep, aOnLoadingText);
   gRes.LoadMainResources(gGameSettings.Locale, gGameSettings.GFX.LoadFullFonts);
 
+  candidateGeneration := fGraphicsAttemptGeneration;
+  if candidateGeneration <> 0 then
+  begin
+    if IsCurrentGraphicsAttempt(candidateGeneration)
+      and TKMRender.TextureBackendReady
+      and (gRes <> nil)
+      and (gRes.Fonts <> nil) then
+    begin
+      gRes.EnsureFontResourcesForGeneration(candidateGeneration, fGraphicsAttemptGeneration);
+
+      if IsCurrentGraphicsAttempt(candidateGeneration)
+        and TKMRender.TextureBackendReady then
+        ReevaluateApplicationGraphicsReadiness(candidateGeneration);
+    end
+    else if IsCurrentGraphicsAttempt(candidateGeneration) then
+      ReevaluateApplicationGraphicsReadiness(candidateGeneration);
+  end;
+
   {$IFDEF USE_MAD_EXCEPT}gExceptions.LoadTranslation;{$ENDIF}
 
   //Show the message if user has old OpenGL drivers (pre-1.4)
@@ -286,9 +306,24 @@ begin
     if not TKMRender.TextureBackendReady then
       raise Exception.Create('Graphics texture backend is not ready after context restore');
 
+    if gRes <> nil then
+      gRes.InvalidateFontGraphicsContext;
+
     if (gRes <> nil) and (gRes.DataState <> rlsNone) then
       gRes.StartGameSpriteRecovery;
 
+    if IsCurrentGraphicsAttempt(candidateGeneration)
+      and TKMRender.TextureBackendReady
+      and (gRes <> nil)
+      and (gRes.Fonts <> nil) then
+    begin
+      gRes.EnsureFontResourcesForGeneration(candidateGeneration, fGraphicsAttemptGeneration);
+
+      if IsCurrentGraphicsAttempt(candidateGeneration)
+        and TKMRender.TextureBackendReady then
+        ReevaluateApplicationGraphicsReadiness(candidateGeneration);
+    end
+    else if IsCurrentGraphicsAttempt(candidateGeneration) then
       ReevaluateApplicationGraphicsReadiness(candidateGeneration);
   end
   else
@@ -297,6 +332,13 @@ begin
     fGraphicsAttemptGeneration := 0;
     fApplicationGraphicsReadyGeneration := 0;
 
+    if gRes <> nil then
+      try
+        gRes.InvalidateFontGraphicsContext;
+      finally
+        TKMRender.GraphicsContextChanged(False);
+      end
+    else
       TKMRender.GraphicsContextChanged(False);
   end;
 end;
@@ -312,6 +354,10 @@ begin
     Exit;
   if not TKMRender.SampledProgramReady then
     Exit;
+  if gRes = nil then
+    Exit;
+  if not gRes.FontResourcesReadyForGeneration(aCandidateGeneration) then
+    Exit;
   if gGame <> nil then
   begin
     if gRes = nil then
@@ -330,6 +376,15 @@ begin
         and (fGraphicsGeneration <> 0)
         and (fGraphicsAttemptGeneration = fGraphicsGeneration)
         and (fApplicationGraphicsReadyGeneration = fGraphicsGeneration);
+  if not Result then
+    Exit;
+  if gRes = nil then
+  begin
+    Result := False;
+    Exit;
+  end;
+
+  Result := gRes.FontResourcesReadyForGeneration(fGraphicsGeneration);
 end;
 
 

port-source/kam_remake/src/res/KM_ResFonts.pas

@@ -0,0 +1,966 @@
+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.

port-source/kam_remake/src/res/KM_Resource.pas

@@ -26,6 +26,9 @@ type
   TKMResource = class
   private
     fDataState: TResourceLoadState;
+    fRequiredFontLevel: TKMFontLoadLevel;
+    fFontCompletionGeneration: QWord;
+    fFontCompletionValid: Boolean;
 
     fCursors: TKMResCursors;
     fFonts: TKMResFonts;
@@ -43,6 +46,7 @@ type
     procedure EnsureGameResourceInterpolation;
     procedure StepRefresh;
     procedure StepCaption(const aCaption: UnicodeString);
+    procedure InvalidateFontCompletion;
   public
     OnLoadingStep: TKMEvent;
     OnLoadingText: TUnicodeStringEvent;
@@ -59,6 +63,10 @@ type
     procedure LoadGameResources(aAlphaShadows: Boolean; aForceReload: Boolean = False);
     procedure StartGameSpriteRecovery;
     procedure LoadLocaleFonts(const aLocale: AnsiString; aLoadFullFonts: Boolean);
+    function FontResourcesReadyForGeneration(aGeneration: QWord): Boolean;
+    procedure InvalidateFontGraphicsContext;
+    function EnsureFontResourcesForGeneration(aCandidateGeneration: QWord;
+      constref aLiveAttemptGeneration: QWord): Boolean;
 
     property DataState: TResourceLoadState read fDataState;
     property GameResourcesReady: Boolean read GetGameResourcesReady;
@@ -100,6 +108,9 @@ begin
   inherited Create;
 
   fDataState := rlsNone;
+  fRequiredFontLevel := fllMinimal;
+  fFontCompletionGeneration := 0;
+  fFontCompletionValid := False;
   gLog.AddTime('Resource loading state - None');
 
   OnLoadingStep := aOnLoadingStep;
@@ -256,21 +267,95 @@ begin
   // Locale info is needed for DAT export and font loading
   LoadLocaleResources(aLocale);
 
-  StepCaption('Reading fonts ...');
-  fFonts := TKMResFonts.Create;
   if aLoadFullFonts or gResLocales.LocaleByCode(aLocale).NeedsFullFonts then
-    fFonts.LoadFonts(fllFull)
+    fRequiredFontLevel := fllFull
   else
-    fFonts.LoadFonts(fllMinimal);
+    fRequiredFontLevel := fllMinimal;
+  InvalidateFontCompletion;
+
+  StepCaption('Reading fonts ...');
+  FreeAndNil(fFonts);
+  fFonts := TKMResFonts.Create;
+  fFonts.LoadFonts(fRequiredFontLevel);
   gLog.AddTime('Read fonts is done');
 end;
 
 
 procedure TKMResource.LoadLocaleFonts(const aLocale: AnsiString; aLoadFullFonts: Boolean);
+var
+  previouslyConfirmedGeneration: QWord;
 begin
-  if (Fonts.LoadLevel <> fllFull)
-    and (aLoadFullFonts or gResLocales.LocaleByCode(aLocale).NeedsFullFonts) then
-    Fonts.LoadFonts(fllFull);
+  if not (aLoadFullFonts or gResLocales.LocaleByCode(aLocale).NeedsFullFonts) then
+    Exit;
+
+  fRequiredFontLevel := fllFull;
+  if fFonts = nil then
+    Exit;
+
+  if fFonts.HasContentLevel(fllFull) then
+    Exit;
+
+  previouslyConfirmedGeneration := fFontCompletionGeneration;
+  InvalidateFontCompletion;
+  fFonts.LoadFonts(fllFull);
+
+  if (previouslyConfirmedGeneration <> 0)
+    and (fFontCompletionGeneration = previouslyConfirmedGeneration)
+    and fFonts.HasContentLevel(fllFull)
+    and fFonts.HasGPUAtlasLevel(fllFull) then
+    fFontCompletionValid := True;
+end;
+
+
+procedure TKMResource.InvalidateFontCompletion;
+begin
+  fFontCompletionValid := False;
+end;
+
+
+function TKMResource.FontResourcesReadyForGeneration(aGeneration: QWord): Boolean;
+begin
+  Result := False;
+  if (aGeneration = 0) or not fFontCompletionValid
+    or (fFontCompletionGeneration <> aGeneration) or (fFonts = nil) then
+    Exit;
+
+  Result := fFonts.HasContentLevel(fRequiredFontLevel)
+    and fFonts.HasGPUAtlasLevel(fRequiredFontLevel);
+end;
+
+
+procedure TKMResource.InvalidateFontGraphicsContext;
+begin
+  fFontCompletionGeneration := 0;
+  fFontCompletionValid := False;
+  if fFonts <> nil then
+    fFonts.InvalidateGPUAtlasContext;
+end;
+
+
+function TKMResource.EnsureFontResourcesForGeneration(aCandidateGeneration: QWord;
+  constref aLiveAttemptGeneration: QWord): Boolean;
+begin
+  InvalidateFontCompletion;
+  Result := False;
+  if (aCandidateGeneration = 0)
+    or (aLiveAttemptGeneration <> aCandidateGeneration)
+    or (fFonts = nil) then
+    Exit;
+
+  if not fFonts.EnsureGPUAtlasLevel(fRequiredFontLevel) then
+    Exit;
+
+  if (aLiveAttemptGeneration <> aCandidateGeneration)
+    or (fFonts = nil)
+    or not fFonts.HasContentLevel(fRequiredFontLevel)
+    or not fFonts.HasGPUAtlasLevel(fRequiredFontLevel) then
+    Exit;
+
+  fFontCompletionGeneration := aCandidateGeneration;
+  fFontCompletionValid := True;
+  Result := True;
 end;