diff --git a/port-source/kam_remake/src/render/KM_RenderTerrain.pas b/port-source/kam_remake/src/render/KM_RenderTerrain.pas index 0b4e631..8911961 100644 --- a/port-source/kam_remake/src/render/KM_RenderTerrain.pas +++ b/port-source/kam_remake/src/render/KM_RenderTerrain.pas @@ -8,93 +8,80 @@ uses KM_ResSprites, KM_ResTilesetTypes, KM_CommonClasses, KM_CommonTypes, KM_Defaults, KM_Points, KM_FogOfWar, KM_Pics, - KM_TerrainTypes; + KM_TerrainTypes, + KM_RenderTerrain_Mobile; type - TKMVBOArrayType = (vatNone, vatTile, vatTileLayer, vatAnimTile, vatFOW); - TKMUVRect = array [1 .. 4, 1 .. 2] of Single; // Texture UV coordinates - TKMTileVerticeExt = record - X, Y, Z, UTile, VTile, ULit, UShd: Single; + TKMTerrainAtlasPublication = record + Generation: QWord; + Revision: QWord; + Published: Boolean; end; - - TKMTileFowVertice = record - X, Y, Z, UFow: Single; + TKMTerrainGraphicsPrerequisites = record + ContextAvailable: Boolean; + Generation: QWord; + Tiles: TKMTerrainAtlasPublication; + Gui: TKMTerrainAtlasPublication; end; - - TKMTileVertice = record - X, Y, Z, UAnim, VAnim: Single; - end; - - TKMTileVerticeExtArray = array of TKMTileVerticeExt; - - TKMTileFowVerticeArray = array of TKMTileFowVertice; - - TKMTileVerticeArray = array of TKMTileVertice; + TKMTerrainGraphicsState = (tgsNotReady, tgsReady, tgsFailure); //Render terrain without sprites TKMRenderTerrain = class + private + type + TKMTerrainBundleKey = record + Generation, TilesRevision, GuiRevision: QWord; + end; private fClipRect: TKMRect; + fGraphics: TKMTerrainMobileGraphics; + fGraphicsState: TKMTerrainGraphicsState; + fHaveGraphicsFacts: Boolean; + fGraphicsFacts: TKMTerrainGraphicsPrerequisites; + fReadyKey: TKMTerrainBundleKey; + fHaveReadyKey: Boolean; + fMaxTilesRevision, fMaxGuiRevision: QWord; + fTrustedGeneration: QWord; + fTrustedTiles, fTrustedGui: TKMTerrainAtlasPublication; + fGpuGeneration: QWord; + fDiscardedGpuGeneration: QWord; fTextG: GLuint; //Shading gradient for lighting - fTextB: GLuint; //Contrast BW for FOW over color-coder - fUseVBO: Boolean; //Wherever to render terrain through VBO (faster but needs GL1.5) or DrawCalls (slower but needs only GL1.1) - - fTilesVtx: TKMTileVerticeExtArray; //Vertice buffer for tiles - fTilesVtxCount: Integer; - fTilesInd: array of Integer; //Indexes for tiles array - fTilesIndCount: Integer; - - fTilesLayersVtx: array of TKMTileVertice; //Vertice cache for layers - fTilesLayersInd: array of Integer; //Indexes for layers array - - fAnimTilesVtx: TKMTileVerticeArray; //Vertice buffer for tiles animations (water/falls/swamp) - fAnimTilesVtxCount: Integer; - fAnimTilesInd: array of Integer; //Indexes for array tiles animation array - fAnimTilesIndCount: Integer; - - fTilesFowVtx: TKMTileFowVerticeArray; //Vertice buffer for tiles - fTilesFowVtxCount: Integer; - fTilesFowInd: array of Integer; //Indexes for tiles array - fTilesFowIndCount: Integer; - - fVtxTilesShd: GLUint; - fIndTilesShd: GLUint; - fVtxTilesLayersShd: GLUint; - fIndTilesLayersShd: GLUint; - fVtxAnimTilesShd: GLUint; - fIndAnimTilesShd: GLUint; - fVtxTilesFowShd: GLUint; - fIndTilesFowShd: GLUint; fTileUVLookup: array [0..TILES_CNT-1, 0..3] of TKMUVRect; - fLastBindVBOArrayType: TKMVBOArrayType; - fVBONeedsFlush: array [TKMVBOArrayType] of Boolean; - fVBOLastClipRect: TKMRect; - fVBOLastGameTick: Cardinal; - fVBOLastFOW: TKMFogOfWarCommon; - - procedure RenderQuadTexture(var TexC: TKMUVRect; tX,tY: Word); inline; - procedure RenderQuadTextureBlended(var TexC: TKMUVRect; tX,tY: Word; aCorners: TKMTileCorners; aBlendingLevel: Byte); inline; + fHaveTileUV: Boolean; + fHaveDerivedKey: Boolean; + fDerivedKey: TKMTerrainBundleKey; + procedure BuildCurrentBaseTileQuad(tX, tY: Word; const aTex: TKMUVRect; out aQuad: TTerrainMobileQuad); function GetTileUV(Index: Word; Rot: Byte): TKMUVRect; inline; - procedure BindVBOArray(aVBOArrayType: TKMVBOArrayType); inline; - procedure UpdateVBO(aAnimStep: Integer; aFOW: TKMFogOfWarCommon); procedure DoTiles(aFOW: TKMFogOfWarCommon); procedure DoTilesLayers(aFOW: TKMFogOfWarCommon); procedure DoOverlays(aFOW: TKMFogOfWarCommon); + procedure SubmitOverlayTile(aTileID: Word; pX,pY,Rot: Integer); + procedure RenderTileOverlay(pX, pY: Integer); procedure DoLighting(aFOW: TKMFogOfWarCommon); procedure DoAnimations(aAnimStep: Integer; aFOW: TKMFogOfWarCommon); procedure DoShadows(aFOW: TKMFogOfWarCommon); - function VBOSupported: Boolean; procedure RenderFence(aFence: TKMFenceKind; Pos: TKMDirection; pX,pY: Integer); procedure RenderMarkup(pX, pY: Word; aFieldType: TKMFieldType); - procedure DoRenderTile(aTerrainId: Word; pX,pY,Rot: Integer; aDoBindTexture: Boolean; aUseTileLookup: Boolean; - DoHighlight: Boolean = False; HighlightColor: Cardinal = 0; aBlendingLvl: Byte = 0); overload; - procedure DoRenderTile(aTerrainId: Word; pX,pY,Rot: Integer; aCorners: TKMTileCorners; aDoBindTexture: Boolean; - aUseTileLookup: Boolean; DoHighlight: Boolean = False; HighlightColor: Cardinal = 0; - aBlendingLvl: Byte = 0); overload; - function DoUseVBO: Boolean; + procedure RevokeTerrainReady; + procedure HandleTerrainPassFailure(aError: TObject; const aKey: TKMTerrainBundleKey); + function ExternalTerrainFactsValid(aGeneration: QWord): Boolean; + function CurrentTerrainBundleKey(out aKey: TKMTerrainBundleKey): Boolean; + function SameTerrainBundleKey(const aLeft, aRight: TKMTerrainBundleKey): Boolean; + function EvaluateTerrainGraphicsState(aGeneration: QWord): TKMTerrainGraphicsState; + function TerrainDrawAllowed: Boolean; + function TerrainOwnedGpuComplete(aGeneration: QWord): Boolean; + function TerrainDerivedDataComplete(const aKey: TKMTerrainBundleKey): Boolean; + function RehydrateTerrainOwnedGpuForGeneration(aGeneration: QWord): Boolean; + function ReconcileTerrainDerivedForKey(const aKey: TKMTerrainBundleKey): Boolean; + procedure InvalidateTerrainOwnedGpu(aContextAvailable: Boolean); + procedure InvalidateTerrainDerivedData; + procedure CreateCurrentTerrainGradient; + procedure ReleaseCurrentTerrainGpu(aGeneration: QWord); + function TerrainGpuContextCurrent: Boolean; + procedure DiscardTerrainGpuAfterContextLoss; public constructor Create; destructor Destroy; override; @@ -102,126 +89,550 @@ type procedure RenderBase(aAnimStep: Integer; aFOW: TKMFogOfWarCommon); procedure RenderFences(aFOW: TKMFogOfWarCommon); procedure RenderPlayerPlans(aFieldsList: TKMPointTagList; aHousePlansList: TKMPointDirList); - procedure RenderFOW(aFOW: TKMFogOfWarCommon; aUseContrast: Boolean = False); - procedure RenderTile(aTerrainId: Word; pX,pY,Rot: Integer; DoHighlight: Boolean = False; HighlightColor: Cardinal = 0); overload; - procedure RenderTile(pX,pY: Integer; aTileBasic: TKMTerrainTileBasic; DoHighlight: Boolean = False; HighlightColor: Cardinal = 0); overload; - procedure RenderTileOverlay(pX, pY: Integer; DoHighlight: Boolean = False; HighlightColor: Cardinal = 0); + procedure RenderFOW(aFOW: TKMFogOfWarCommon); + procedure AcceptGraphicsPrerequisites(const aFacts: TKMTerrainGraphicsPrerequisites); + function PrepareGraphicsBundleForGeneration(aGeneration: QWord): TKMTerrainGraphicsState; + function GraphicsCompletionForGeneration(aGeneration: QWord): TKMTerrainGraphicsState; end; implementation uses + CastleRenderOptions, KM_Game, KM_GameParams, KM_Render, KM_RenderTypes, KM_Resource, KM_ResTypes, - KM_DevPerfLog, KM_DevPerfLogTypes, KM_Terrain; -const - TILE_LAYERS_USE_VBO = False; - MAX_RENDERABLE_TILES = (MAX_MAP_SIZE + 1) * (MAX_MAP_SIZE + 1); - MAX_RENDERABLE_VERTICIES = 4 * MAX_RENDERABLE_TILES; - MAX_RENDERABLE_INDEXES = 6 * MAX_RENDERABLE_TILES; - - { TKMRenderTerrain } constructor TKMRenderTerrain.Create; -var - I, K: Integer; - pData: array [0..255] of Cardinal; - V: TKMVBOArrayType; begin inherited; - //Tiles UV lookup for faster access. Only base tileset for smaller size - for I := 0 to TILES_CNT - 1 do - for K := 0 to 3 do - fTileUVLookup[I, K] := GetTileUV(I, K); + fGraphics := TKMTerrainMobileGraphics.Create; + fGraphics.ContextCheck := {$IFDEF FPC}@{$ENDIF}TerrainGpuContextCurrent; + fGpuGeneration := 0; + fTextG := 0; - //Generate gradient programmatically - //KaM uses [0..255] gradients - //We use slightly smoothed gradients [16..255] for Remake - //cos it shows much more of terrain on screen and it looks too contrast - for I := 0 to 255 do - pData[I] := EnsureRange(Round(I * 1.0625 - 16), 0, 255) * 65793 or $FF000000; - - fTextG := TKMRender.GenTexture(256, 1, @pData[0], tfRGBA8, ftNearest, ftNearest); - - //Sharp transition between black and white - pData[0] := $FF000000; - pData[1] := $00000000; - pData[2] := $00000000; - pData[3] := $00000000; - fTextB := TKMRender.GenTexture(4, 1, @pData[0], tfRGBA8, ftNearest, ftNearest); - - fUseVBO := DoUseVBO; - - if fUseVBO then - begin - glGenBuffers(1, @fVtxTilesShd); - glGenBuffers(1, @fIndTilesShd); - glGenBuffers(1, @fVtxTilesLayersShd); - glGenBuffers(1, @fIndTilesLayersShd); - glGenBuffers(1, @fVtxAnimTilesShd); - glGenBuffers(1, @fIndAnimTilesShd); - glGenBuffers(1, @fVtxTilesFowShd); - glGenBuffers(1, @fIndTilesFowShd); - - //Allocate buffers large enough for the entire map - SetLength(fTilesVtx, MAX_RENDERABLE_VERTICIES); - SetLength(fTilesInd, MAX_RENDERABLE_INDEXES); - SetLength(fTilesFowVtx, MAX_RENDERABLE_VERTICIES); - SetLength(fTilesFowInd, MAX_RENDERABLE_INDEXES); - SetLength(fAnimTilesVtx, MAX_RENDERABLE_VERTICIES); - SetLength(fAnimTilesInd, MAX_RENDERABLE_INDEXES); - - fTilesVtxCount := 0; - fTilesIndCount := 0; - fTilesFowVtxCount := 0; - fTilesFowIndCount := 0; - fAnimTilesVtxCount := 0; - fAnimTilesIndCount := 0; - end; - - for V := Low(TKMVBOArrayType) to High(TKMVBOArrayType) do - fVBONeedsFlush[V] := True; + fGraphicsState := tgsNotReady; + fHaveGraphicsFacts := False; + fHaveReadyKey := False; + fHaveTileUV := False; + fHaveDerivedKey := False; + fMaxTilesRevision := 0; + fMaxGuiRevision := 0; + fTrustedGeneration := 0; end; destructor TKMRenderTerrain.Destroy; begin -// fUseVBO := VBOSupported; //Could have been set to False if 3D rendering is enabled, so reset it - if fUseVBO then - begin - //Since RenderTerrain is created fresh everytime fGame is created, we should clear - //the buffers to avoid memory leaks. - glDeleteBuffers(1, @fVtxTilesShd); - glDeleteBuffers(1, @fIndTilesShd); - glDeleteBuffers(1, @fVtxTilesLayersShd); - glDeleteBuffers(1, @fIndTilesLayersShd); - glDeleteBuffers(1, @fVtxAnimTilesShd); - glDeleteBuffers(1, @fIndAnimTilesShd); - glDeleteBuffers(1, @fVtxTilesFowShd); - glDeleteBuffers(1, @fIndTilesFowShd); - end; + RevokeTerrainReady; + if fHaveGraphicsFacts and fGraphicsFacts.ContextAvailable + and (fGpuGeneration <> 0) and (fGpuGeneration = fGraphicsFacts.Generation) + and TKMRender.TextureBackendReady then + ReleaseCurrentTerrainGpu(fGpuGeneration) + else + DiscardTerrainGpuAfterContextLoss; + FreeAndNil(fGraphics); inherited; end; -function TKMRenderTerrain.VBOSupported: Boolean; +procedure TKMRenderTerrain.RevokeTerrainReady; begin - //Some GPUs don't comply with OpenGL 1.5 spec on VBOs, so check Assigned instead of GL_VERSION_1_5 - Result := Assigned(glGenBuffers) and Assigned(glBindBuffer) and Assigned(glBufferData) and - Assigned(glEnableClientState) and Assigned(glVertexPointer) and Assigned(glClientActiveTexture) and - Assigned(glTexCoordPointer) and Assigned(glDrawElements) and Assigned(glDisableClientState) and - Assigned(glDeleteBuffers); + fHaveReadyKey := False; + fGraphicsState := tgsNotReady; end; -function TKMRenderTerrain.DoUseVBO: Boolean; +procedure TKMRenderTerrain.HandleTerrainPassFailure(aError: TObject; + const aKey: TKMTerrainBundleKey); +var + CurrentKey: TKMTerrainBundleKey; begin - Result := VBOSupported; + if not (aError is ETerrainOwnedGpuError) then Exit; + RevokeTerrainReady; + if not TerrainGpuContextCurrent then + begin + DiscardTerrainGpuAfterContextLoss; + Exit; + end; + if not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(aKey, CurrentKey) then Exit; + try + ReleaseCurrentTerrainGpu(aKey.Generation); + except + { Preserve the original upload/draw exception across partial cleanup. } + end; + if ExternalTerrainFactsValid(aKey.Generation) + and CurrentTerrainBundleKey(CurrentKey) + and SameTerrainBundleKey(aKey, CurrentKey) then + fGraphicsState := tgsFailure; +end; + + +function TKMRenderTerrain.SameTerrainBundleKey(const aLeft, aRight: TKMTerrainBundleKey): Boolean; +begin + Result := (aLeft.Generation = aRight.Generation) + and (aLeft.TilesRevision = aRight.TilesRevision) + and (aLeft.GuiRevision = aRight.GuiRevision); +end; + + +function TKMRenderTerrain.ExternalTerrainFactsValid(aGeneration: QWord): Boolean; +begin + Result := fHaveGraphicsFacts + and (aGeneration <> 0) + and (fGraphicsFacts.Generation = aGeneration) + and fGraphicsFacts.ContextAvailable + and TKMRender.TextureBackendReady + and fGraphicsFacts.Tiles.Published + and fGraphicsFacts.Gui.Published + and (fGraphicsFacts.Tiles.Generation = fGraphicsFacts.Generation) + and (fGraphicsFacts.Gui.Generation = fGraphicsFacts.Generation) + and (fGraphicsFacts.Tiles.Revision <> 0) + and (fGraphicsFacts.Gui.Revision <> 0) + and (fGraphicsFacts.Tiles.Revision = fMaxTilesRevision) + and (fGraphicsFacts.Gui.Revision = fMaxGuiRevision); +end; + + +function TKMRenderTerrain.CurrentTerrainBundleKey(out aKey: TKMTerrainBundleKey): Boolean; +begin + aKey.Generation := 0; + aKey.TilesRevision := 0; + aKey.GuiRevision := 0; + Result := fHaveGraphicsFacts and ExternalTerrainFactsValid(fGraphicsFacts.Generation); + if Result then + begin + aKey.Generation := fGraphicsFacts.Generation; + aKey.TilesRevision := fGraphicsFacts.Tiles.Revision; + aKey.GuiRevision := fGraphicsFacts.Gui.Revision; + end; +end; + + +procedure TKMRenderTerrain.InvalidateTerrainOwnedGpu(aContextAvailable: Boolean); +begin + RevokeTerrainReady; + if aContextAvailable and (fGpuGeneration <> 0) + and (fGpuGeneration = fGraphicsFacts.Generation) + and TKMRender.TextureBackendReady then + ReleaseCurrentTerrainGpu(fGpuGeneration) + else + DiscardTerrainGpuAfterContextLoss; +end; + + +procedure TKMRenderTerrain.DiscardTerrainGpuAfterContextLoss; +begin + RevokeTerrainReady; + if fGpuGeneration <> 0 then fDiscardedGpuGeneration := fGpuGeneration; + fGpuGeneration := 0; + fTextG := 0; + if fGraphics <> nil then + fGraphics.DiscardGpuWithoutGL; +end; + + +function TKMRenderTerrain.TerrainGpuContextCurrent: Boolean; +begin + Result := (fGpuGeneration <> 0) and fHaveGraphicsFacts + and fGraphicsFacts.ContextAvailable + and (fGraphicsFacts.Generation = fGpuGeneration) + and TKMRender.TextureBackendReady; +end; + + +procedure TKMRenderTerrain.ReleaseCurrentTerrainGpu(aGeneration: QWord); +var + FirstError: Exception; +begin + RevokeTerrainReady; + if (aGeneration = 0) or (fGpuGeneration <> aGeneration) + or not TerrainGpuContextCurrent then + begin + DiscardTerrainGpuAfterContextLoss; + Exit; + end; + FirstError := nil; + try + if fGraphics <> nil then fGraphics.ReleaseCurrentGpuObjects; + except + FirstError := Exception(AcquireExceptionObject); + end; + try + if TerrainGpuContextCurrent and (fTextG <> 0) then + begin + TKMRender.DeleteTexture(Cardinal(fTextG)); + fTextG := 0; + end; + except + if FirstError = nil then FirstError := Exception(AcquireExceptionObject); + end; + DiscardTerrainGpuAfterContextLoss; + if FirstError <> nil then raise FirstError; +end; + +procedure TKMRenderTerrain.InvalidateTerrainDerivedData; +begin + fHaveDerivedKey := False; + fHaveTileUV := False; + if fGraphics = nil then Exit; + if TerrainGpuContextCurrent then + fGraphics.AbortPass + else + fGraphics.DiscardPendingRunWithoutGL; +end; + + +function TKMRenderTerrain.TerrainOwnedGpuComplete(aGeneration: QWord): Boolean; +begin + Result := (aGeneration <> 0) + and (fGpuGeneration = aGeneration) + and fHaveGraphicsFacts and fGraphicsFacts.ContextAvailable + and (fGraphicsFacts.Generation = aGeneration) + and TKMRender.TextureBackendReady + and (fTextG <> 0) + and (fGraphics <> nil) + and fGraphics.GpuObjectsComplete; +end; + + +function TKMRenderTerrain.TerrainDerivedDataComplete(const aKey: TKMTerrainBundleKey): Boolean; +var + CurrentKey: TKMTerrainBundleKey; +begin + Result := fHaveTileUV and fHaveDerivedKey and (aKey.Generation <> 0) + and SameTerrainBundleKey(fDerivedKey, aKey) + and CurrentTerrainBundleKey(CurrentKey) + and SameTerrainBundleKey(CurrentKey, aKey); +end; + + +function TKMRenderTerrain.RehydrateTerrainOwnedGpuForGeneration(aGeneration: QWord): Boolean; +var + StartKey, CurrentKey: TKMTerrainBundleKey; + + function AttemptCurrent: Boolean; + begin + Result := TerrainGpuContextCurrent and CurrentTerrainBundleKey(CurrentKey) + and SameTerrainBundleKey(StartKey, CurrentKey); + end; + + procedure StopAttempt; + begin + RevokeTerrainReady; + if not TerrainGpuContextCurrent then DiscardTerrainGpuAfterContextLoss; + end; +begin + Result := False; + if not ExternalTerrainFactsValid(aGeneration) + or not CurrentTerrainBundleKey(StartKey) then Exit; + + if (fGpuGeneration <> 0) and (fGpuGeneration <> aGeneration) then + DiscardTerrainGpuAfterContextLoss; + if (fGpuGeneration = aGeneration) and TerrainOwnedGpuComplete(aGeneration) then + Exit(True); + if fGpuGeneration = aGeneration then ReleaseCurrentTerrainGpu(aGeneration); + + if (fDiscardedGpuGeneration <> 0) + and (fDiscardedGpuGeneration <> aGeneration) then + begin + { A trusted new Castle open generation follows the old shader close. } + fGraphics.ConfirmPreviousProgramClosed; + fDiscardedGpuGeneration := 0; + end; + fGpuGeneration := aGeneration; + try + fGraphics.CreateCurrentProgram; + fDiscardedGpuGeneration := 0; + if not AttemptCurrent then begin StopAttempt; Exit; end; + CreateCurrentTerrainGradient; + if not AttemptCurrent then begin StopAttempt; Exit; end; + fGraphics.CreateCurrentStreamStorage; + if not AttemptCurrent then begin StopAttempt; Exit; end; + Result := TerrainOwnedGpuComplete(aGeneration); + except + RevokeTerrainReady; + if TerrainGpuContextCurrent and not (ExceptObject is ETerrainForeignGLError) + and not (ExceptObject is ETerrainContextUnavailable) then + begin + try + ReleaseCurrentTerrainGpu(aGeneration); + except + { Preserve the original terrain GPU exception. } + end; + if ExternalTerrainFactsValid(aGeneration) + and CurrentTerrainBundleKey(CurrentKey) + and SameTerrainBundleKey(StartKey, CurrentKey) then + fGraphicsState := tgsFailure; + end + else if not TerrainGpuContextCurrent then + DiscardTerrainGpuAfterContextLoss; + raise; + end; +end; + +procedure TKMRenderTerrain.CreateCurrentTerrainGradient; +var + I: Integer; + pData: array [0..255] of Cardinal; + CandidateId: Cardinal; +begin + if fTextG <> 0 then Exit; + for I := 0 to 255 do + pData[I] := EnsureRange(Round(I * 1.0625 - 16), 0, 255) * 65793 or $FF000000; + + CandidateId := TKMRender.GenTexture(256, 1, @pData[0], tfRGBA8, ftNearest, ftNearest); + if CandidateId = 0 then + raise Exception.Create('Terrain gradient texture creation returned an invalid identity'); + fTextG := CandidateId; +end; + + +function TKMRenderTerrain.ReconcileTerrainDerivedForKey(const aKey: TKMTerrainBundleKey): Boolean; +var + CurrentKey: TKMTerrainBundleKey; + I, K: Integer; +begin + Result := False; + if not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(CurrentKey, aKey) + or not TerrainOwnedGpuComplete(aKey.Generation) then Exit; + + if TerrainDerivedDataComplete(aKey) then Exit(True); + + fHaveDerivedKey := False; + fHaveTileUV := False; + if TerrainGpuContextCurrent then + fGraphics.AbortPass + else + fGraphics.DiscardPendingRunWithoutGL; + if Length(gGFXData[rxTiles]) < TILES_CNT + 1 then Exit; + + try + for I := 0 to TILES_CNT - 1 do + for K := 0 to 3 do + fTileUVLookup[I, K] := GetTileUV(I, K); + except + fHaveTileUV := False; + Exit; + end; + + fHaveTileUV := True; + if not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(CurrentKey, aKey) + or not TerrainOwnedGpuComplete(aKey.Generation) then + begin + fHaveTileUV := False; + Exit; + end; + fDerivedKey := aKey; + fHaveDerivedKey := True; + Result := TerrainDerivedDataComplete(aKey); + if not Result then + begin + fHaveDerivedKey := False; + fHaveTileUV := False; + end; +end; + + +procedure TKMRenderTerrain.AcceptGraphicsPrerequisites(const aFacts: TKMTerrainGraphicsPrerequisites); +var + HadFacts, Changed, GenerationChanged, ContextChanged, AtlasChanged: Boolean; + TilesStale, GuiStale, NewTrustedGeneration, TrustedIncoming: Boolean; + Previous: TKMTerrainGraphicsPrerequisites; +begin + HadFacts := fHaveGraphicsFacts; + Previous := fGraphicsFacts; + Changed := not HadFacts + or (Previous.ContextAvailable <> aFacts.ContextAvailable) + or (Previous.Generation <> aFacts.Generation) + or (Previous.Tiles.Published <> aFacts.Tiles.Published) + or (Previous.Tiles.Generation <> aFacts.Tiles.Generation) + or (Previous.Tiles.Revision <> aFacts.Tiles.Revision) + or (Previous.Gui.Published <> aFacts.Gui.Published) + or (Previous.Gui.Generation <> aFacts.Gui.Generation) + or (Previous.Gui.Revision <> aFacts.Gui.Revision); + if not Changed then Exit; + + GenerationChanged := not HadFacts or (Previous.Generation <> aFacts.Generation); + ContextChanged := not HadFacts or (Previous.ContextAvailable <> aFacts.ContextAvailable); + AtlasChanged := not HadFacts + or (Previous.Generation <> aFacts.Generation) + or (Previous.Tiles.Published <> aFacts.Tiles.Published) + or (Previous.Tiles.Generation <> aFacts.Tiles.Generation) + or (Previous.Tiles.Revision <> aFacts.Tiles.Revision) + or (Previous.Gui.Published <> aFacts.Gui.Published) + or (Previous.Gui.Generation <> aFacts.Gui.Generation) + or (Previous.Gui.Revision <> aFacts.Gui.Revision); + + RevokeTerrainReady; + if aFacts.ContextAvailable and (aFacts.Generation <> 0) + and (fDiscardedGpuGeneration <> 0) + and (aFacts.Generation <> fDiscardedGpuGeneration) then + begin + { The trusted producer advances generation in Castle OnGLContextOpen, + after the preceding OnGLContextCloseObject shader handlers completed. } + fGraphics.ConfirmPreviousProgramClosed; + fDiscardedGpuGeneration := 0; + end; + TrustedIncoming := aFacts.ContextAvailable and (aFacts.Generation <> 0); + NewTrustedGeneration := TrustedIncoming and (fTrustedGeneration <> aFacts.Generation); + if NewTrustedGeneration then + begin + fMaxTilesRevision := 0; + fMaxGuiRevision := 0; + fTrustedGeneration := aFacts.Generation; + FillChar(fTrustedTiles, SizeOf(fTrustedTiles), 0); + FillChar(fTrustedGui, SizeOf(fTrustedGui), 0); + end; + + TilesStale := False; + GuiStale := False; + if TrustedIncoming then + begin + if aFacts.Tiles.Published then + TilesStale := (aFacts.Tiles.Revision < fMaxTilesRevision) + or ((aFacts.Tiles.Revision = fMaxTilesRevision) + and not (fTrustedTiles.Published + and (fTrustedTiles.Generation = aFacts.Tiles.Generation) + and (fTrustedTiles.Revision = aFacts.Tiles.Revision))); + if aFacts.Gui.Published then + GuiStale := (aFacts.Gui.Revision < fMaxGuiRevision) + or ((aFacts.Gui.Revision = fMaxGuiRevision) + and not (fTrustedGui.Published + and (fTrustedGui.Generation = aFacts.Gui.Generation) + and (fTrustedGui.Revision = aFacts.Gui.Revision))); + end; + + fGraphicsFacts := aFacts; + fHaveGraphicsFacts := True; + if TilesStale then + fGraphicsFacts.Tiles.Published := False + else if aFacts.ContextAvailable and (aFacts.Generation <> 0) + and aFacts.Tiles.Published and (aFacts.Tiles.Generation = aFacts.Generation) + and (aFacts.Tiles.Revision <> 0) then + if aFacts.Tiles.Revision > fMaxTilesRevision then + fMaxTilesRevision := aFacts.Tiles.Revision; + if GuiStale then + fGraphicsFacts.Gui.Published := False + else if aFacts.ContextAvailable and (aFacts.Generation <> 0) + and aFacts.Gui.Published and (aFacts.Gui.Generation = aFacts.Generation) + and (aFacts.Gui.Revision <> 0) then + if aFacts.Gui.Revision > fMaxGuiRevision then + fMaxGuiRevision := aFacts.Gui.Revision; + + if TrustedIncoming then + begin + fTrustedTiles := fGraphicsFacts.Tiles; + fTrustedGui := fGraphicsFacts.Gui; + end + else + begin + if not aFacts.Tiles.Published then fTrustedTiles.Published := False; + if not aFacts.Gui.Published then fTrustedGui.Published := False; + end; + + if AtlasChanged or ContextChanged or TilesStale or GuiStale then + InvalidateTerrainDerivedData; + if GenerationChanged or ContextChanged then + InvalidateTerrainOwnedGpu(aFacts.ContextAvailable); +end; + + +function TKMRenderTerrain.EvaluateTerrainGraphicsState(aGeneration: QWord): TKMTerrainGraphicsState; +var + CurrentKey: TKMTerrainBundleKey; +begin + if not ExternalTerrainFactsValid(aGeneration) then + begin + RevokeTerrainReady; + Exit(tgsNotReady); + end; + + if fGraphicsState = tgsFailure then + Exit(tgsFailure); + if fGraphicsState <> tgsReady then + Exit(tgsNotReady); + + if not CurrentTerrainBundleKey(CurrentKey) + or not fHaveReadyKey + or not SameTerrainBundleKey(fReadyKey, CurrentKey) + or not TerrainOwnedGpuComplete(aGeneration) + or not TerrainDerivedDataComplete(CurrentKey) then + begin + RevokeTerrainReady; + Exit(tgsNotReady); + end; + Result := tgsReady; +end; + + +function TKMRenderTerrain.TerrainDrawAllowed: Boolean; +begin + if fHaveGraphicsFacts then + Result := EvaluateTerrainGraphicsState(fGraphicsFacts.Generation) = tgsReady + else + Result := EvaluateTerrainGraphicsState(0) = tgsReady; + if not Result and fHaveGraphicsFacts and fGraphicsFacts.ContextAvailable + and (fGraphicsFacts.Generation = fTrustedGeneration) + and TKMRender.TextureBackendReady and (fGraphics <> nil) then + fGraphics.AbortPass; + if not Result and fGraphics <> nil + and (not fHaveGraphicsFacts or not fGraphicsFacts.ContextAvailable + or not TKMRender.TextureBackendReady) then + fGraphics.DiscardPendingRunWithoutGL; +end; + + +function TKMRenderTerrain.GraphicsCompletionForGeneration(aGeneration: QWord): TKMTerrainGraphicsState; +begin + Result := EvaluateTerrainGraphicsState(aGeneration); +end; + + +function TKMRenderTerrain.PrepareGraphicsBundleForGeneration(aGeneration: QWord): TKMTerrainGraphicsState; +var + StartKey, CurrentKey: TKMTerrainBundleKey; +begin + if not ExternalTerrainFactsValid(aGeneration) or not CurrentTerrainBundleKey(StartKey) then + Exit(tgsNotReady); + if (EvaluateTerrainGraphicsState(aGeneration) = tgsReady) + and fHaveReadyKey and SameTerrainBundleKey(fReadyKey, StartKey) then + Exit(tgsReady); + + RevokeTerrainReady; + try + if not RehydrateTerrainOwnedGpuForGeneration(aGeneration) then + Exit(tgsNotReady); + if not ReconcileTerrainDerivedForKey(StartKey) then + Exit(tgsNotReady); + if not ExternalTerrainFactsValid(aGeneration) + or not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(StartKey, CurrentKey) + or not TerrainOwnedGpuComplete(aGeneration) + or not TerrainDerivedDataComplete(StartKey) then + Exit(tgsNotReady); + except + RevokeTerrainReady; + if not (ExceptObject is ETerrainForeignGLError) + and not (ExceptObject is ETerrainContextUnavailable) + and ExternalTerrainFactsValid(aGeneration) + and CurrentTerrainBundleKey(CurrentKey) + and SameTerrainBundleKey(StartKey, CurrentKey) then + fGraphicsState := tgsFailure; + raise; + end; + + fReadyKey := StartKey; + fHaveReadyKey := True; + fGraphicsState := tgsReady; + Result := tgsReady; end; @@ -265,6 +676,8 @@ begin end; + + function TileHasToBeRendered(IsFirst: Boolean; aTX,aTY: Word; aFOW: TKMFogOfWarCommon): Boolean; inline; begin // We have to render at least 1 tile (otherwise smth wrong with gl contex and all UI and other sprites are not rendered at all @@ -273,509 +686,468 @@ begin end; -procedure TKMRenderTerrain.UpdateVBO(aAnimStep: Integer; aFOW: TKMFogOfWarCommon); -var - fog: PKMByte2Array; - - procedure SetTileVertexExt(out aVert: TKMTileVerticeExt; aTX, aTY: Word; - aIsBottomRow: Boolean; aUTile, aVTile: Single); inline; - begin - with gTerrain do - begin - aVert.X := aTX; - aVert.Y := aTY - LandExt^[aTY+1, aTX+1].RenderHeight / CELL_HEIGHT_DIV; - aVert.Z := aTY - Byte(aIsBottomRow); - aVert.UTile := aUTile; - aVert.VTile := aVTile; - aVert.ULit := LandExt[aTY+1, aTX+1].RenderLight; - aVert.UShd := -LandExt[aTY+1, aTX+1].RenderLight; - end; - end; - - procedure SetTileFowVertex(out aVert: TKMTileFowVertice; Fog: PKMByte2Array; aTX, aTY: Word; aIsBottomRow: Boolean); inline; - begin - aVert.X := aTX; - aVert.Y := aTY - gTerrain.LandExt^[aTY+1, aTX+1].RenderHeight / CELL_HEIGHT_DIV; - aVert.Z := aTY - Byte(aIsBottomRow); - if Fog <> nil then - aVert.UFow := Fog^[aTY, aTX] / 256 - else - aVert.UFow := 255; - end; - - procedure SetTileVertex(out aVert: TKMTileVertice; aTX, aTY: Word; aIsBottomRow: Boolean; aUAnimTile, aVAnimTile: Single); inline; - begin - with gTerrain do - begin - aVert.X := aTX; - aVert.Y := aTY - LandExt^[aTY+1, aTX+1].RenderHeight / CELL_HEIGHT_DIV; - aVert.Z := aTY - Byte(aIsBottomRow); - aVert.UAnim := aUAnimTile; - aVert.VAnim := aVAnimTile; - end; - end; - - function TryAddAnimTex(var aAnimCnt: Integer; aTX, aTY: Word; aAnimStep: Integer): Boolean; - - function SetAnimTileVertex(aTerrain: Word; aRotation: Byte): Boolean; - var - I: Integer; - texAnimC: TKMUVRect; - vtxOffset, indOffset: Integer; - tile: TKMTileParams; - begin - tile := gRes.Tileset[aTerrain]; - if not tile.HasAnim then Exit(False); - - Result := False; - - for I := Low(tile.Animation.Layers) to High(tile.Animation.Layers) do - begin - if not tile.Animation.Layers[I].HasAnim then Continue; - - texAnimC := GetTileUV(tile.Animation.Layers[I].GetAnim(aAnimStep), aRotation mod 4); - - vtxOffset := aAnimCnt * 4; - indOffset := aAnimCnt * 6; - - SetTileVertex(fAnimTilesVtx[vtxOffset], aTX-1, aTY-1, False, texAnimC[1][1], texAnimC[1][2]); - SetTileVertex(fAnimTilesVtx[vtxOffset+1], aTX-1, aTY, True, texAnimC[2][1], texAnimC[2][2]); - SetTileVertex(fAnimTilesVtx[vtxOffset+2], aTX, aTY, True, texAnimC[3][1], texAnimC[3][2]); - SetTileVertex(fAnimTilesVtx[vtxOffset+3], aTX, aTY-1, False, texAnimC[4][1], texAnimC[4][2]); - - fAnimTilesInd[indOffset+0] := vtxOffset; - fAnimTilesInd[indOffset+1] := vtxOffset + 1; - fAnimTilesInd[indOffset+2] := vtxOffset + 2; - fAnimTilesInd[indOffset+3] := vtxOffset; - fAnimTilesInd[indOffset+4] := vtxOffset + 3; - fAnimTilesInd[indOffset+5] := vtxOffset + 2; - - Inc(aAnimCnt); - Result := True; - end; - end; - - var - L: Integer; - begin - Result := SetAnimTileVertex(gTerrain.Land^[aTY,aTX].BaseLayer.Terrain, gTerrain.Land^[aTY,aTX].BaseLayer.Rotation); - for L := 0 to gTerrain.Land^[aTY,aTX].LayersCnt - 1 do - if not Result then - Result := SetAnimTileVertex(BASE_TERRAIN[gRes.Sprites.GetGenTerrainInfo(gTerrain.Land^[aTY,aTX].Layer[L].Terrain).TerKind], - gTerrain.Land^[aTY,aTX].Layer[L].Rotation) - else - Exit; - end; - -var - I, J, tilesCnt, fowCnt, animCnt, vtxOffset, indOffset: Integer; -// P,L,TilesLayersCnt: Integer; - sizeX, sizeY: Word; - tX, tY: Word; - texTileC: TKMUVRect; - V: TKMVBOArrayType; -begin - if not fUseVBO then Exit; - - //Skip updating VBOs if GameTick and ClipRect haven't changed - if not gGameParams.IsMapEditor - and (fClipRect = fVBOLastClipRect) - and (fVBOLastFOW = aFOW) - and (gGameParams.Tick = fVBOLastGameTick) then - Exit; - {$IFDEF DBG_PERFLOG} - gPerfLogs.SectionEnter(psFrameUpdateVBO); - {$ENDIF} - - fVBOLastClipRect := fClipRect; - fVBOLastGameTick := gGameParams.Tick; - fVBOLastFOW := aFOW; - - fLastBindVBOArrayType := vatNone; - - if aFOW is TKMFogOfWar then - fog := @TKMFogOfWar(aFOW).Revelation - else - fog := nil; - - sizeX := Max(fClipRect.Right - fClipRect.Left, 0); - sizeY := Max(fClipRect.Bottom - fClipRect.Top, 0); - - tilesCnt := 0; - fowCnt := 0; - animCnt := 0; -// P := 0; -// SetLength(fTilesLayersVtx, (SizeX + 1) * 4 * 3 * (SizeY + 1)); - - with gTerrain do - if (MapX > 0) and (MapY > 0) then - for I := 0 to sizeY do - for J := 0 to sizeX do - begin - tX := J + fClipRect.Left; - tY := I + fClipRect.Top; - - if TileHasToBeRendered(I*J = 0,tX,tY,aFow) then // Do not render tiles fully covered by FOW - begin - texTileC := fTileUVLookup[Land^[tY, tX].BaseLayer.Terrain, Land^[tY, tX].BaseLayer.Rotation mod 4]; - - vtxOffset := tilesCnt * 4; - indOffset := tilesCnt * 6; - - //Fill Tile vertices array - SetTileVertexExt(fTilesVtx[vtxOffset], tX-1, tY-1, False, texTileC[1][1], texTileC[1][2]); - SetTileVertexExt(fTilesVtx[vtxOffset+1], tX-1, tY, True, texTileC[2][1], texTileC[2][2]); - SetTileVertexExt(fTilesVtx[vtxOffset+2], tX, tY, True, texTileC[3][1], texTileC[3][2]); - SetTileVertexExt(fTilesVtx[vtxOffset+3], tX, tY-1, False, texTileC[4][1], texTileC[4][2]); - - // Set Tile terrain indices - fTilesInd[indOffset+0] := vtxOffset; - fTilesInd[indOffset+1] := vtxOffset + 1; - fTilesInd[indOffset+2] := vtxOffset + 2; - fTilesInd[indOffset+3] := vtxOffset; - fTilesInd[indOffset+4] := vtxOffset + 3; - fTilesInd[indOffset+5] := vtxOffset + 2; - - Inc(tilesCnt); - -// if Land^[tY, tX].LayersCnt > 0 then -// for L := 0 to Land^[tY, tX].LayersCnt - 1 do -// begin -// TexTileC := GetTileUV(Land[tY,tX].Layer[L].Terrain, Land^[TY,TX].Layer[L].Rotation mod 4); -// -// //Fill Tile vertices array -// SetTileVertex(fTilesLayersVtx, P, tX-1, tY-1, False, TexTileC[1][1], TexTileC[1][2]); -// SetTileVertex(fTilesLayersVtx, P+1, tX-1, tY, True, TexTileC[2][1], TexTileC[2][2]); -// SetTileVertex(fTilesLayersVtx, P+2, tX, tY, True, TexTileC[3][1], TexTileC[3][2]); -// SetTileVertex(fTilesLayersVtx, P+3, tX, tY-1, False, TexTileC[4][1], TexTileC[4][2]); -// P := P + 4; -// end; -// -// if gTerrain.Land^[tY, tX].LayersCnt > 0 then -// // Set Tile layers terrain indices -// for L := 0 to gTerrain.Land^[tY, tX].LayersCnt - 1 do -// begin -// fTilesLayersInd[P+0] := KP shl 2; // shl 2 = *4 -// fTilesLayersInd[P+1] := (KP shl 2) + 1; -// fTilesLayersInd[P+2] := (KP shl 2) + 2; -// fTilesLayersInd[P+3] := (KP shl 2); -// fTilesLayersInd[P+4] := (KP shl 2) + 3; -// fTilesLayersInd[P+5] := (KP shl 2) + 2; -// P := P + 6; -// Inc(KP); -// end; - end; - - vtxOffset := fowCnt * 4; - indOffset := fowCnt * 6; - - // Always set FOW - SetTileFowVertex(fTilesFowVtx[vtxOffset], fog, tX-1, tY-1, False); - SetTileFowVertex(fTilesFowVtx[vtxOffset+1], fog, tX-1, tY, True); - SetTileFowVertex(fTilesFowVtx[vtxOffset+2], fog, tX, tY, True); - SetTileFowVertex(fTilesFowVtx[vtxOffset+3], fog, tX, tY-1, False); - - // Set FOW indices - fTilesFowInd[indOffset+0] := vtxOffset; - fTilesFowInd[indOffset+1] := vtxOffset + 1; - fTilesFowInd[indOffset+2] := vtxOffset + 2; - fTilesFowInd[indOffset+3] := vtxOffset; - fTilesFowInd[indOffset+4] := vtxOffset + 3; - fTilesFowInd[indOffset+5] := vtxOffset + 2; - - Inc(fowCnt); - - // Render animation only if tile is not covered by FOW - if (aFOW.CheckVerticeRenderRev(tX,tY) > FOG_OF_WAR_ACT) then - //every tile can have only 1 animation - TryAddAnimTex(animCnt, tX, tY, aAnimStep); - end; - - //Update vertex/index counts - fTilesVtxCount := 4*tilesCnt; - fTilesIndCount := 6*tilesCnt; - - fTilesFowVtxCount := 4*fowCnt; - fTilesFowIndCount := 6*fowCnt; - - fAnimTilesVtxCount := 4*animCnt; - fAnimTilesIndCount := 6*animCnt; - -// SetLength(fTilesLayersVtx, P); -// TilesLayersCnt := P div 4; -// SetLength(fTileslayersInd, TilesLayersCnt*6); - - for V := Low(TKMVBOArrayType) to High(TKMVBOArrayType) do - fVBONeedsFlush[V] := True; - - {$IFDEF DBG_PERFLOG} - gPerfLogs.SectionLeave(psFrameUpdateVBO); - {$ENDIF} -end; - - -procedure TKMRenderTerrain.RenderQuadTexture(var TexC: TKMUVRect; tX,tY: Word); -begin - with gTerrain do - begin - glTexCoord2fv(@TexC[1]); glVertex3f(tX-1,tY-1-LandExt^[tY, tX].RenderHeight / CELL_HEIGHT_DIV, tY-1); - glTexCoord2fv(@TexC[2]); glVertex3f(tX-1,tY -LandExt^[tY+1,tX].RenderHeight / CELL_HEIGHT_DIV, tY-1); - glTexCoord2fv(@TexC[3]); glVertex3f(tX ,tY -LandExt^[tY+1,tX+1].RenderHeight / CELL_HEIGHT_DIV, tY-1); - glTexCoord2fv(@TexC[4]); glVertex3f(tX ,tY-1-LandExt^[tY, tX+1].RenderHeight / CELL_HEIGHT_DIV, tY-1); - end; -end; - - -procedure TKMRenderTerrain.RenderQuadTextureBlended(var TexC: TKMUVRect; tX,tY: Word; aCorners: TKMTileCorners; aBlendingLevel: Byte); -var - blendFactor: Single; -begin - blendFactor := 1 - Max(0, Min(1, aBlendingLevel / TERRAIN_MAX_BLENDING_LEVEL)); - with gTerrain do - begin - if aCorners[0] then - glColor4f(1,1,1,1) - else - glColor4f(1,1,1,blendFactor); - glTexCoord2fv(@TexC[1]); glVertex3f(tX-1,tY-1-LandExt^[tY, tX].RenderHeight / CELL_HEIGHT_DIV, tY-1); - - if aCorners[3] then - glColor4f(1,1,1,1) - else - glColor4f(1,1,1,blendFactor); - glTexCoord2fv(@TexC[2]); glVertex3f(tX-1,tY -LandExt^[tY+1,tX].RenderHeight / CELL_HEIGHT_DIV, tY-1); - - if aCorners[2] then - glColor4f(1,1,1,1) - else - glColor4f(1,1,1,blendFactor); - glTexCoord2fv(@TexC[3]); glVertex3f(tX ,tY -LandExt^[tY+1,tX+1].RenderHeight / CELL_HEIGHT_DIV, tY-1); - - if aCorners[1] then - glColor4f(1,1,1,1) - else - glColor4f(1,1,1,blendFactor); - glTexCoord2fv(@TexC[4]); glVertex3f(tX ,tY-1-LandExt^[tY, tX+1].RenderHeight / CELL_HEIGHT_DIV, tY-1); - glColor4f(1,1,1,1); - end; -end; - - procedure TKMRenderTerrain.DoTiles(aFOW: TKMFogOfWarCommon); var - I, K: Integer; - texC: TKMUVRect; + I, K, TileIndex, SpriteId, Corner: Integer; + TexCoords: TKMUVRect; + Quad: TTerrainMobileQuad; + TexId: Cardinal; sizeX, sizeY: Word; tX, tY: Word; + StartKey, CurrentKey: TKMTerrainBundleKey; + PassOpen: Boolean; begin - {$IFDEF DBG_PERFLOG} - gPerfLogs.SectionEnter(psFrameTiles); - {$ENDIF} - //First we render base layer, then we do animated layers for Water/Swamps/Waterfalls - //They all run at different speeds so we can't adjoin them in one layer - glColor4f(1,1,1,1); - //Draw with VBO only if all tiles are on the same texture - if fUseVBO and TKMResSprites.AllTilesOnOneAtlas then - begin - if fTilesVtxCount = 0 then Exit; //Nothing to render - BindVBOArray(vatTile); - //Bind to tiles texture. All tiles should be places in 1 atlas, - //so to get TexId we can use any of terrain tile Id (f.e. 1st) - TKMRender.BindTexture(gGFXData[rxTiles, 1].Tex.TexID); + if not TerrainDrawAllowed then Exit; + if (gTerrain.MapX <= 0) or (gTerrain.MapY <= 0) then Exit; + if not CurrentTerrainBundleKey(StartKey) then Exit; - //Setup vertex and UV layout and offsets - glEnableClientState(GL_VERTEX_ARRAY); - glVertexPointer(3, GL_FLOAT, SizeOf(TKMTileVerticeExt), Pointer(0)); - glClientActiveTexture(GL_TEXTURE0); - glEnableClientState(GL_TEXTURE_COORD_ARRAY); - glTexCoordPointer(2, GL_FLOAT, SizeOf(TKMTileVerticeExt), Pointer(12)); - - //Here and above OGL requests Pointer, but in fact it's just a number (offset within Array) - glDrawElements(GL_TRIANGLES, fTilesIndCount, GL_UNSIGNED_INT, Pointer(0)); - - glDisableClientState(GL_VERTEX_ARRAY); - glDisableClientState(GL_TEXTURE_COORD_ARRAY); - end - else - begin + PassOpen := False; + try + fGraphics.BeginPass(tmsAtlasUV, bsSrcAlpha, bdOneMinusSrcAlpha); + PassOpen := True; sizeX := Max(fClipRect.Right - fClipRect.Left, 0); sizeY := Max(fClipRect.Bottom - fClipRect.Top, 0); - with gTerrain do - for I := 0 to sizeY do - for K := 0 to sizeX do - begin - tX := K + fClipRect.Left; - tY := I + fClipRect.Top; - if TileHasToBeRendered(I*K = 0, tX, tY, aFow) then // Do not render tiles fully covered by FOW - begin - with Land^[tY,tX] do - begin - TKMRender.BindTexture(gGFXData[rxTiles, BaseLayer.Terrain+1].Tex.TexID); - glBegin(GL_TRIANGLE_FAN); - texC := fTileUVLookup[BaseLayer.Terrain, BaseLayer.Rotation mod 4]; - end; + for I := 0 to sizeY do + for K := 0 to sizeX do + begin + tX := K + fClipRect.Left; + tY := I + fClipRect.Top; + if not TileHasToBeRendered(I*K = 0, tX, tY, aFow) then Continue; - RenderQuadTexture(texC, tX, tY); - glEnd; - end; - end; + if not TerrainDrawAllowed + or not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(StartKey, CurrentKey) then + raise Exception.Create('Terrain graphics prerequisites changed during base tile pass'); + if not fHaveDerivedKey or not fHaveTileUV + or not SameTerrainBundleKey(fDerivedKey, StartKey) then + raise Exception.Create('Terrain tile UV data is not current for the active base tile pass'); + + TileIndex := gTerrain.Land^[tY,tX].BaseLayer.Terrain; + if (TileIndex < 0) or (TileIndex >= TILES_CNT) then + raise Exception.CreateFmt('Terrain tile index %d is outside the base UV table', [TileIndex]); + SpriteId := TileIndex + 1; + if (SpriteId < 1) or (SpriteId >= Length(gGFXData[rxTiles])) then + raise Exception.CreateFmt('Terrain sprite index %d is outside the current tiles atlas', [SpriteId]); + + TexCoords := fTileUVLookup[TileIndex, gTerrain.Land^[tY,tX].BaseLayer.Rotation mod 4]; + TexId := gGFXData[rxTiles, SpriteId].Tex.TexID; + if TexId = 0 then + raise Exception.CreateFmt('Terrain sprite %d has an invalid texture identity', [SpriteId]); + for Corner := 1 to 4 do + if IsNan(TexCoords[Corner,1]) or IsInfinite(TexCoords[Corner,1]) + or IsNan(TexCoords[Corner,2]) or IsInfinite(TexCoords[Corner,2]) then + raise Exception.CreateFmt('Terrain sprite %d has invalid UV coordinates', [SpriteId]); + + BuildCurrentBaseTileQuad(tX, tY, TexCoords, Quad); + fGraphics.SubmitQuad(TexId, Quad); + end; + + if not TerrainDrawAllowed + or not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(StartKey, CurrentKey) then + raise Exception.Create('Terrain graphics prerequisites changed before base tile pass completion'); + fGraphics.FinishPass; + PassOpen := False; + except + if PassOpen then + begin + try + if TerrainGpuContextCurrent then + fGraphics.AbortPass + else + fGraphics.DiscardPendingRunWithoutGL; + except + { Preserve the original base-tile preparation or draw error. } + end; + end; + HandleTerrainPassFailure(ExceptObject, StartKey); + raise; + end; +end; + + +procedure TKMRenderTerrain.BuildCurrentBaseTileQuad(tX, tY: Word; + const aTex: TKMUVRect; out aQuad: TTerrainMobileQuad); +var + HeightTL, HeightBL, HeightBR, HeightTR: Single; + I: Integer; +begin + HeightTL := gTerrain.LandExt^[tY, tX ].RenderHeight / CELL_HEIGHT_DIV; + HeightBL := gTerrain.LandExt^[tY+1, tX ].RenderHeight / CELL_HEIGHT_DIV; + HeightBR := gTerrain.LandExt^[tY+1, tX+1].RenderHeight / CELL_HEIGHT_DIV; + HeightTR := gTerrain.LandExt^[tY, tX+1].RenderHeight / CELL_HEIGHT_DIV; + if IsNan(HeightTL) or IsInfinite(HeightTL) + or IsNan(HeightBL) or IsInfinite(HeightBL) + or IsNan(HeightBR) or IsInfinite(HeightBR) + or IsNan(HeightTR) or IsInfinite(HeightTR) then + raise Exception.Create('Terrain base tile has invalid corner height data'); + + aQuad[0].X := tX-1; + aQuad[0].Y := tY-1-HeightTL; + aQuad[0].Z := tY-1; + aQuad[1].X := tX-1; + aQuad[1].Y := tY-HeightBL; + aQuad[1].Z := tY-1; + aQuad[2].X := tX; + aQuad[2].Y := tY-HeightBR; + aQuad[2].Z := tY-1; + aQuad[3].X := tX; + aQuad[3].Y := tY-1-HeightTR; + aQuad[3].Z := tY-1; + + for I := 0 to 3 do + begin + aQuad[I].U := aTex[I+1,1]; + aQuad[I].V := aTex[I+1,2]; + aQuad[I].Opacity := 1.0; + aQuad[I].GradientU := 0.0; end; - {$IFDEF DBG_PERFLOG} - gPerfLogs.SectionLeave(psFrameTiles); - {$ENDIF} end; procedure TKMRenderTerrain.DoTilesLayers(aFOW: TKMFogOfWarCommon); var - I, K, L: Integer; - texC: TKMUVRect; - sizeX, sizeY: Word; - tX, tY: Word; - terInfo: TKMGenTerrainInfo; -begin - {$IFDEF DBG_PERFLOG} - gPerfLogs.SectionEnter(psFrameTilesLayers); - {$ENDIF} - //First we render base layer, then we do animated layers for Water/Swamps/Waterfalls - //They all run at different speeds so we can't adjoin them in one layer - glColor4f(1,1,1,1); - //Draw with VBO only if all tiles are on the same texture + I, K, L, Corner, LayerTerrainId, SpriteId, GeneratedFirst, GeneratedLast: Integer; + TexC: TKMUVRect; + SizeX, SizeY, TX, TY: Integer; + TerrainInfo: TKMGenTerrainInfo; + Quad: TTerrainMobileQuad; + Corners: TKMTileCorners; + BlendLevel: Byte; + BlendFactor: Single; + HeightTL, HeightBL, HeightBR, HeightTR: Single; + TextureId: Cardinal; + StartKey, CurrentKey: TKMTerrainBundleKey; + PassOpen, HaveGeneratedBounds: Boolean; - //DONT USE VBO FOR LAYERS FOR NOW, SINCE WE CAN USE BLENDING HERE - if TILE_LAYERS_USE_VBO - and fUseVBO - and TKMResSprites.AllTilesOnOneAtlas then + procedure RequireGeneratedSource(aSourceId: Integer); + var + TK: TKMTerrainKind; + MK: TKMTileMaskKind; + MT: TKMTileMaskType; + MST: TKMTileMaskSubType; + TransitionId: Integer; begin - if Length(fTilesLayersVtx) = 0 then Exit; //Nothing to render - BindVBOArray(vatTileLayer); - //Bind to tiles texture. All tiles should be places in 1 atlas, - //so to get TexId we can use any of terrain tile Id (f.e. 1st) - TKMRender.BindTexture(gGFXData[rxTiles, 1].Tex.TexID); - - //Setup vertex and UV layout and offsets - glEnableClientState(GL_VERTEX_ARRAY); - glVertexPointer(3, GL_FLOAT, SizeOf(TKMTileVertice), Pointer(0)); - glClientActiveTexture(GL_TEXTURE0); - glEnableClientState(GL_TEXTURE_COORD_ARRAY); - glTexCoordPointer(2, GL_FLOAT, SizeOf(TKMTileVertice), Pointer(12)); - - //Here and above OGL requests Pointer, but in fact it's just a number (offset within Array) - glDrawElements(GL_TRIANGLES, Length(fTilesLayersInd), GL_UNSIGNED_INT, Pointer(0)); - - glDisableClientState(GL_VERTEX_ARRAY); - glDisableClientState(GL_TEXTURE_COORD_ARRAY); - end - else - begin - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - sizeX := Max(fClipRect.Right - fClipRect.Left, 0); - sizeY := Max(fClipRect.Bottom - fClipRect.Top, 0); - with gTerrain do - for I := 0 to sizeY do - for K := 0 to sizeX do - begin - tX := K + fClipRect.Left; - tY := I + fClipRect.Top; - if TileHasToBeRendered(I*K = 0,tX,tY,aFow) then // Do not render tiles fully covered by FOW - for L := 0 to Land^[tY,tX].LayersCnt - 1 do + if not HaveGeneratedBounds then + begin + GeneratedFirst := MaxInt; + GeneratedLast := -1; + for TK := Succ(tkCustom) to High(TKMTerrainKind) do + for MK := Succ(mkNone) to High(TKMTileMaskKind) do + for MT := Succ(tmtNone) to High(TKMTileMaskType) do + for MST := Low(TKMTileMaskSubType) to High(TKMTileMaskSubType) do begin - with Land^[tY,tX] do - begin - TKMRender.BindTexture(gGFXData[rxTiles, Layer[L].Terrain+1].Tex.TexID); - glBegin(GL_TRIANGLE_FAN); - texC := GetTileUV(Layer[L].Terrain, Layer[L].Rotation); - terInfo := gRes.Sprites.GetGenTerrainInfo(Layer[L].Terrain); - - if terInfo.TerKind = tkCustom then - Exit; - - if BlendingLvl > 0 then - RenderQuadTextureBlended(texC, tX, tY, Layer[L].GetCorners, BlendingLvl) - else - RenderQuadTexture(texC, tX, tY); - glEnd; - end; + TransitionId := gRes.Sprites.GenTerrainTransitions[TK, MK, MT, MST]; + if TransitionId = 0 then Continue; + GeneratedFirst := Min(GeneratedFirst, TransitionId); + GeneratedLast := Max(GeneratedLast, TransitionId); end; - end; - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); //Just in case... + HaveGeneratedBounds := True; + end; + if (aSourceId < GeneratedFirst) or (aSourceId > GeneratedLast) then + raise Exception.CreateFmt('Static terrain layer source %d is outside the generated-info range', [aSourceId]); end; - {$IFDEF DBG_PERFLOG} - gPerfLogs.SectionLeave(psFrameTilesLayers); - {$ENDIF} + +begin + if not TerrainDrawAllowed then Exit; + if (gTerrain.MapX <= 0) or (gTerrain.MapY <= 0) then Exit; + if not CurrentTerrainBundleKey(StartKey) then Exit; + + HaveGeneratedBounds := False; + PassOpen := False; + try + fGraphics.BeginPass(tmsAtlasUV, bsSrcAlpha, bdOneMinusSrcAlpha); + PassOpen := True; + SizeX := Max(fClipRect.Right - fClipRect.Left, 0); + SizeY := Max(fClipRect.Bottom - fClipRect.Top, 0); + for I := 0 to SizeY do + for K := 0 to SizeX do + begin + TX := fClipRect.Left + K; + TY := fClipRect.Top + I; + if not TileHasToBeRendered(I*K = 0, TX, TY, aFOW) then Continue; + + if (Integer(gTerrain.Land^[TY,TX].LayersCnt) < 0) + or (Integer(gTerrain.Land^[TY,TX].LayersCnt) > Length(gTerrain.Land^[TY,TX].Layer)) then + raise Exception.CreateFmt('Static terrain layer count %d is invalid', + [gTerrain.Land^[TY,TX].LayersCnt]); + + for L := 0 to Integer(gTerrain.Land^[TY,TX].LayersCnt) - 1 do + begin + if not TerrainDrawAllowed + or not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(StartKey, CurrentKey) then + raise Exception.Create('Terrain graphics prerequisites changed during static layer pass'); + + LayerTerrainId := gTerrain.Land^[TY,TX].Layer[L].Terrain; + RequireGeneratedSource(LayerTerrainId); + TerrainInfo := gRes.Sprites.GetGenTerrainInfo(LayerTerrainId); + if (Ord(TerrainInfo.TerKind) < Ord(Low(TKMTerrainKind))) + or (Ord(TerrainInfo.TerKind) > Ord(High(TKMTerrainKind))) then + raise Exception.CreateFmt('Static terrain layer source %d has an invalid terrain kind', [LayerTerrainId]); + if TerrainInfo.TerKind = tkCustom then Continue; + + SpriteId := LayerTerrainId + 1; + if not TerrainDrawAllowed + or not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(StartKey, CurrentKey) then + raise Exception.Create('Terrain graphics prerequisites changed before static layer atlas selection'); + if (SpriteId < 1) or (SpriteId >= Length(gGFXData[rxTiles])) then + raise Exception.CreateFmt('Static terrain layer source %d is outside the current tiles atlas', [LayerTerrainId]); + TextureId := gGFXData[rxTiles, SpriteId].Tex.TexID; + if TextureId = 0 then + raise Exception.CreateFmt('Static terrain layer source %d has an invalid texture identity', [LayerTerrainId]); + + TexC := GetTileUV(LayerTerrainId, gTerrain.Land^[TY,TX].Layer[L].Rotation mod 4); + for Corner := 1 to 4 do + if IsNan(TexC[Corner,1]) or IsInfinite(TexC[Corner,1]) + or IsNan(TexC[Corner,2]) or IsInfinite(TexC[Corner,2]) then + raise Exception.CreateFmt('Static terrain layer source %d has invalid UV coordinates', [LayerTerrainId]); + + HeightTL := gTerrain.LandExt^[TY, TX ].RenderHeight / CELL_HEIGHT_DIV; + HeightBL := gTerrain.LandExt^[TY+1, TX ].RenderHeight / CELL_HEIGHT_DIV; + HeightBR := gTerrain.LandExt^[TY+1, TX+1].RenderHeight / CELL_HEIGHT_DIV; + HeightTR := gTerrain.LandExt^[TY, TX+1].RenderHeight / CELL_HEIGHT_DIV; + if IsNan(HeightTL) or IsInfinite(HeightTL) + or IsNan(HeightBL) or IsInfinite(HeightBL) + or IsNan(HeightBR) or IsInfinite(HeightBR) + or IsNan(HeightTR) or IsInfinite(HeightTR) then + raise Exception.Create('Static terrain layer has invalid corner height data'); + + Quad[0].X := TX-1; + Quad[0].Y := TY-1-HeightTL; + Quad[0].Z := TY-1; + Quad[1].X := TX-1; + Quad[1].Y := TY-HeightBL; + Quad[1].Z := TY-1; + Quad[2].X := TX; + Quad[2].Y := TY-HeightBR; + Quad[2].Z := TY-1; + Quad[3].X := TX; + Quad[3].Y := TY-1-HeightTR; + Quad[3].Z := TY-1; + + BlendLevel := gTerrain.Land^[TY,TX].BlendingLvl; + Corners := gTerrain.Land^[TY,TX].Layer[L].GetCorners; + if BlendLevel = 0 then + BlendFactor := 1.0 + else + BlendFactor := 1.0 - Max(0.0, Min(1.0, + BlendLevel / TERRAIN_MAX_BLENDING_LEVEL)); + if (BlendLevel = 0) or Corners[0] then Quad[0].Opacity := 1.0 + else Quad[0].Opacity := BlendFactor; + if (BlendLevel = 0) or Corners[3] then Quad[1].Opacity := 1.0 + else Quad[1].Opacity := BlendFactor; + if (BlendLevel = 0) or Corners[2] then Quad[2].Opacity := 1.0 + else Quad[2].Opacity := BlendFactor; + if (BlendLevel = 0) or Corners[1] then Quad[3].Opacity := 1.0 + else Quad[3].Opacity := BlendFactor; + for Corner := 0 to 3 do + begin + Quad[Corner].U := TexC[Corner+1,1]; + Quad[Corner].V := TexC[Corner+1,2]; + Quad[Corner].GradientU := 0.0; + end; + + if not TerrainDrawAllowed + or not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(StartKey, CurrentKey) then + raise Exception.Create('Terrain graphics prerequisites changed before static layer submission'); + fGraphics.SubmitQuad(TextureId, Quad); + end; + end; + + if not TerrainDrawAllowed + or not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(StartKey, CurrentKey) then + raise Exception.Create('Terrain graphics prerequisites changed before static layer pass completion'); + fGraphics.FinishPass; + PassOpen := False; + except + if PassOpen then + begin + try + if TerrainGpuContextCurrent then + fGraphics.AbortPass + else + fGraphics.DiscardPendingRunWithoutGL; + except + { Preserve the original static layer preparation or draw error. } + end; + end; + HandleTerrainPassFailure(ExceptObject, StartKey); + raise; + end; end; procedure TKMRenderTerrain.DoAnimations(aAnimStep: Integer; aFOW: TKMFogOfWarCommon); var - I, J, K: Integer; - texC: TKMUVRect; - animID: Word; - tile: TKMTileParams; + I, K, L, SourceId, SpriteId, Corner: Integer; + AnimID: Word; + TexC: TKMUVRect; + Tile: TKMTileParams; + TerrainInfo: TKMGenTerrainInfo; + Quad: TTerrainMobileQuad; + TexId: Cardinal; + StartKey, CurrentKey: TKMTerrainBundleKey; + PassOpen, HaveGeneratedBounds: Boolean; + GeneratedFirst, GeneratedLast: Integer; + + procedure RequireGeneratedSource(aSourceId: Integer); + var + TK: TKMTerrainKind; + MK: TKMTileMaskKind; + MT: TKMTileMaskType; + MST: TKMTileMaskSubType; + Id: Integer; + begin + if not HaveGeneratedBounds then + begin + GeneratedFirst := MaxInt; + GeneratedLast := -1; + { The producer appends a contiguous generated range; its public transition + table exposes that range without accessing private producer indices. } + for TK := Succ(tkCustom) to High(TKMTerrainKind) do + for MK := Succ(mkNone) to High(TKMTileMaskKind) do + for MT := Succ(tmtNone) to High(TKMTileMaskType) do + for MST := Low(TKMTileMaskSubType) to High(TKMTileMaskSubType) do + begin + Id := gRes.Sprites.GenTerrainTransitions[TK, MK, MT, MST]; + if Id = 0 then Continue; + GeneratedFirst := Min(GeneratedFirst, Id); + GeneratedLast := Max(GeneratedLast, Id); + end; + HaveGeneratedBounds := True; + end; + if (aSourceId < GeneratedFirst) or (aSourceId > GeneratedLast) then + raise Exception.CreateFmt('Terrain source %d is outside the generated-info range', [aSourceId]); + end; + + procedure SubmitSourceAnimations(aSourceId: Word; aSourceRotation: Byte); + var + AnimLayer, AnimCount, FrameIndex: Integer; + begin + if Integer(aSourceId) >= TILES_CNT then + raise Exception.CreateFmt('Terrain animation source %d is outside the tileset', [aSourceId]); + + Tile := gRes.Tileset[aSourceId]; + if Tile = nil then + raise Exception.Create('Terrain animation source record is missing'); + if Length(Tile.Animation.Layers) > High(Byte) then + raise Exception.Create('Terrain animation layer count exceeds the source contract'); + if not Tile.HasAnim then Exit; + + for AnimLayer := Low(Tile.Animation.Layers) to High(Tile.Animation.Layers) do + begin + if not Tile.Animation.Layers[AnimLayer].HasAnim then Continue; + + if not TerrainDrawAllowed + or not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(StartKey, CurrentKey) then + raise Exception.Create('Terrain graphics prerequisites changed during animation pass'); + + AnimCount := Length(Tile.Animation.Layers[AnimLayer].Anims); + if (Tile.Animation.Layers[AnimLayer].Frames = 0) + or (AnimCount > High(Byte)) then + raise Exception.Create('Terrain animation has invalid frame timing or count'); + FrameIndex := (aAnimStep div Tile.Animation.Layers[AnimLayer].Frames) mod AnimCount; + if (FrameIndex < 0) or (FrameIndex >= AnimCount) then + raise Exception.Create('Terrain animation step selects an invalid frame index'); + AnimID := Tile.Animation.Layers[AnimLayer].GetAnim(aAnimStep); + SpriteId := Integer(AnimID) + 1; + if (SpriteId < 1) or (SpriteId >= Length(gGFXData[rxTiles])) then + raise Exception.CreateFmt('Terrain animation frame %d is outside the current tiles atlas', [AnimID]); + + TexId := gGFXData[rxTiles, SpriteId].Tex.TexID; + if TexId = 0 then + raise Exception.CreateFmt('Terrain animation frame %d has an invalid texture identity', [AnimID]); + TexC := GetTileUV(AnimID, aSourceRotation mod 4); + for Corner := 1 to 4 do + if IsNan(TexC[Corner,1]) or IsInfinite(TexC[Corner,1]) + or IsNan(TexC[Corner,2]) or IsInfinite(TexC[Corner,2]) then + raise Exception.CreateFmt('Terrain animation frame %d has invalid UV coordinates', [AnimID]); + + BuildCurrentBaseTileQuad(K, I, TexC, Quad); + if not TerrainDrawAllowed + or not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(StartKey, CurrentKey) then + raise Exception.Create('Terrain graphics prerequisites changed before animation submission'); + fGraphics.SubmitQuad(TexId, Quad); + end; + end; + begin - {$IFDEF DBG_PERFLOG} - gPerfLogs.SectionEnter(psFrameWater); - {$ENDIF} + if not TerrainDrawAllowed then Exit; + if (gTerrain.MapX <= 0) or (gTerrain.MapY <= 0) then Exit; + if not CurrentTerrainBundleKey(StartKey) then Exit; - //First we render base layer, then we do animated layers for Water/Swamps/Waterfalls - //They all run at different speeds so we can't adjoin them in one layer - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - - if fUseVBO and TKMResSprites.AllTilesOnOneAtlas then - begin - if fAnimTilesVtxCount = 0 then Exit; //There is no animation on map - BindVBOArray(vatAnimTile); - //Bind to tiles texture. All tiles should be placed in 1 atlas, - //so to get TexId we can use any of terrain tile Id (f.e. 1st) - TKMRender.BindTexture(gGFXData[rxTiles, 1].Tex.TexID); - - //Setup vertex and UV layout and offsets - glEnableClientState(GL_VERTEX_ARRAY); - glVertexPointer(3, GL_FLOAT, SizeOf(TKMTileVertice), Pointer(0)); - glClientActiveTexture(GL_TEXTURE0); - glEnableClientState(GL_TEXTURE_COORD_ARRAY); - glTexCoordPointer(2, GL_FLOAT, SizeOf(TKMTileVertice), Pointer(12)); - - //Here and above OGL requests Pointer, but in fact it's just a number (offset within Array) - glDrawElements(GL_TRIANGLES, fAnimTilesIndCount, GL_UNSIGNED_INT, Pointer(0)); - - glDisableClientState(GL_VERTEX_ARRAY); - glDisableClientState(GL_TEXTURE_COORD_ARRAY); - end - else - begin - with gTerrain do + HaveGeneratedBounds := False; + PassOpen := False; + try + fGraphics.BeginPass(tmsAtlasUV, bsSrcAlpha, bdOneMinusSrcAlpha); + PassOpen := True; for I := fClipRect.Top to fClipRect.Bottom do for K := fClipRect.Left to fClipRect.Right do begin - tile := gRes.Tileset[Land^[I,K].BaseLayer.Terrain]; - if tile.HasAnim - and (aFOW.CheckVerticeRenderRev(K,I) > FOG_OF_WAR_ACT) then //No animation in FOW + if not TerrainDrawAllowed + or not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(StartKey, CurrentKey) then + raise Exception.Create('Terrain graphics prerequisites changed during animation pass'); + + if aFOW.CheckVerticeRenderRev(K,I) <= FOG_OF_WAR_ACT then Continue; + + SourceId := gTerrain.Land^[I,K].BaseLayer.Terrain; + SubmitSourceAnimations(SourceId, gTerrain.Land^[I,K].BaseLayer.Rotation); + + if (Integer(gTerrain.Land^[I,K].LayersCnt) < 0) + or (Integer(gTerrain.Land^[I,K].LayersCnt) > Length(gTerrain.Land^[I,K].Layer)) then + raise Exception.CreateFmt('Terrain animation layer count %d is invalid', + [gTerrain.Land^[I,K].LayersCnt]); + for L := 0 to Integer(gTerrain.Land^[I,K].LayersCnt) - 1 do begin - for J := Low(tile.Animation.Layers) to High(tile.Animation.Layers) do - begin - if not tile.Animation.Layers[J].HasAnim then Continue; - - animID := tile.Animation.Layers[J].GetAnim(aAnimStep); - TKMRender.BindTexture(gGFXData[rxTiles, animID + 1].Tex.TexID); - texC := GetTileUV(animID, Land^[I,K].BaseLayer.Rotation); - - glBegin(GL_TRIANGLE_FAN); - glColor4f(1,1,1,1); - RenderQuadTexture(texC, K, I); - glEnd; - end; + SourceId := gTerrain.Land^[I,K].Layer[L].Terrain; + if (SourceId < TILES_CNT) or (SourceId + 1 >= Length(gGFXData[rxTiles])) then + raise Exception.CreateFmt('Generated terrain source %d is outside the current tiles atlas', [SourceId]); + RequireGeneratedSource(SourceId); + TerrainInfo := gRes.Sprites.GetGenTerrainInfo(SourceId); + if (Ord(TerrainInfo.TerKind) < Ord(Low(TKMTerrainKind))) + or (Ord(TerrainInfo.TerKind) > Ord(High(TKMTerrainKind))) then + raise Exception.CreateFmt('Generated terrain source %d has an invalid terrain kind', [SourceId]); + SourceId := BASE_TERRAIN[TerrainInfo.TerKind]; + if (SourceId < 0) or (SourceId >= TILES_CNT) then + raise Exception.CreateFmt('Generated terrain source %d maps to invalid tileset source %d', + [gTerrain.Land^[I,K].Layer[L].Terrain, SourceId]); + SubmitSourceAnimations(SourceId, gTerrain.Land^[I,K].Layer[L].Rotation); end; end; - end; - {$IFDEF DBG_PERFLOG} - gPerfLogs.SectionLeave(psFrameWater); - {$ENDIF} + + if not TerrainDrawAllowed + or not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(StartKey, CurrentKey) then + raise Exception.Create('Terrain graphics prerequisites changed before animation pass completion'); + fGraphics.FinishPass; + PassOpen := False; + except + if PassOpen then + begin + try + if TerrainGpuContextCurrent then + fGraphics.AbortPass + else + fGraphics.DiscardPendingRunWithoutGL; + except + { Preserve the original animation preparation or draw error. } + end; + end; + HandleTerrainPassFailure(ExceptObject, StartKey); + raise; + end; end; //Render single tile overlay -procedure TKMRenderTerrain.RenderTileOverlay(pX, pY: Integer; DoHighlight: Boolean = False; HighlightColor: Cardinal = 0); +procedure TKMRenderTerrain.RenderTileOverlay(pX, pY: Integer); // 1 //Select road tile and rotation // 8*2 //depending on surrounding tiles // 4 //Bitfield @@ -787,68 +1159,155 @@ const (250,1), (252,2), (252,1), (254,0)); var road, ID, rot: Byte; + overlay: TKMTileOverlay; begin - //Fake tiles for MapEd fields - if gGame.MapEditor <> nil then - case gGame.MapEditor.LandMapEd^[pY, pX].CornOrWine of - 1: RenderTile(gGame.MapEditor.LandMapEd^[pY, pX].CornOrWineTerrain, pX, pY, 0, DoHighlight, HighlightColor); // Corn - 2: RenderTile(WINE_TERRAIN_ID, pX, pY, 0, DoHighlight, HighlightColor); //Wine - end; + if not gTerrain.TileInMapCoords(pX,pY) then Exit; + overlay := gTerrain.Land^[pY, pX].TileOverlay; + case overlay of + toNone: Exit; + toRoad: + begin + road := 0; + if (pY - 1 >= 1) then + road := road + Byte(gTerrain.Land^[pY - 1, pX].TileOverlay = toRoad) shl 0; + if (pX + 1 <= gTerrain.MapX - 1) then + road := road + Byte(gTerrain.Land^[pY, pX + 1].TileOverlay = toRoad) shl 1; + if (pY + 1 <= gTerrain.MapY - 1) then + road := road + Byte(gTerrain.Land^[pY + 1, pX].TileOverlay = toRoad) shl 2; + if (pX - 1 >= 1) then + road := road + Byte(gTerrain.Land^[pY, pX - 1].TileOverlay = toRoad) shl 3; + ID := RoadsConnectivity[road, 1]; + rot := RoadsConnectivity[road, 2]; + SubmitOverlayTile(ID, pX, pY, rot); + end; + toDig1, toDig2, toDig3, toDig4: + SubmitOverlayTile(TILE_OVERLAY_IDS[overlay], pX, pY, 0); + end; +end; - if gTerrain.Land^[pY, pX].TileOverlay = toRoad then - begin - road := 0; - if (pY - 1 >= 1) then - road := road + Byte(gTerrain.Land^[pY - 1, pX].TileOverlay = toRoad) shl 0; - if (pX + 1 <= gTerrain.MapX - 1) then - road := road + Byte(gTerrain.Land^[pY, pX + 1].TileOverlay = toRoad) shl 1; - if (pY + 1 <= gTerrain.MapY - 1) then - road := road + Byte(gTerrain.Land^[pY + 1, pX].TileOverlay = toRoad) shl 2; - if (pX - 1 >= 1) then - road := road + Byte(gTerrain.Land^[pY, pX - 1].TileOverlay = toRoad) shl 3; - ID := RoadsConnectivity[road, 1]; - rot := RoadsConnectivity[road, 2]; - RenderTile(ID, pX, pY, rot, DoHighlight, HighlightColor); - end - else if gTerrain.Land^[pY, pX].TileOverlay <> toNone then - RenderTile(TILE_OVERLAY_IDS[gTerrain.Land^[pY, pX].TileOverlay], pX, pY, 0, DoHighlight, HighlightColor); + +procedure TKMRenderTerrain.SubmitOverlayTile(aTileID: Word; pX,pY,Rot: Integer); +var + SpriteId, Rotation, Corner: Integer; + TexId: Cardinal; + TexCoords: TKMUVRect; + Quad: TTerrainMobileQuad; + CurrentKey: TKMTerrainBundleKey; +begin + if not gTerrain.TileInMapCoords(pX,pY) then Exit; + if not TerrainDrawAllowed + or not CurrentTerrainBundleKey(CurrentKey) + or not fHaveReadyKey + or not SameTerrainBundleKey(fReadyKey, CurrentKey) + or not TerrainDerivedDataComplete(CurrentKey) then + raise Exception.Create('Terrain overlay graphics prerequisites are not current'); + if aTileID >= TILES_CNT then + raise Exception.CreateFmt('Terrain overlay tile index %d is outside the base UV table', [aTileID]); + + Rotation := Rot mod 4; + SpriteId := Integer(aTileID) + 1; + if (SpriteId < 1) or (SpriteId >= Length(gGFXData[rxTiles])) then + raise Exception.CreateFmt('Terrain overlay sprite index %d is outside the current tiles atlas', [SpriteId]); + TexId := gGFXData[rxTiles, SpriteId].Tex.TexID; + if TexId = 0 then + raise Exception.CreateFmt('Terrain overlay sprite %d has an invalid texture identity', [SpriteId]); + + TexCoords := fTileUVLookup[aTileID, Rotation]; + for Corner := 1 to 4 do + if IsNan(TexCoords[Corner,1]) or IsInfinite(TexCoords[Corner,1]) + or IsNan(TexCoords[Corner,2]) or IsInfinite(TexCoords[Corner,2]) then + raise Exception.CreateFmt('Terrain overlay sprite %d has invalid UV coordinates', [SpriteId]); + BuildCurrentBaseTileQuad(pX, pY, TexCoords, Quad); + if not TerrainDrawAllowed + or not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(fReadyKey, CurrentKey) then + raise Exception.Create('Terrain graphics prerequisites changed before overlay submission'); + fGraphics.SubmitQuad(TexId, Quad); end; procedure TKMRenderTerrain.DoOverlays(aFOW: TKMFogOfWarCommon); var I, K: Integer; + StartKey, CurrentKey: TKMTerrainBundleKey; + PassOpen: Boolean; begin - {$IFDEF DBG_PERFLOG} - gPerfLogs.SectionEnter(psFrameOverlays); - {$ENDIF} - if not (mlOverlays in gGameParams.VisibleLayers) then - Exit; + if not (mlOverlays in gGameParams.VisibleLayers) then Exit; + if not TerrainDrawAllowed + or not CurrentTerrainBundleKey(StartKey) + or not fHaveReadyKey + or not SameTerrainBundleKey(fReadyKey, StartKey) + or not TerrainDerivedDataComplete(StartKey) then Exit; - for I := fClipRect.Top to fClipRect.Bottom do - for K := fClipRect.Left to fClipRect.Right do - if TileHasToBeRendered(False,K,I,aFow) then - RenderTileOverlay(K, I); + PassOpen := False; + try + fGraphics.BeginPass(tmsAtlasUV, bsSrcAlpha, bdOneMinusSrcAlpha); + PassOpen := True; + for I := fClipRect.Top to fClipRect.Bottom do + for K := fClipRect.Left to fClipRect.Right do + begin + if not TerrainDrawAllowed + or not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(StartKey, CurrentKey) + or not TerrainDerivedDataComplete(StartKey) then + raise Exception.Create('Terrain graphics prerequisites changed during overlay pass'); + if not TileHasToBeRendered(False, K, I, aFow) then Continue; + RenderTileOverlay(K, I); + end; - {$IFDEF DBG_PERFLOG} - gPerfLogs.SectionLeave(psFrameOverlays); - {$ENDIF} + if not TerrainDrawAllowed + or not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(StartKey, CurrentKey) + or not TerrainDerivedDataComplete(StartKey) then + raise Exception.Create('Terrain graphics prerequisites changed before overlay pass completion'); + fGraphics.FinishPass; + PassOpen := False; + except + if PassOpen then + begin + try + if TerrainGpuContextCurrent then + fGraphics.AbortPass + else + fGraphics.DiscardPendingRunWithoutGL; + except + { Preserve the original overlay preparation or draw error. } + end; + end; + HandleTerrainPassFailure(ExceptObject, StartKey); + raise; + end; end; procedure TKMRenderTerrain.RenderFences(aFOW: TKMFogOfWarCommon); var I, K: Integer; + StartKey, CurrentKey: TKMTerrainBundleKey; + PassOpen: Boolean; begin - if gGameParams.IsMapEditor and not (mlOverlays in gGameParams.VisibleLayers) then - Exit; + if not TerrainDrawAllowed then Exit; + if not CurrentTerrainBundleKey(StartKey) + or not fHaveReadyKey + or not SameTerrainBundleKey(fReadyKey, StartKey) + or not TerrainDerivedDataComplete(StartKey) then Exit; - with gTerrain do - for I := fClipRect.Top to fClipRect.Bottom do - for K := fClipRect.Left to fClipRect.Right do - begin - if TileHasToBeRendered(False,K,I,aFow) then + PassOpen := False; + try + fGraphics.BeginPass(tmsAtlasUV, bsSrcAlpha, bdOneMinusSrcAlpha); + PassOpen := True; + with gTerrain do + for I := fClipRect.Top to fClipRect.Bottom do + for K := fClipRect.Left to fClipRect.Right do begin + if not TerrainDrawAllowed + or not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(StartKey, CurrentKey) + or not TerrainDerivedDataComplete(StartKey) then + raise Exception.Create('Terrain graphics prerequisites changed during fence pass'); + + if not TileHasToBeRendered(False,K,I,aFow) then Continue; + if Fences[I,K].Side and 1 = 1 then RenderFence(Fences[I,K].Kind, dirN, K, I); if Fences[I,K].Side and 2 = 2 then @@ -858,7 +1317,28 @@ begin if Fences[I,K].Side and 8 = 8 then RenderFence(Fences[I,K].Kind, dirS, K, I); end; + if not TerrainDrawAllowed + or not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(StartKey, CurrentKey) + or not TerrainDerivedDataComplete(StartKey) then + raise Exception.Create('Terrain graphics prerequisites changed before fence pass completion'); + fGraphics.FinishPass; + PassOpen := False; + except + if PassOpen then + begin + try + if TerrainGpuContextCurrent then + fGraphics.AbortPass + else + fGraphics.DiscardPendingRunWithoutGL; + except + { Preserve the original fence preparation or draw error. } end; + end; + HandleTerrainPassFailure(ExceptObject, StartKey); + raise; + end; end; @@ -866,14 +1346,67 @@ end; procedure TKMRenderTerrain.RenderPlayerPlans(aFieldsList: TKMPointTagList; aHousePlansList: TKMPointDirList); var I: Integer; -begin - //Rope field marks - for I := 0 to aFieldsList.Count - 1 do - RenderMarkup(aFieldsList[I].X, aFieldsList[I].Y, TKMFieldType(aFieldsList.Tag[I])); + PassOpen: Boolean; + StartKey, CurrentKey: TKMTerrainBundleKey; + GraphicsState: TKMTerrainGraphicsState; - //Rope outlines - for I := 0 to aHousePlansList.Count - 1 do - RenderFence(fncHousePlan, aHousePlansList[I].Dir, aHousePlansList[I].Loc.X, aHousePlansList[I].Loc.Y); + procedure RequireCurrentPlansBundle; + begin + GraphicsState := EvaluateTerrainGraphicsState(StartKey.Generation); + if GraphicsState = tgsFailure then + raise Exception.Create('Terrain graphics failed during player plans pass'); + if (GraphicsState <> tgsReady) + or not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(StartKey, CurrentKey) + or not fHaveReadyKey + or not SameTerrainBundleKey(fReadyKey, StartKey) then + raise Exception.Create('Terrain graphics prerequisites changed during player plans pass'); + end; + +begin + GraphicsState := tgsNotReady; + if fHaveGraphicsFacts then + GraphicsState := EvaluateTerrainGraphicsState(fGraphicsFacts.Generation) + else + GraphicsState := EvaluateTerrainGraphicsState(0); + if GraphicsState = tgsNotReady then Exit; + if GraphicsState = tgsFailure then + raise Exception.Create('Terrain graphics are unavailable for player plans pass'); + if not CurrentTerrainBundleKey(StartKey) + or not fHaveReadyKey + or not SameTerrainBundleKey(fReadyKey, StartKey) then Exit; + + PassOpen := False; + try + fGraphics.BeginPass(tmsAtlasUV, bsSrcAlpha, bdOneMinusSrcAlpha); + PassOpen := True; + + // Rope field marks + for I := 0 to aFieldsList.Count - 1 do + RenderMarkup(aFieldsList[I].X, aFieldsList[I].Y, TKMFieldType(aFieldsList.Tag[I])); + + // Rope outlines + for I := 0 to aHousePlansList.Count - 1 do + RenderFence(fncHousePlan, aHousePlansList[I].Dir, aHousePlansList[I].Loc.X, aHousePlansList[I].Loc.Y); + + RequireCurrentPlansBundle; + fGraphics.FinishPass; + PassOpen := False; + except + if PassOpen then + begin + try + if TerrainGpuContextCurrent then + fGraphics.AbortPass + else + fGraphics.DiscardPendingRunWithoutGL; + except + { Preserve the original player plans preparation or draw error. } + end; + end; + HandleTerrainPassFailure(ExceptObject, StartKey); + raise; + end; end; @@ -882,57 +1415,94 @@ var I, K: Integer; sizeX, sizeY: Word; tX, tY: Word; + Quad: TTerrainMobileQuad; + StartKey, CurrentKey: TKMTerrainBundleKey; + GraphicsState: TKMTerrainGraphicsState; + PassOpen: Boolean; + + procedure RequireCurrentLightingBundle; + begin + GraphicsState := EvaluateTerrainGraphicsState(StartKey.Generation); + if GraphicsState = tgsFailure then + raise Exception.Create('Terrain graphics failed during lighting pass'); + if (GraphicsState <> tgsReady) + or not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(StartKey, CurrentKey) + or not fHaveReadyKey + or not SameTerrainBundleKey(fReadyKey, StartKey) + or (fTextG = 0) then + raise Exception.Create('Terrain graphics prerequisites changed during lighting pass'); + end; + + procedure SetVertex(aCorner: Integer; aX, aY: Single; aHeight, aLight: Single); + begin + Quad[aCorner].X := aX; + Quad[aCorner].Y := aY - aHeight / CELL_HEIGHT_DIV; + Quad[aCorner].Z := tY - 1; + Quad[aCorner].U := 0.0; + Quad[aCorner].V := 0.0; + Quad[aCorner].Opacity := 1.0; + Quad[aCorner].GradientU := aLight; + end; + begin - {$IFDEF DBG_PERFLOG} - gPerfLogs.SectionEnter(psFrameLighting); - {$ENDIF} - - glColor4f(1, 1, 1, 1); - //Render highlights - glBlendFunc(GL_DST_COLOR, GL_ONE); - TKMRender.BindTexture(fTextG); - - if fUseVBO then - begin - if fTilesVtxCount = 0 then Exit; //Nothing to render - BindVBOArray(vatTile); - //Setup vertex and UV layout and offsets - glEnableClientState(GL_VERTEX_ARRAY); - glVertexPointer(3, GL_FLOAT, SizeOf(TKMTileVerticeExt), Pointer(0)); - glClientActiveTexture(GL_TEXTURE0); - glEnableClientState(GL_TEXTURE_COORD_ARRAY); - glTexCoordPointer(1, GL_FLOAT, SizeOf(TKMTileVerticeExt), Pointer(20)); - - //Here and above OGL requests Pointer, but in fact it's just a number (offset within Array) - glDrawElements(GL_TRIANGLES, fTilesIndCount, GL_UNSIGNED_INT, Pointer(0)); - - glDisableClientState(GL_VERTEX_ARRAY); - glDisableClientState(GL_TEXTURE_COORD_ARRAY); - end + if (gTerrain.MapX <= 0) or (gTerrain.MapY <= 0) then Exit; + if fHaveGraphicsFacts then + GraphicsState := EvaluateTerrainGraphicsState(fGraphicsFacts.Generation) else - begin + GraphicsState := EvaluateTerrainGraphicsState(0); + if GraphicsState = tgsNotReady then Exit; + if GraphicsState = tgsFailure then + raise Exception.Create('Terrain graphics are unavailable for lighting pass'); + if not CurrentTerrainBundleKey(StartKey) + or not fHaveReadyKey + or not SameTerrainBundleKey(fReadyKey, StartKey) + or (fTextG = 0) then + raise Exception.Create('Terrain graphics prerequisites changed before lighting pass'); + + PassOpen := False; + try + fGraphics.BeginPass(tmsGradientU, bsDstColor, bdOne); + PassOpen := True; sizeX := Max(fClipRect.Right - fClipRect.Left, 0); sizeY := Max(fClipRect.Bottom - fClipRect.Top, 0); - with gTerrain do - for I := 0 to sizeY do - for K := 0 to sizeX do - begin - tX := K + fClipRect.Left; - tY := I + fClipRect.Top; - if TileHasToBeRendered(I*K = 0,tX,tY,aFow) then // Do not render tiles fully covered by FOW - begin - glBegin(GL_TRIANGLE_FAN); - glTexCoord1f(LandExt[ tY, tX].RenderLight); glVertex3f(tX-1, tY-1 - LandExt^[ tY, tX].RenderHeight / CELL_HEIGHT_DIV, tY-1); - glTexCoord1f(LandExt[tY+1, tX].RenderLight); glVertex3f(tX-1, tY - LandExt^[tY+1, tX].RenderHeight / CELL_HEIGHT_DIV, tY-1); - glTexCoord1f(LandExt[tY+1, tX+1].RenderLight); glVertex3f( tX, tY - LandExt^[tY+1, tX+1].RenderHeight / CELL_HEIGHT_DIV, tY-1); - glTexCoord1f(LandExt[ tY, tX+1].RenderLight); glVertex3f( tX, tY-1 - LandExt^[ tY, tX+1].RenderHeight / CELL_HEIGHT_DIV, tY-1); - glEnd; - end; - end; + for I := 0 to sizeY do + for K := 0 to sizeX do + begin + tX := K + fClipRect.Left; + tY := I + fClipRect.Top; + if not TileHasToBeRendered(I*K = 0, tX, tY, aFOW) then Continue; + + RequireCurrentLightingBundle; + SetVertex(0, tX - 1, tY - 1, gTerrain.LandExt^[tY,tX].RenderHeight, + gTerrain.LandExt^[tY,tX].RenderLight); + SetVertex(1, tX - 1, tY, gTerrain.LandExt^[tY+1,tX].RenderHeight, + gTerrain.LandExt^[tY+1,tX].RenderLight); + SetVertex(2, tX, tY, gTerrain.LandExt^[tY+1,tX+1].RenderHeight, + gTerrain.LandExt^[tY+1,tX+1].RenderLight); + SetVertex(3, tX, tY - 1, gTerrain.LandExt^[tY,tX+1].RenderHeight, + gTerrain.LandExt^[tY,tX+1].RenderLight); + RequireCurrentLightingBundle; + fGraphics.SubmitQuad(Cardinal(fTextG), Quad); + end; + RequireCurrentLightingBundle; + fGraphics.FinishPass; + PassOpen := False; + except + if PassOpen then + begin + try + if TerrainGpuContextCurrent then + fGraphics.AbortPass + else + DiscardTerrainGpuAfterContextLoss; + except + { Preserve the original lighting preparation or draw error. } + end; + end; + HandleTerrainPassFailure(ExceptObject, StartKey); + raise; end; - {$IFDEF DBG_PERFLOG} - gPerfLogs.SectionLeave(psFrameLighting); - {$ENDIF} end; @@ -942,231 +1512,227 @@ var I, K: Integer; sizeX, sizeY: Word; tX, tY: Word; -begin - {$IFDEF DBG_PERFLOG} - gPerfLogs.SectionEnter(psFrameShadows); - {$ENDIF} + Quad: TTerrainMobileQuad; + StartKey, CurrentKey: TKMTerrainBundleKey; + GraphicsState: TKMTerrainGraphicsState; + PassOpen: Boolean; - glColor4f(1, 1, 1, 1); - glBlendFunc(GL_ZERO, GL_ONE_MINUS_SRC_COLOR); - TKMRender.BindTexture(fTextG); - - if fUseVBO then + procedure RequireCurrentShadowBundle; begin - if fTilesVtxCount = 0 then Exit; //Nothing to render - BindVBOArray(vatTile); - //Setup vertex and UV layout and offsets - glEnableClientState(GL_VERTEX_ARRAY); - glVertexPointer(3, GL_FLOAT, SizeOf(TKMTileVerticeExt), Pointer(0)); - glClientActiveTexture(GL_TEXTURE0); - glEnableClientState(GL_TEXTURE_COORD_ARRAY); - glTexCoordPointer(1, GL_FLOAT, SizeOf(TKMTileVerticeExt), Pointer(24)); - - //Here and above OGL requests Pointer, but in fact it's just a number (offset within Array) - glDrawElements(GL_TRIANGLES, fTilesIndCount, GL_UNSIGNED_INT, Pointer(0)); - - glDisableClientState(GL_VERTEX_ARRAY); - glDisableClientState(GL_TEXTURE_COORD_ARRAY); - end - else - begin - sizeX := Max(fClipRect.Right - fClipRect.Left, 0); - sizeY := Max(fClipRect.Bottom - fClipRect.Top, 0); - with gTerrain do - for I := 0 to sizeY do - for K := 0 to sizeX do - begin - tX := K + fClipRect.Left; - tY := I + fClipRect.Top; - if TileHasToBeRendered(I*K = 0,tX,tY,aFow) then // Do not render tiles fully covered by FOW - begin - glBegin(GL_TRIANGLE_FAN); - glTexCoord1f(-LandExt[ tY, tX].RenderLight); glVertex3f(tX-1, tY-1 - LandExt^[ tY, tX].RenderHeight / CELL_HEIGHT_DIV, tY-1); - glTexCoord1f(-LandExt[tY+1, tX].RenderLight); glVertex3f(tX-1, tY - LandExt^[tY+1, tX].RenderHeight / CELL_HEIGHT_DIV, tY-1); - glTexCoord1f(-LandExt[tY+1, tX+1].RenderLight); glVertex3f( tX, tY - LandExt^[tY+1, tX+1].RenderHeight / CELL_HEIGHT_DIV, tY-1); - glTexCoord1f(-LandExt[ tY, tX+1].RenderLight); glVertex3f( tX, tY-1 - LandExt^[ tY, tX+1].RenderHeight / CELL_HEIGHT_DIV, tY-1); - glEnd; - end; - end; + GraphicsState := EvaluateTerrainGraphicsState(StartKey.Generation); + if GraphicsState = tgsFailure then + raise Exception.Create('Terrain graphics failed during shadow pass'); + if (GraphicsState <> tgsReady) + or not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(StartKey, CurrentKey) + or not fHaveReadyKey + or not SameTerrainBundleKey(fReadyKey, StartKey) + or (fTextG = 0) then + raise Exception.Create('Terrain graphics prerequisites changed during shadow pass'); end; - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - TKMRender.BindTexture(0); + procedure SetVertex(aCorner: Integer; aX, aY: Single; aHeight, aLight: Single); + begin + Quad[aCorner].X := aX; + Quad[aCorner].Y := aY - aHeight / CELL_HEIGHT_DIV; + Quad[aCorner].Z := tY - 1; + Quad[aCorner].U := 0.0; + Quad[aCorner].V := 0.0; + Quad[aCorner].Opacity := 1.0; + Quad[aCorner].GradientU := -aLight; + end; - {$IFDEF DBG_PERFLOG} - gPerfLogs.SectionLeave(psFrameShadows); - {$ENDIF} +begin + if (gTerrain.MapX <= 0) or (gTerrain.MapY <= 0) then Exit; + if fHaveGraphicsFacts then + GraphicsState := EvaluateTerrainGraphicsState(fGraphicsFacts.Generation) + else + GraphicsState := EvaluateTerrainGraphicsState(0); + if GraphicsState = tgsNotReady then Exit; + if GraphicsState = tgsFailure then + raise Exception.Create('Terrain graphics are unavailable for shadow pass'); + if not CurrentTerrainBundleKey(StartKey) + or not fHaveReadyKey + or not SameTerrainBundleKey(fReadyKey, StartKey) + or (fTextG = 0) then + raise Exception.Create('Terrain graphics prerequisites changed before shadow pass'); + + PassOpen := False; + try + fGraphics.BeginPass(tmsGradientU, bsZero, bdOneMinusSrcColor); + PassOpen := True; + sizeX := Max(fClipRect.Right - fClipRect.Left, 0); + sizeY := Max(fClipRect.Bottom - fClipRect.Top, 0); + for I := 0 to sizeY do + for K := 0 to sizeX do + begin + tX := K + fClipRect.Left; + tY := I + fClipRect.Top; + if not TileHasToBeRendered(I*K = 0, tX, tY, aFOW) then Continue; + + RequireCurrentShadowBundle; + SetVertex(0, tX - 1, tY - 1, gTerrain.LandExt^[tY,tX].RenderHeight, + gTerrain.LandExt^[tY,tX].RenderLight); + SetVertex(1, tX - 1, tY, gTerrain.LandExt^[tY+1,tX].RenderHeight, + gTerrain.LandExt^[tY+1,tX].RenderLight); + SetVertex(2, tX, tY, gTerrain.LandExt^[tY+1,tX+1].RenderHeight, + gTerrain.LandExt^[tY+1,tX+1].RenderLight); + SetVertex(3, tX, tY - 1, gTerrain.LandExt^[tY,tX+1].RenderHeight, + gTerrain.LandExt^[tY,tX+1].RenderLight); + RequireCurrentShadowBundle; + fGraphics.SubmitQuad(Cardinal(fTextG), Quad); + end; + RequireCurrentShadowBundle; + fGraphics.FinishPass; + PassOpen := False; + except + if PassOpen then + begin + try + if TerrainGpuContextCurrent then + fGraphics.AbortPass + else + DiscardTerrainGpuAfterContextLoss; + except + { Preserve the original shadow preparation or draw error. } + end; + end; + HandleTerrainPassFailure(ExceptObject, StartKey); + raise; + end; end; //Render FOW at once -procedure TKMRenderTerrain.RenderFOW(aFOW: TKMFogOfWarCommon; aUseContrast: Boolean = False); +procedure TKMRenderTerrain.RenderFOW(aFOW: TKMFogOfWarCommon); var I, K: Integer; fog: PKMByte2Array; + Quad: TTerrainMobileQuad; + StartKey, CurrentKey: TKMTerrainBundleKey; + GraphicsState: TKMTerrainGraphicsState; + PassOpen: Boolean; + + procedure RequireCurrentFOWBundle; + begin + GraphicsState := EvaluateTerrainGraphicsState(StartKey.Generation); + if GraphicsState = tgsFailure then + raise Exception.Create('Terrain graphics failed during FOW pass'); + if (GraphicsState <> tgsReady) + or not CurrentTerrainBundleKey(CurrentKey) + or not SameTerrainBundleKey(StartKey, CurrentKey) + or not fHaveReadyKey + or not SameTerrainBundleKey(fReadyKey, StartKey) + or (fTextG = 0) then + raise Exception.Create('Terrain graphics prerequisites changed during FOW pass'); + end; + + procedure SetFOWVertex(aCorner: Integer; aX, aY, aZ: Single; aFog: Byte); + begin + Quad[aCorner].X := aX; + Quad[aCorner].Y := aY; + Quad[aCorner].Z := aZ; + Quad[aCorner].U := 0.0; + Quad[aCorner].V := 0.0; + Quad[aCorner].Opacity := 1.0; + Quad[aCorner].GradientU := EnsureRange(aFog / 255.0, 0.0, 1.0); + end; + begin if aFOW is TKMFogOfWarOpen then Exit; - {$IFDEF DBG_PERFLOG} - gPerfLogs.SectionEnter(psFrameFOW); - {$ENDIF} + if (gTerrain.MapX <= 0) or (gTerrain.MapY <= 0) + or (fClipRect.Left > fClipRect.Right) + or (fClipRect.Top > fClipRect.Bottom) then Exit; - glColor4f(1, 1, 1, 1); - - if aUseContrast then - begin - //Hide everything behind FOW with a sharp transition - glColor4f(0, 0, 0, 1); - TKMRender.BindTexture(fTextB); - end + if fHaveGraphicsFacts then + GraphicsState := EvaluateTerrainGraphicsState(fGraphicsFacts.Generation) else - begin - glBlendFunc(GL_ZERO, GL_SRC_COLOR); - TKMRender.BindTexture(fTextG); - end; + GraphicsState := EvaluateTerrainGraphicsState(0); + if GraphicsState = tgsNotReady then Exit; + if GraphicsState = tgsFailure then + raise Exception.Create('Terrain graphics are unavailable for FOW pass'); + if not CurrentTerrainBundleKey(StartKey) + or not fHaveReadyKey + or not SameTerrainBundleKey(fReadyKey, StartKey) + or (fTextG = 0) then + raise Exception.Create('Terrain graphics prerequisites changed before FOW pass'); fog := @TKMFogOfWar(aFOW).Revelation; - if fUseVBO then - begin - if fTilesFowVtxCount = 0 then Exit; //Nothing to render - BindVBOArray(vatFOW); + PassOpen := False; + try + fGraphics.BeginPass(tmsGradientU, bsZero, bdSrcColor); + PassOpen := True; - //Setup vertex and UV layout and offsets - glEnableClientState(GL_VERTEX_ARRAY); - glVertexPointer(3, GL_FLOAT, SizeOf(TKMTileFowVertice), Pointer(0)); - glClientActiveTexture(GL_TEXTURE0); - glEnableClientState(GL_TEXTURE_COORD_ARRAY); - glTexCoordPointer(1, GL_FLOAT, SizeOf(TKMTileFowVertice), Pointer(12)); - - //Here and above OGL requests Pointer, but in fact it's just a number (offset within Array) - glDrawElements(GL_TRIANGLES, fTilesFowIndCount, GL_UNSIGNED_INT, Pointer(0)); - - glDisableClientState(GL_VERTEX_ARRAY); - glDisableClientState(GL_TEXTURE_COORD_ARRAY); - end - else - begin with gTerrain do + begin for I := fClipRect.Top to fClipRect.Bottom do - for K := fClipRect.Left to fClipRect.Right do - begin - glBegin(GL_TRIANGLE_FAN); - glTexCoord1f(fog^[I - 1, K - 1] / 255); - glVertex2f(K - 1, I - 1 - LandExt^[I, K].RenderHeight / CELL_HEIGHT_DIV); - glTexCoord1f(fog^[I, K - 1] / 255); - glVertex2f(K - 1, I - LandExt^[I + 1, K].RenderHeight / CELL_HEIGHT_DIV); - glTexCoord1f(fog^[I, K] / 255); - glVertex2f(K, I - LandExt^[I + 1, K + 1].RenderHeight / CELL_HEIGHT_DIV); - glTexCoord1f(fog^[I - 1, K] / 255); - glVertex2f(K, I - 1 - LandExt^[I, K + 1].RenderHeight / CELL_HEIGHT_DIV); - glEnd; - end; - end; + for K := fClipRect.Left to fClipRect.Right do + begin + RequireCurrentFOWBundle; + SetFOWVertex(0, K - 1, I - 1 - LandExt^[I, K].RenderHeight / CELL_HEIGHT_DIV, + I - 1, fog^[I - 1, K - 1]); + SetFOWVertex(1, K - 1, I - LandExt^[I + 1, K].RenderHeight / CELL_HEIGHT_DIV, + I - 1, fog^[I, K - 1]); + SetFOWVertex(2, K, I - LandExt^[I + 1, K + 1].RenderHeight / CELL_HEIGHT_DIV, + I - 1, fog^[I, K]); + SetFOWVertex(3, K, I - 1 - LandExt^[I, K + 1].RenderHeight / CELL_HEIGHT_DIV, + I - 1, fog^[I - 1, K]); + RequireCurrentFOWBundle; + fGraphics.SubmitQuad(Cardinal(fTextG), Quad); + end; - //Sprites (trees) can extend beyond the top edge of the map, so draw extra rows of fog to cover them - //@Krom: If you know a neater/faster way to solve this problem please feel free to change it. - //@Krom: Side note: Is it ok to not use VBOs in this case? (does mixing VBO with non-VBO code cause any problems?) - with gTerrain do - if fClipRect.Top <= 1 then - begin - //3 tiles is enough to cover the tallest tree with highest elevation on top row - for I := -2 to 0 do - for K := fClipRect.Left to fClipRect.Right do - begin - glBegin(GL_TRIANGLE_FAN); - glTexCoord1f(fog^[0, K - 1] / 255); - glVertex2f(K - 1, I - 1 - LandExt^[1, K].RenderHeight / CELL_HEIGHT_DIV); - glTexCoord1f(fog^[0, K - 1] / 255); - glVertex2f(K - 1, I - LandExt^[1, K].RenderHeight / CELL_HEIGHT_DIV); - glTexCoord1f(fog^[0, K] / 255); - glVertex2f(K, I - LandExt^[1, K + 1].RenderHeight / CELL_HEIGHT_DIV); - glTexCoord1f(fog^[0, K] / 255); - glVertex2f(K, I - 1 - LandExt^[1, K + 1].RenderHeight / CELL_HEIGHT_DIV); - glEnd; - end; - end; - //Similar thing for the bottom of the map (field borders can overhang) - with gTerrain do - if fClipRect.Bottom >= MapY-1 then - begin - //1 tile is enough to cover field borders - for K := fClipRect.Left to fClipRect.Right do - begin - glBegin(GL_TRIANGLE_FAN); - glTexCoord1f(fog^[MapY-1, K - 1] / 255); - glVertex2f(K - 1, MapY-1 - LandExt^[MapY, K].RenderHeight / CELL_HEIGHT_DIV); - glTexCoord1f(fog^[MapY-1, K - 1] / 255); - glVertex2f(K - 1, MapY - LandExt^[MapY, K].RenderHeight / CELL_HEIGHT_DIV); - glTexCoord1f(fog^[MapY-1, K] / 255); - glVertex2f(K, MapY-1 - LandExt^[MapY, K + 1].RenderHeight / CELL_HEIGHT_DIV); - glTexCoord1f(fog^[MapY-1, K] / 255); - glVertex2f(K, MapY - LandExt^[MapY, K + 1].RenderHeight / CELL_HEIGHT_DIV); - glEnd; - end; + if fClipRect.Top <= 1 then + for I := -2 to 0 do + for K := fClipRect.Left to fClipRect.Right do + begin + RequireCurrentFOWBundle; + SetFOWVertex(0, K - 1, I - 1 - LandExt^[1, K].RenderHeight / CELL_HEIGHT_DIV, + I - 1, fog^[0, K - 1]); + SetFOWVertex(1, K - 1, I - LandExt^[1, K].RenderHeight / CELL_HEIGHT_DIV, + I - 1, fog^[0, K - 1]); + SetFOWVertex(2, K, I - LandExt^[1, K + 1].RenderHeight / CELL_HEIGHT_DIV, + I - 1, fog^[0, K]); + SetFOWVertex(3, K, I - 1 - LandExt^[1, K + 1].RenderHeight / CELL_HEIGHT_DIV, + I - 1, fog^[0, K]); + RequireCurrentFOWBundle; + fGraphics.SubmitQuad(Cardinal(fTextG), Quad); + end; + + if fClipRect.Bottom >= MapY - 1 then + for K := fClipRect.Left to fClipRect.Right do + begin + RequireCurrentFOWBundle; + SetFOWVertex(0, K - 1, MapY - 1 - LandExt^[MapY, K].RenderHeight / CELL_HEIGHT_DIV, + MapY - 1, fog^[MapY - 1, K - 1]); + SetFOWVertex(1, K - 1, MapY - LandExt^[MapY, K].RenderHeight / CELL_HEIGHT_DIV, + MapY - 1, fog^[MapY - 1, K - 1]); + SetFOWVertex(2, K, MapY - LandExt^[MapY, K + 1].RenderHeight / CELL_HEIGHT_DIV, + MapY - 1, fog^[MapY - 1, K]); + SetFOWVertex(3, K, MapY - 1 - LandExt^[MapY, K + 1].RenderHeight / CELL_HEIGHT_DIV, + MapY - 1, fog^[MapY - 1, K]); + RequireCurrentFOWBundle; + fGraphics.SubmitQuad(Cardinal(fTextG), Quad); + end; end; - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - TKMRender.BindTexture(0); - {$IFDEF DBG_PERFLOG} - gPerfLogs.SectionLeave(psFrameFOW); - {$ENDIF} -end; - - -procedure TKMRenderTerrain.BindVBOArray(aVBOArrayType: TKMVBOArrayType); -begin - if fLastBindVBOArrayType = aVBOArrayType then Exit; // Do not to rebind for same tyle type - - case aVBOArrayType of - vatTile: if fTilesVtxCount > 0 then - begin - glBindBuffer(GL_ARRAY_BUFFER, fVtxTilesShd); - glBindBuffer(GL_ELEMENT_ARRAY_BUFFER, fIndTilesShd); - - if fVBONeedsFlush[aVBOArrayType] then - begin - glBufferData(GL_ARRAY_BUFFER, fTilesVtxCount * SizeOf(TKMTileVerticeExt), @fTilesVtx[0].X, GL_STREAM_DRAW); - glBufferData(GL_ELEMENT_ARRAY_BUFFER, fTilesIndCount * SizeOf(fTilesInd[0]), @fTilesInd[0], GL_STREAM_DRAW); - fVBONeedsFlush[aVBOArrayType] := False; - end; - end else Exit; - vatTileLayer: if Length(fTilesLayersVtx) > 0 then - begin - glBindBuffer(GL_ARRAY_BUFFER, fVtxTilesLayersShd); - glBindBuffer(GL_ELEMENT_ARRAY_BUFFER, fIndTilesLayersShd); - - if fVBONeedsFlush[aVBOArrayType] then - begin - glBufferData(GL_ARRAY_BUFFER, Length(fTilesLayersVtx) * SizeOf(TKMTileVertice), @fTilesLayersVtx[0].X, GL_STREAM_DRAW); - glBufferData(GL_ELEMENT_ARRAY_BUFFER, Length(fTilesLayersInd) * SizeOf(fTilesLayersInd[0]), @fTilesLayersInd[0], GL_STREAM_DRAW); - fVBONeedsFlush[aVBOArrayType] := False; - end; - end else Exit; - vatAnimTile: if fAnimTilesVtxCount > 0 then - begin - glBindBuffer(GL_ARRAY_BUFFER, fVtxAnimTilesShd); - glBindBuffer(GL_ELEMENT_ARRAY_BUFFER, fIndAnimTilesShd); - - if fVBONeedsFlush[aVBOArrayType] then - begin - glBufferData(GL_ARRAY_BUFFER, fAnimTilesVtxCount * SizeOf(TKMTileVertice), @fAnimTilesVtx[0].X, GL_STREAM_DRAW); - glBufferData(GL_ELEMENT_ARRAY_BUFFER, fAnimTilesIndCount * SizeOf(fAnimTilesInd[0]), @fAnimTilesInd[0], GL_STREAM_DRAW); - fVBONeedsFlush[aVBOArrayType] := False; - end; - end else Exit; - vatFOW: if fTilesFowVtxCount > 0 then - begin - glBindBuffer(GL_ARRAY_BUFFER, fVtxTilesFowShd); - glBindBuffer(GL_ELEMENT_ARRAY_BUFFER, fIndTilesFowShd); - - if fVBONeedsFlush[aVBOArrayType] then - begin - glBufferData(GL_ARRAY_BUFFER, fTilesFowVtxCount * SizeOf(TKMTileFowVertice), @fTilesFowVtx[0].X, GL_STREAM_DRAW); - glBufferData(GL_ELEMENT_ARRAY_BUFFER, fTilesFowIndCount * SizeOf(fTilesFowInd[0]), @fTilesFowInd[0], GL_STREAM_DRAW); - fVBONeedsFlush[aVBOArrayType] := False; - end; - end else Exit; + RequireCurrentFOWBundle; + fGraphics.FinishPass; + PassOpen := False; + except + if PassOpen then + begin + try + if TerrainGpuContextCurrent then + fGraphics.AbortPass + else + DiscardTerrainGpuAfterContextLoss; + except + { Preserve the original FOW preparation or draw error. } + end; + end; + HandleTerrainPassFailure(ExceptObject, StartKey); + raise; end; - fLastBindVBOArrayType := aVBOArrayType; end; @@ -1174,13 +1740,7 @@ end; //aFOW - whose players FOW to apply procedure TKMRenderTerrain.RenderBase(aAnimStep: Integer; aFOW: TKMFogOfWarCommon); begin - fUseVBO := DoUseVBO; - - UpdateVBO(aAnimStep, aFOW); - - {$IFDEF DBG_PERFLOG} - gPerfLogs.SectionEnter(psFrameTerrainBase); - {$ENDIF} + if not TerrainDrawAllowed then Exit; DoTiles(aFOW); //It was 'unlit water goes above lit sand' @@ -1191,84 +1751,7 @@ begin DoTilesLayers(aFOW); DoOverlays(aFOW); DoLighting(aFOW); -// DoAnimations(aAnimStep, aFOW); DoShadows(aFOW); - - {$IFDEF DBG_PERFLOG} - gPerfLogs.SectionLeave(psFrameTerrainBase); - {$ENDIF} -end; - - -procedure TKMRenderTerrain.DoRenderTile(aTerrainId: Word; pX,pY,Rot: Integer; aDoBindTexture: Boolean; aUseTileLookup: Boolean; - DoHighlight: Boolean = False; HighlightColor: Cardinal = 0; aBlendingLvl: Byte = 0); -const - NO_CORNERS: TKMTileCorners = (False, False, False, False); -begin - DoRenderTile(aTerrainId, pX,pY,Rot, NO_CORNERS, aDoBindTexture, aUseTileLookup, DoHighlight, HighlightColor, aBlendingLvl); -end; - - -procedure TKMRenderTerrain.DoRenderTile(aTerrainId: Word; pX,pY,Rot: Integer; aCorners: TKMTileCorners; aDoBindTexture: Boolean; - aUseTileLookup: Boolean; DoHighlight: Boolean = False; HighlightColor: Cardinal = 0; - aBlendingLvl: Byte = 0); -var - texC: TKMUVRect; // Texture UV coordinates -begin - if not gTerrain.TileInMapCoords(pX,pY) then Exit; - - if DoHighlight then - glColor4ub(HighlightColor and $FF, (HighlightColor shr 8) and $FF, (HighlightColor shr 16) and $FF, $FF) - else - glColor4f(1, 1, 1, 1); - - if aDoBindTexture then - TKMRender.BindTexture(gGFXData[rxTiles, aTerrainId + 1].Tex.TexID); - - if aUseTileLookup then - texC := fTileUVLookup[aTerrainId, Rot mod 4] - else - texC := GetTileUV(aTerrainId, Rot mod 4); - - glBegin(GL_TRIANGLE_FAN); - - //todo -cComplicated: DoHighlight and HighlightColor is not considered here, we use always glColor4f(1, 1, 1, 1); - if aBlendingLvl > 0 then - RenderQuadTextureBlended(texC, pX, pY, aCorners, aBlendingLvl) - else - RenderQuadTexture(texC, pX, pY); - - glEnd; -end; - - -//Render single terrain cell -procedure TKMRenderTerrain.RenderTile(aTerrainId: Word; pX,pY,Rot: Integer; DoHighlight: Boolean = False; HighlightColor: Cardinal = 0); -begin - DoRenderTile(aTerrainId, pX, pY, Rot, True, True, DoHighlight, HighlightColor); -end; - - -//Render single terrain cell -procedure TKMRenderTerrain.RenderTile(pX,pY: Integer; aTileBasic: TKMTerrainTileBasic; DoHighlight: Boolean = False; HighlightColor: Cardinal = 0); -var - L: Integer; - doBindTexture: Boolean; -begin - if not gTerrain.TileInMapCoords(pX,pY) then Exit; - - doBindTexture := not TKMResSprites.AllTilesOnOneAtlas; - if not doBindTexture then - TKMRender.BindTexture(gGFXData[rxTiles, aTileBasic.BaseLayer.Terrain + 1].Tex.TexID); - - // Render Base Layer - DoRenderTile(aTileBasic.BaseLayer.Terrain, pX, pY, aTileBasic.BaseLayer.Rotation, doBindTexture, - False, DoHighlight, HighlightColor); - - // Render other Layers - for L := 0 to aTileBasic.LayersCnt - 1 do - DoRenderTile(aTileBasic.Layer[L].Terrain, pX, pY, aTileBasic.Layer[L].Rotation, aTileBasic.Layer[L].GetCorners, - doBindTexture, False, DoHighlight, HighlightColor, aTileBasic.BlendingLvl); end; @@ -1277,55 +1760,101 @@ const FO = 4; //Fence overlap VO = -4; //Move fences a little down to avoid visible overlap when unit stands behind fence, but is rendered ontop of it, due to Z sorting algo we use var + CurrentKey, InitialKey: TKMTerrainBundleKey; UVa, UVb: TKMPointF; - texID: Integer; - x1, y1, y2, fenceX, fenceY: Single; + Quad: TTerrainMobileQuad; + SpriteID: Integer; + SpriteWidth, SpriteHeight: Integer; + CurrentGuiTextureID: Cardinal; + x1, y1, y2, fenceX, fenceY, LeftX, RightX, VCrop: Single; heightInPx: Integer; + I: Integer; + + procedure RequireCurrentGuiBundle; + begin + if not CurrentTerrainBundleKey(CurrentKey) + or (EvaluateTerrainGraphicsState(CurrentKey.Generation) <> tgsReady) + or not fHaveReadyKey + or not SameTerrainBundleKey(fReadyKey, CurrentKey) then + raise Exception.Create('Terrain GUI fence draw has no current accepted atlas bundle'); + end; + begin case aFence of - fncHouseFence: if Pos in [dirN,dirS] then texID:=463 else texID:=467; //WIP (Wood planks) - fncHousePlan: if Pos in [dirN,dirS] then texID:=105 else texID:=117; //Plan (Ropes) - fncWine: if Pos in [dirN,dirS] then texID:=462 else texID:=466; //Fence (Wood) - fncCorn: if Pos in [dirN,dirS] then texID:=461 else texID:=465; //Fence (Stones) - else texID := 0; + fncHouseFence: if Pos in [dirN,dirS] then SpriteID:=463 else SpriteID:=467; //WIP (Wood planks) + fncHousePlan: if Pos in [dirN,dirS] then SpriteID:=105 else SpriteID:=117; //Plan (Ropes) + fncWine: if Pos in [dirN,dirS] then SpriteID:=462 else SpriteID:=466; //Fence (Wood) + fncCorn: if Pos in [dirN,dirS] then SpriteID:=461 else SpriteID:=465; //Fence (Stones) + else SpriteID := 0; end; //With these directions render fences on next tile if Pos = dirS then Inc(pY); if Pos = dirW then Inc(pX); + RequireCurrentGuiBundle; + InitialKey := CurrentKey; + if (SpriteID < 0) or (SpriteID >= Length(gGFXData[rxGui])) then + raise Exception.Create('Terrain GUI fence selected sprite is outside the current atlas'); + + CurrentGuiTextureID := gGFXData[rxGui, SpriteID].Tex.TexID; + UVa.X := gGFXData[rxGui, SpriteID].Tex.u1; + UVa.Y := gGFXData[rxGui, SpriteID].Tex.v1; + UVb.X := gGFXData[rxGui, SpriteID].Tex.u2; + UVb.Y := gGFXData[rxGui, SpriteID].Tex.v2; + SpriteWidth := gGFXData[rxGui, SpriteID].PxWidth; + SpriteHeight := gGFXData[rxGui, SpriteID].PxHeight; + if (CurrentGuiTextureID = 0) + or IsNan(UVa.X) or IsInfinite(UVa.X) + or IsNan(UVa.Y) or IsInfinite(UVa.Y) + or IsNan(UVb.X) or IsInfinite(UVb.X) + or IsNan(UVb.Y) or IsInfinite(UVb.Y) + or not (UVa.X >= 0) or not (UVa.X <= 1) + or not (UVa.Y >= 0) or not (UVa.Y <= 1) + or not (UVb.X >= 0) or not (UVb.X <= 1) + or not (UVb.Y >= 0) or not (UVb.Y <= 1) + or (UVb.X <= UVa.X) or (UVb.Y <= UVa.Y) then + raise Exception.Create('Terrain GUI fence selected sprite has invalid texture or UV data'); + if SpriteWidth <= 0 then + raise Exception.Create('Terrain GUI fence selected sprite has invalid pixel width'); + if Pos in [dirN, dirS] then begin //Horizontal - TKMRender.BindTexture(gGFXData[rxGui,texID].Tex.TexID); - UVa.X := gGFXData[rxGui, texID].Tex.u1; - UVa.Y := gGFXData[rxGui, texID].Tex.v1; - UVb.X := gGFXData[rxGui, texID].Tex.u2; - UVb.Y := gGFXData[rxGui, texID].Tex.v2; - y1 := pY - 1 - (gTerrain.LandExt^[pY, pX].RenderHeight + VO) / CELL_HEIGHT_DIV; y2 := pY - 1 - (gTerrain.LandExt^[pY, pX + 1].RenderHeight + VO) / CELL_HEIGHT_DIV; - fenceY := gGFXData[rxGui,texID].PxWidth / CELL_SIZE_PX; - glBegin(GL_QUADS); - glTexCoord2f(UVb.x, UVa.y); glVertex2f(pX-1 -3/ CELL_SIZE_PX, y1); - glTexCoord2f(UVa.x, UVa.y); glVertex2f(pX-1 -3/ CELL_SIZE_PX, y1 - fenceY); - glTexCoord2f(UVa.x, UVb.y); glVertex2f(pX +3/ CELL_SIZE_PX, y2 - fenceY); - glTexCoord2f(UVb.x, UVb.y); glVertex2f(pX +3/ CELL_SIZE_PX, y2); - glEnd; + fenceY := SpriteWidth / CELL_SIZE_PX; + LeftX := pX - 1 - 3 / CELL_SIZE_PX; + RightX := pX + 3 / CELL_SIZE_PX; + Quad[0].X := LeftX; + Quad[0].Y := y1; + Quad[0].U := UVb.X; + Quad[0].V := UVa.Y; + Quad[1].X := LeftX; + Quad[1].Y := y1 - fenceY; + Quad[1].U := UVa.X; + Quad[1].V := UVa.Y; + Quad[2].X := RightX; + Quad[2].Y := y2 - fenceY; + Quad[2].U := UVa.X; + Quad[2].V := UVb.Y; + Quad[3].X := RightX; + Quad[3].Y := y2; + Quad[3].U := UVb.X; + Quad[3].V := UVb.Y; end else begin //Vertical - TKMRender.BindTexture(gGFXData[rxGui,texID].Tex.TexID); heightInPx := Round(CELL_SIZE_PX * (1 + (gTerrain.LandExt^[pY,pX].RenderHeight - gTerrain.LandExt^[pY+1,pX].RenderHeight)/CELL_HEIGHT_DIV)+FO); - UVa.X := gGFXData[rxGui, texID].Tex.u1; - UVa.Y := gGFXData[rxGui, texID].Tex.v1; - UVb.X := gGFXData[rxGui, texID].Tex.u2; - UVb.Y := Mix(gGFXData[rxGui, texID].Tex.v2, gGFXData[rxGui, texID].Tex.v1, heightInPx / gGFXData[rxGui, texID].pxHeight); + if SpriteHeight <= 0 then + raise Exception.Create('Terrain GUI fence selected sprite has invalid pixel height'); + VCrop := Mix(UVb.Y, UVa.Y, + heightInPx / SpriteHeight); y1 := pY - 1 - (gTerrain.LandExt^[pY, pX].RenderHeight + FO + VO) / CELL_HEIGHT_DIV; y2 := pY - (gTerrain.LandExt^[pY + 1, pX].RenderHeight + VO) / CELL_HEIGHT_DIV; - fenceX := gGFXData[rxGui,texID].PxWidth / CELL_SIZE_PX; + fenceX := SpriteWidth / CELL_SIZE_PX; case Pos of dirW: x1 := pX - 1 - 3 / CELL_SIZE_PX; @@ -1333,13 +1862,35 @@ begin else x1 := pX - 1; //Should never happen end; - glBegin(GL_QUADS); - glTexCoord2f(UVa.x, UVa.y); glVertex2f(x1, y1); - glTexCoord2f(UVb.x, UVa.y); glVertex2f(x1+ fenceX, y1); - glTexCoord2f(UVb.x, UVb.y); glVertex2f(x1+ fenceX, y2); - glTexCoord2f(UVa.x, UVb.y); glVertex2f(x1, y2); - glEnd; + Quad[0].X := x1; + Quad[0].Y := y1; + Quad[0].U := UVa.X; + Quad[0].V := UVa.Y; + Quad[1].X := x1 + fenceX; + Quad[1].Y := y1; + Quad[1].U := UVb.X; + Quad[1].V := UVa.Y; + Quad[2].X := x1 + fenceX; + Quad[2].Y := y2; + Quad[2].U := UVb.X; + Quad[2].V := VCrop; + Quad[3].X := x1; + Quad[3].Y := y2; + Quad[3].U := UVa.X; + Quad[3].V := VCrop; end; + + for I := 0 to High(Quad) do + begin + Quad[I].Z := 0.0; + Quad[I].Opacity := 1.0; + Quad[I].GradientU := 0.0; + end; + + RequireCurrentGuiBundle; + if not SameTerrainBundleKey(InitialKey, CurrentKey) then + raise Exception.Create('Terrain GUI atlas changed during fence quad preparation'); + fGraphics.SubmitQuad(CurrentGuiTextureID, Quad); end; @@ -1347,29 +1898,90 @@ procedure TKMRenderTerrain.RenderMarkup(pX, pY: Word; aFieldType: TKMFieldType); const MarkupTex: array [TKMFieldType] of Word = (0, 105, 107, 108, 0); var - ID: Integer; - UVa,UVb: TKMPointF; + SpriteID: Integer; + CurrentKey, InitialKey: TKMTerrainBundleKey; + CurrentGuiTextureID: Cardinal; + U1, V1, U2, V2: Single; + HNW, HNE, HSW, HSE: Single; + FirstQuad, SecondQuad: TTerrainMobileQuad; + I: Integer; + SpriteValid: Boolean; + + procedure RequireCurrentGuiBundle; + begin + if not CurrentTerrainBundleKey(CurrentKey) + or (EvaluateTerrainGraphicsState(CurrentKey.Generation) <> tgsReady) + or not fHaveReadyKey + or not SameTerrainBundleKey(fReadyKey, CurrentKey) then + raise Exception.Create('Terrain GUI markup draw has no current accepted atlas bundle'); + end; + + function ValidUV(aU1, aV1, aU2, aV2: Single): Boolean; + begin + Result := not IsNan(aU1) and not IsInfinite(aU1) + and not IsNan(aV1) and not IsInfinite(aV1) + and not IsNan(aU2) and not IsInfinite(aU2) + and not IsNan(aV2) and not IsInfinite(aV2) + and (aU1 >= 0) and (aU1 <= 1) + and (aV1 >= 0) and (aV1 <= 1) + and (aU2 >= 0) and (aU2 <= 1) + and (aV2 >= 0) and (aV2 <= 1) + and (aU2 > aU1) and (aV2 > aV1); + end; + + procedure SetVertex(var aVertex: TTerrainMobileVertex; aX, aY, aU, aV: Single); + begin + aVertex.X := aX; + aVertex.Y := aY; + aVertex.Z := 0.0; + aVertex.U := aU; + aVertex.V := aV; + aVertex.Opacity := 1.0; + aVertex.GradientU := 0.0; + end; + begin - ID := MarkupTex[aFieldType]; + SpriteID := MarkupTex[aFieldType]; + RequireCurrentGuiBundle; + InitialKey := CurrentKey; + if (SpriteID < 0) or (SpriteID >= Length(gGFXData[rxGui])) then + begin + if SpriteID = 0 then Exit; + raise Exception.Create('Terrain GUI markup selected sprite is outside the current atlas'); + end; - TKMRender.BindTexture(gGFXData[rxGui, ID].Tex.TexID); + CurrentGuiTextureID := gGFXData[rxGui, SpriteID].Tex.TexID; + U1 := gGFXData[rxGui, SpriteID].Tex.u1; + V1 := gGFXData[rxGui, SpriteID].Tex.v1; + U2 := gGFXData[rxGui, SpriteID].Tex.u2; + V2 := gGFXData[rxGui, SpriteID].Tex.v2; + SpriteValid := (CurrentGuiTextureID <> 0) and ValidUV(U1, V1, U2, V2); + if not SpriteValid then + begin + if SpriteID = 0 then Exit; + raise Exception.Create('Terrain GUI markup selected sprite has invalid texture or UV data'); + end; - UVa.X := gGFXData[rxGui, ID].Tex.u1; - UVa.Y := gGFXData[rxGui, ID].Tex.v1; - UVb.X := gGFXData[rxGui, ID].Tex.u2; - UVb.Y := gGFXData[rxGui, ID].Tex.v2; + HNW := gTerrain.LandExt^[pY, pX].RenderHeight; + HNE := gTerrain.LandExt^[pY, pX + 1].RenderHeight; + HSW := gTerrain.LandExt^[pY + 1, pX].RenderHeight; + HSE := gTerrain.LandExt^[pY + 1, pX + 1].RenderHeight; - glBegin(GL_QUADS); - glTexCoord2f(UVb.x, UVa.y); glVertex2f(pX-1, pY-1 - gTerrain.LandExt^[pY ,pX ].RenderHeight/CELL_HEIGHT_DIV+0.10); - glTexCoord2f(UVa.x, UVa.y); glVertex2f(pX-1, pY-1 - gTerrain.LandExt^[pY ,pX ].RenderHeight/CELL_HEIGHT_DIV-0.15); - glTexCoord2f(UVa.x, UVb.y); glVertex2f(pX , pY - gTerrain.LandExt^[pY+1,pX+1].RenderHeight/CELL_HEIGHT_DIV-0.25); - glTexCoord2f(UVb.x, UVb.y); glVertex2f(pX , pY - gTerrain.LandExt^[pY+1,pX+1].RenderHeight/CELL_HEIGHT_DIV); + SetVertex(FirstQuad[0], pX - 1, pY - 1 - HNW / CELL_HEIGHT_DIV + 0.10, U2, V1); + SetVertex(FirstQuad[1], pX - 1, pY - 1 - HNW / CELL_HEIGHT_DIV - 0.15, U1, V1); + SetVertex(FirstQuad[2], pX, pY - HSE / CELL_HEIGHT_DIV - 0.25, U1, V2); + SetVertex(FirstQuad[3], pX, pY - HSE / CELL_HEIGHT_DIV, U2, V2); - glTexCoord2f(UVb.x, UVa.y); glVertex2f(pX-1, pY - gTerrain.LandExt^[pY+1,pX ].RenderHeight/CELL_HEIGHT_DIV); - glTexCoord2f(UVa.x, UVa.y); glVertex2f(pX-1, pY - gTerrain.LandExt^[pY+1,pX ].RenderHeight/CELL_HEIGHT_DIV-0.25); - glTexCoord2f(UVa.x, UVb.y); glVertex2f(pX , pY-1 - gTerrain.LandExt^[pY ,pX+1].RenderHeight/CELL_HEIGHT_DIV-0.15); - glTexCoord2f(UVb.x, UVb.y); glVertex2f(pX , pY-1 - gTerrain.LandExt^[pY ,pX+1].RenderHeight/CELL_HEIGHT_DIV+0.10); - glEnd; + SetVertex(SecondQuad[0], pX - 1, pY - HSW / CELL_HEIGHT_DIV, U2, V1); + SetVertex(SecondQuad[1], pX - 1, pY - HSW / CELL_HEIGHT_DIV - 0.25, U1, V1); + SetVertex(SecondQuad[2], pX, pY - 1 - HNE / CELL_HEIGHT_DIV - 0.15, U1, V2); + SetVertex(SecondQuad[3], pX, pY - 1 - HNE / CELL_HEIGHT_DIV + 0.10, U2, V2); + + RequireCurrentGuiBundle; + if not SameTerrainBundleKey(InitialKey, CurrentKey) then + raise Exception.Create('Terrain GUI atlas changed during markup quad preparation'); + fGraphics.SubmitQuad(CurrentGuiTextureID, FirstQuad); + fGraphics.SubmitQuad(CurrentGuiTextureID, SecondQuad); end; diff --git a/port-source/kam_remake/src/render/KM_RenderTerrain_Mobile.pas b/port-source/kam_remake/src/render/KM_RenderTerrain_Mobile.pas new file mode 100644 index 0000000..f83f6aa --- /dev/null +++ b/port-source/kam_remake/src/render/KM_RenderTerrain_Mobile.pas @@ -0,0 +1,540 @@ +unit KM_RenderTerrain_Mobile; +{$I KaM_Remake.inc} +interface + +uses + SysUtils, CastleGLShaders, CastleGLES, CastleRenderOptions; + +type + ETerrainForeignGLError = class(Exception); + ETerrainOwnedGpuError = class(Exception); + ETerrainContextUnavailable = class(Exception); + TTerrainContextCheck = function: Boolean of object; + TTerrainMobileVertex = packed record + X, Y, Z: Single; + U, V: Single; + Opacity: Single; + GradientU: Single; + end; + + TTerrainMobileQuad = array[0..3] of TTerrainMobileVertex; + TTerrainMobileSampleKind = (tmsAtlasUV, tmsGradientU); + + TKMTerrainMobileGraphics = class + private + fProgram: TGLSLProgram; + fPendingProgram: TGLSLProgram; + fProgramReady: Boolean; + fContextCheck: TTerrainContextCheck; + fStreamVbo: CastleGLES.GLuint; + fStreamStorageReady: Boolean; + fRunVertices: array[0..6143] of TTerrainMobileVertex; + fRunTexID: Cardinal; + fRunVertexCount: Integer; + fPassActive: Boolean; + fPassSampleKind: TTerrainMobileSampleKind; + fPassSourceBlend: TBlendingSourceFactor; + fPassDestinationBlend: TBlendingDestinationFactor; + fStateApplied: Boolean; + fPassFailed: Boolean; + procedure AppendQuadVertices(const aQuad: TTerrainMobileQuad); + procedure ResetPendingRun; + procedure FlushPendingRun; + procedure ClosePassState; + function ContextCurrent: Boolean; + procedure DisposeClosedProgram; + public + constructor Create; + property ContextCheck: TTerrainContextCheck read fContextCheck write fContextCheck; + destructor Destroy; override; + procedure BeginPass(aSampleKind: TTerrainMobileSampleKind; + aSourceBlend: TBlendingSourceFactor; + aDestinationBlend: TBlendingDestinationFactor); + procedure SubmitQuad(aTextureId: Cardinal; const aQuad: TTerrainMobileQuad); + procedure FinishPass; + procedure AbortPass; + procedure DiscardPendingRunWithoutGL; + procedure CreateCurrentProgram; + procedure CreateCurrentStreamStorage; + procedure ReleaseCurrentGpuObjects; + procedure DiscardGpuWithoutGL; + procedure ConfirmPreviousProgramClosed; + function GpuObjectsComplete: Boolean; + end; + +implementation + +uses + CastleRenderContext, CastleApplicationProperties, KM_Render; + +const + TerrainVertexShader = + 'attribute vec3 aPosition;' + #10 + + 'attribute vec2 aTexCoord;' + #10 + + 'attribute float aOpacity;' + #10 + + 'attribute float aGradientCoord;' + #10 + + 'uniform mat4 uProjection;' + #10 + + 'varying vec2 vTexCoord;' + #10 + + 'varying float vOpacity;' + #10 + + 'varying float vGradientCoord;' + #10 + + 'void main() {' + #10 + + ' gl_Position = uProjection * vec4(aPosition, 1.0);' + #10 + + ' vTexCoord = aTexCoord;' + #10 + + ' vOpacity = aOpacity;' + #10 + + ' vGradientCoord = aGradientCoord;' + #10 + + '}'; + TerrainFragmentShader = + 'uniform sampler2D uTexture;' + #10 + + 'uniform int uSampleKind;' + #10 + + 'varying vec2 vTexCoord;' + #10 + + 'varying float vOpacity;' + #10 + + 'varying float vGradientCoord;' + #10 + + 'void main() {' + #10 + + ' vec2 chosenUV = uSampleKind == 0 ? vTexCoord : vec2(vGradientCoord, 0.5);' + #10 + + ' gl_FragColor = texture2D(uTexture, chosenUV) * vec4(1.0, 1.0, 1.0, clamp(vOpacity, 0.0, 1.0));' + #10 + + '}'; + +function DrainTerrainGLErrors: string; +var + ErrorCode: CastleGLES.GLenum; +begin + Result := ''; + if not Assigned(CastleGLES.glGetError) then + raise Exception.Create('Terrain GLES glGetError is unavailable'); + 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 RequireTerrainGLErrorFree(const aStage: string); +var + Errors: string; +begin + Errors := DrainTerrainGLErrors; + if Errors <> '' then + raise ETerrainOwnedGpuError.Create('Terrain GLES ' + aStage + ' failed with error(s) ' + Errors); +end; + +constructor TKMTerrainMobileGraphics.Create; +begin + inherited Create; + fProgram := nil; + fStreamVbo := 0; + fStreamStorageReady := False; + fPassActive := False; + fStateApplied := False; + fPassFailed := False; + fRunTexID := 0; + fRunVertexCount := 0; +end; + +procedure TKMTerrainMobileGraphics.ConfirmPreviousProgramClosed; +begin + fProgramReady := False; + FreeAndNil(fPendingProgram); + FreeAndNil(fProgram); +end; + +procedure TKMTerrainMobileGraphics.DisposeClosedProgram; +begin + if not ApplicationProperties.IsGLContextOpen then + ConfirmPreviousProgramClosed; +end; + +destructor TKMTerrainMobileGraphics.Destroy; +begin + if ContextCurrent then ReleaseCurrentGpuObjects; + DiscardGpuWithoutGL; + DisposeClosedProgram; + if (fProgram <> nil) or (fPendingProgram <> nil) then + raise ETerrainContextUnavailable.Create('Terrain shader disposal awaits completed Castle context close'); + inherited; +end; + +procedure TKMTerrainMobileGraphics.CreateCurrentProgram; +var + Candidate: TGLSLProgram; + PositionAttribute, TexCoordAttribute, OpacityAttribute, GradientAttribute: TGLSLAttribute; + ProjectionUniform, TextureUniform, SampleKindUniform: TGLSLUniform; +begin + if fProgramReady and (fProgram <> nil) then Exit; + DisposeClosedProgram; + if (fProgram <> nil) or (fPendingProgram <> nil) then + raise ETerrainContextUnavailable.Create('Terrain shader creation awaits disposal after Castle context close'); + if not ContextCurrent then + raise ETerrainContextUnavailable.Create('Terrain shader creation requires the accepted current context'); + + Candidate := nil; + try + Candidate := TGLSLProgram.Create; + Candidate.FragmentShaderRequired := True; + Candidate.AttachVertexShader(TerrainVertexShader); + Candidate.AttachFragmentShader(TerrainFragmentShader); + Candidate.Link; + + PositionAttribute := Candidate.Attribute('aPosition'); + TexCoordAttribute := Candidate.Attribute('aTexCoord'); + OpacityAttribute := Candidate.Attribute('aOpacity'); + GradientAttribute := Candidate.Attribute('aGradientCoord'); + ProjectionUniform := Candidate.Uniform('uProjection', umIgnore); + TextureUniform := Candidate.Uniform('uTexture', umIgnore); + SampleKindUniform := Candidate.Uniform('uSampleKind', umIgnore); + if (PositionAttribute.Location = -1) or (TexCoordAttribute.Location = -1) + or (OpacityAttribute.Location = -1) or (GradientAttribute.Location = -1) + or (ProjectionUniform.Location = -1) or (TextureUniform.Location = -1) + or (SampleKindUniform.Location = -1) then + raise Exception.Create('Terrain shader is missing a required attribute or uniform'); + + if not ContextCurrent then + raise ETerrainContextUnavailable.Create('Terrain context changed during shader creation'); + fProgram := Candidate; + fProgramReady := True; + Candidate := nil; + finally + if Candidate <> nil then + begin + if ContextCurrent then FreeAndNil(Candidate) + else + begin + fPendingProgram := Candidate; + DisposeClosedProgram; + end; + end; + end; +end; + +procedure TKMTerrainMobileGraphics.CreateCurrentStreamStorage; +var + Candidate: CastleGLES.GLuint; + OldErrors: string; +begin + if fStreamStorageReady then Exit; + OldErrors := DrainTerrainGLErrors; + if OldErrors <> '' then + raise ETerrainForeignGLError.Create('Terrain GLES encountered pre-existing error(s) before stream allocation: ' + OldErrors); + + if fStreamVbo = 0 then + begin + Candidate := 0; + CastleGLES.glGenBuffers(1, @Candidate); + if Candidate = 0 then + raise Exception.Create('Terrain GLES failed to allocate a stream buffer name'); + fStreamVbo := Candidate; + RequireTerrainGLErrorFree('stream buffer name allocation'); + end; + fStreamStorageReady := False; + try + RenderContext.BindBuffer[btArray] := fStreamVbo; + CastleGLES.glBufferData(CastleGLES.GL_ARRAY_BUFFER, + 6144 * SizeOf(TTerrainMobileVertex), nil, CastleGLES.GL_STREAM_DRAW); + if ContextCurrent then RenderContext.BindBuffer[btArray] := 0; + RequireTerrainGLErrorFree('stream storage allocation'); + fStreamStorageReady := True; + except + try + if ContextCurrent then RenderContext.BindBuffer[btArray] := 0; + except + { Preserve the allocation failure. } + end; + raise; + end; +end; + +function TKMTerrainMobileGraphics.ContextCurrent: Boolean; +begin + Result := Assigned(fContextCheck) and fContextCheck(); +end; + +procedure TKMTerrainMobileGraphics.ReleaseCurrentGpuObjects; +var + FirstError: Exception; + + procedure RememberError; + begin + if FirstError = nil then FirstError := Exception(AcquireExceptionObject); + end; +begin + FirstError := nil; + try + if ContextCurrent and fPassActive then AbortPass; + except + RememberError; + end; + try + if ContextCurrent and (fStreamVbo <> 0) then + begin + CastleGLES.glDeleteBuffers(1, @fStreamVbo); + fStreamVbo := 0; + end; + except + RememberError; + end; + try + if ContextCurrent then + begin + FreeAndNil(fPendingProgram); + if ContextCurrent then FreeAndNil(fProgram); + end; + except + RememberError; + end; + DiscardGpuWithoutGL; + if FirstError <> nil then raise FirstError; +end; + +procedure TKMTerrainMobileGraphics.DiscardGpuWithoutGL; +begin + fProgramReady := False; + DisposeClosedProgram; + fStreamVbo := 0; + fStreamStorageReady := False; + ResetPendingRun; + fPassActive := False; + fStateApplied := False; + fPassFailed := False; +end; + +function TKMTerrainMobileGraphics.GpuObjectsComplete: Boolean; +begin + Result := fProgramReady and (fProgram <> nil) and fStreamStorageReady and (fStreamVbo <> 0); +end; + +procedure TKMTerrainMobileGraphics.ResetPendingRun; +begin + fRunTexID := 0; + fRunVertexCount := 0; +end; + +procedure TKMTerrainMobileGraphics.AppendQuadVertices(const aQuad: TTerrainMobileQuad); +const + TriangleOrder: array[0..5] of Byte = (0, 1, 2, 0, 2, 3); +var + I: Integer; +begin + for I := 0 to High(TriangleOrder) do + fRunVertices[fRunVertexCount + I] := aQuad[TriangleOrder[I]]; + Inc(fRunVertexCount, Length(TriangleOrder)); +end; + +procedure TKMTerrainMobileGraphics.BeginPass(aSampleKind: TTerrainMobileSampleKind; + aSourceBlend: TBlendingSourceFactor; aDestinationBlend: TBlendingDestinationFactor); +begin + if fPassActive then + raise Exception.Create('Terrain graphics pass is already active'); + fPassSampleKind := aSampleKind; + fPassSourceBlend := aSourceBlend; + fPassDestinationBlend := aDestinationBlend; + fPassActive := True; + fStateApplied := False; + fPassFailed := False; + ResetPendingRun; +end; + +procedure TKMTerrainMobileGraphics.SubmitQuad(aTextureId: Cardinal; + const aQuad: TTerrainMobileQuad); +begin + if not fPassActive then + raise Exception.Create('Terrain graphics SubmitQuad requires an active pass'); + if fPassFailed then + raise Exception.Create('Terrain graphics pass has already failed'); + if aTextureId = 0 then + begin + fPassFailed := True; + raise Exception.Create('Terrain graphics quad has an invalid texture identity'); + end; + if not fProgramReady or (fProgram = nil) or (fStreamVbo = 0) then + begin + fPassFailed := True; + raise Exception.Create('Terrain graphics shader or stream buffer is unavailable'); + end; + + if fRunVertexCount = 0 then + fRunTexID := aTextureId + else if fRunTexID <> aTextureId then + begin + try + FlushPendingRun; + except + fPassFailed := True; + raise; + end; + fRunTexID := aTextureId; + end; + + if fRunVertexCount + 6 > Length(fRunVertices) then + begin + try + FlushPendingRun; + except + fPassFailed := True; + raise; + end; + fRunTexID := aTextureId; + end; + AppendQuadVertices(aQuad); +end; + +procedure TKMTerrainMobileGraphics.FlushPendingRun; +var + PositionAttribute, TexCoordAttribute, OpacityAttribute, GradientAttribute: TGLSLAttribute; + ProjectionUniform, TextureUniform, SampleKindUniform: TGLSLUniform; + PositionEnabled, TexCoordEnabled, OpacityEnabled, GradientEnabled: Boolean; + RunFailed: Boolean; + OldErrors: string; + + procedure CleanupRun; + begin + try + if ContextCurrent and GradientEnabled then GradientAttribute.DisableArray; + finally + try + if ContextCurrent and OpacityEnabled then OpacityAttribute.DisableArray; + finally + try + if ContextCurrent and TexCoordEnabled then TexCoordAttribute.DisableArray; + finally + try + if ContextCurrent and PositionEnabled then PositionAttribute.DisableArray; + finally + if ContextCurrent then RenderContext.BindBuffer[btArray] := 0; + end; + end; + end; + end; + end; +begin + if fRunVertexCount = 0 then Exit; + if not fPassActive or fPassFailed then + raise Exception.Create('Terrain graphics cannot flush a failed or closed pass'); + if not fProgramReady or (fProgram = nil) or (fStreamVbo = 0) then + raise Exception.Create('Terrain graphics shader or stream buffer is unavailable'); + + OldErrors := DrainTerrainGLErrors; + if OldErrors <> '' then + raise ETerrainForeignGLError.Create('Terrain GLES encountered pre-existing error(s) before flush: ' + OldErrors); + + if not fStateApplied then + begin + RenderContext.BlendingEnable(fPassSourceBlend, fPassDestinationBlend); + fStateApplied := True; + end; + PositionEnabled := False; + TexCoordEnabled := False; + OpacityEnabled := False; + GradientEnabled := False; + RunFailed := True; + try + TKMRender.BindTexture(fRunTexID); + fProgram.Enable; + ProjectionUniform := fProgram.Uniform('uProjection', umIgnore); + TextureUniform := fProgram.Uniform('uTexture', umIgnore); + SampleKindUniform := fProgram.Uniform('uSampleKind', umIgnore); + if (ProjectionUniform.Location = -1) or (TextureUniform.Location = -1) or + (SampleKindUniform.Location = -1) then + raise Exception.Create('Terrain shader is missing a required draw uniform'); + ProjectionUniform.SetValue(RenderContext.ProjectionMatrix); + TextureUniform.SetValue(0); + SampleKindUniform.SetValue(Ord(fPassSampleKind)); + RenderContext.BindBuffer[btArray] := fStreamVbo; + PositionAttribute := fProgram.Attribute('aPosition'); + TexCoordAttribute := fProgram.Attribute('aTexCoord'); + OpacityAttribute := fProgram.Attribute('aOpacity'); + GradientAttribute := fProgram.Attribute('aGradientCoord'); + PositionAttribute.EnableArrayVector3(nil, 28, PtrUInt(0)); + PositionEnabled := True; + TexCoordAttribute.EnableArrayVector2(nil, 28, PtrUInt(12)); + TexCoordEnabled := True; + OpacityAttribute.EnableArraySingle(nil, 28, PtrUInt(20)); + OpacityEnabled := True; + GradientAttribute.EnableArraySingle(nil, 28, PtrUInt(24)); + GradientEnabled := True; + RequireTerrainGLErrorFree('shader/bind/attribute setup'); + + CastleGLES.glBufferData(CastleGLES.GL_ARRAY_BUFFER, + fRunVertexCount * SizeOf(TTerrainMobileVertex), @fRunVertices[0], CastleGLES.GL_STREAM_DRAW); + RequireTerrainGLErrorFree('stream upload'); + CastleGLES.glDrawArrays(CastleGLES.GL_TRIANGLES, 0, CastleGLES.GLsizei(fRunVertexCount)); + RequireTerrainGLErrorFree('triangle draw'); + ResetPendingRun; + RunFailed := False; + finally + if RunFailed then + begin + try + CleanupRun; + except + { Preserve the original flush error after attempting every cleanup. } + end; + end + else + CleanupRun; + end; +end; + +procedure TKMTerrainMobileGraphics.ClosePassState; +begin + try + if ContextCurrent and fStateApplied and (fProgram <> nil) and (fStreamVbo <> 0) then + begin + try + if ContextCurrent then TGLSLProgram.Disable; + finally + try + if ContextCurrent then TKMRender.BindTexture(0); + finally + try + if ContextCurrent then RenderContext.BlendingEnable(bsSrcAlpha, bdOneMinusSrcAlpha); + finally + if ContextCurrent then RenderContext.BindBuffer[btArray] := 0; + end; + end; + end; + end; + finally + ResetPendingRun; + fPassActive := False; + fStateApplied := False; + fPassFailed := False; + end; +end; + +procedure TKMTerrainMobileGraphics.FinishPass; +begin + if not fPassActive then + raise Exception.Create('Terrain graphics FinishPass requires an active pass'); + try + if fPassFailed then + raise Exception.Create('Terrain graphics pass has already failed'); + FlushPendingRun; + except + fPassFailed := True; + try + ClosePassState; + except + { Keep the original submission error. } + end; + raise; + end; + ClosePassState; +end; + +procedure TKMTerrainMobileGraphics.AbortPass; +begin + if not fPassActive then Exit; + ClosePassState; +end; + +procedure TKMTerrainMobileGraphics.DiscardPendingRunWithoutGL; +begin + ResetPendingRun; + fPassActive := False; + fStateApplied := False; + fPassFailed := False; +end; + +end.