From 4072fea1cce6f2ca02943da469d5ca945911a222 Mon Sep 17 00:00:00 2001 From: admin_d Date: Wed, 14 Oct 2026 16:07:55 +0500 Subject: [PATCH] Complete BigTask --- code/KM_Render_Mobile.pas | 352 ++++++- config/extra-paths.json | 3 +- config/runtime-resources.json | 10 +- port-source/kam_remake/src/KM_GameApp.pas | 59 +- .../kam_remake/src/res/KM_ResFonts.pas | 966 ++++++++++++++++++ .../kam_remake/src/res/KM_Resource.pas | 99 +- 6 files changed, 1439 insertions(+), 50 deletions(-) create mode 100644 port-source/kam_remake/src/res/KM_ResFonts.pas diff --git a/code/KM_Render_Mobile.pas b/code/KM_Render_Mobile.pas index b442a8d..de9d7d2 100644 --- a/code/KM_Render_Mobile.pas +++ b/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,61 +288,203 @@ var alphaData: array of Byte; pixelCount, I: Cardinal; unpackAlignment: CastleGLES.GLint; - restoreUnpackAlignment: Boolean; -begin - 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'); + alignmentKnown, alignmentSetAttempted, bindAttempted: Boolean; + operationUnverified: Boolean; + finalizeErrors, finalizeEntryErrors: string; - if aMode = tfAlpha8 then + procedure AddFinalizeError(const aStage, aMessage: string); begin - pixelCount := Cardinal(aWidth) * Cardinal(aHeight); - SetLength(alphaData, pixelCount); - for I := 0 to pixelCount - 1 do - alphaData[I] := Byte((PCardinal(aData)[I] shr 24) and $FF); + if finalizeErrors <> '' then finalizeErrors := finalizeErrors + '; '; + finalizeErrors := finalizeErrors + aStage + ': ' + aMessage; end; - CastleGLES.glGetIntegerv(CastleGLES.GL_UNPACK_ALIGNMENT, @unpackAlignment); - restoreUnpackAlignment := unpackAlignment <> 1; - if restoreUnpackAlignment then - CastleGLES.glPixelStorei(CastleGLES.GL_UNPACK_ALIGNMENT, 1); - try - KMRenderMobileBindTexture(aTexture); + procedure CollectFinalizePending(const aStage: string); + var + Errors: string; + begin + if not gTextureBackendReady then Exit; try - case aMode of - tfRGB5A1: + 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 - 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); + operationUnverified := False; + AddFinalizeError('update/unbind', E.Message); + CollectFinalizePending('update/unbind'); end; - tfRGBA8: + 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); + SetLength(alphaData, pixelCount); + for I := 0 to pixelCount - 1 do + 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); + RequireTextureNoGLError('update', 'glGetIntegerv'); + operationUnverified := False; + alignmentKnown := True; + + if unpackAlignment <> 1 then + begin + alignmentSetAttempted := True; + operationUnverified := True; + CastleGLES.glPixelStorei(CastleGLES.GL_UNPACK_ALIGNMENT, 1); + RequireTextureNoGLError('update', 'glPixelStorei(1)'); + operationUnverified := False; + end; + + 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; end; - finally - if restoreUnpackAlignment then - CastleGLES.glPixelStorei(CastleGLES.GL_UNPACK_ALIGNMENT, unpackAlignment); + + FinalizeUpdate(False); + if finalizeErrors <> '' then + raise Exception.Create('texture update failed: ' + finalizeErrors); + except + KMRenderMobileInvalidateTextureBindingCache; + raise; end; end; @@ -314,23 +501,110 @@ end; function KMRenderMobileCreateTexture(aMinFilter, aMagFilter: TKMFilterType): Cardinal; var texture: CastleGLES.GLuint; + cleanupErrors, cleanupEntryErrors, cleanupFailure: string; + cleanupReady, cleanupFailed: Boolean; begin RequireTextureBackendReady; + RequireNoPreexistingTextureGLError('create'); texture := 0; - CastleGLES.glGenTextures(1, @texture); - if texture = 0 then - raise Exception.Create('Texture generation failed'); try + CastleGLES.glGenTextures(1, @texture); + RequireTextureNoGLError('create', 'glGenTextures'); + if texture = 0 then + raise Exception.Create('Texture generation failed'); 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 - KMRenderMobileDeleteTexture(Cardinal(texture)); - raise; + 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; diff --git a/config/extra-paths.json b/config/extra-paths.json index b8b9157..2fe66ee 100755 --- a/config/extra-paths.json +++ b/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" diff --git a/config/runtime-resources.json b/config/runtime-resources.json index 3c9cc8b..4118496 100644 --- a/config/runtime-resources.json +++ b/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"} ] } diff --git a/port-source/kam_remake/src/KM_GameApp.pas b/port-source/kam_remake/src/KM_GameApp.pas index 4ff55a1..60f0c4e 100644 --- a/port-source/kam_remake/src/KM_GameApp.pas +++ b/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; 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,10 +306,25 @@ 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; - ReevaluateApplicationGraphicsReadiness(candidateGeneration); + 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 begin @@ -297,7 +332,14 @@ begin fGraphicsAttemptGeneration := 0; fApplicationGraphicsReadyGeneration := 0; - TKMRender.GraphicsContextChanged(False); + 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; diff --git a/port-source/kam_remake/src/res/KM_ResFonts.pas b/port-source/kam_remake/src/res/KM_ResFonts.pas new file mode 100644 index 0000000..8830fe9 --- /dev/null +++ b/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. diff --git a/port-source/kam_remake/src/res/KM_Resource.pas b/port-source/kam_remake/src/res/KM_Resource.pas index 344f4fd..d630fc3 100644 --- a/port-source/kam_remake/src/res/KM_Resource.pas +++ b/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;