unit GR32_MicroTiles; (* ***** BEGIN LICENSE BLOCK ***** * Version: MPL 1.1 or LGPL 2.1 with linking exception * * The contents of this file are subject to the Mozilla Public License Version * 1.1 (the "License"); you may not use this file except in compliance with * the License. You may obtain a copy of the License at * http://www.mozilla.org/MPL/ * * Software distributed under the License is distributed on an "AS IS" basis, * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License * for the specific language governing rights and limitations under the * License. * * Alternatively, the contents of this file may be used under the terms of the * Free Pascal modified version of the GNU Lesser General Public License * Version 2.1 (the "FPC modified LGPL License"), in which case the provisions * of this license are applicable instead of those above. * Please see the file LICENSE.txt for additional information concerning this * license. * * The Original Code is MicroTiles Repaint Optimizer Extension for Graphics32 * * The Initial Developer of the Original Code is * Andre Beckedorf - metaException * Andre@metaException.de * * Portions created by the Initial Developer are Copyright (C) 2005-2009 * the Initial Developer. All Rights Reserved. * * Contributor(s): * * ***** END LICENSE BLOCK ***** *) interface {$include GR32.inc} {-$DEFINE MICROTILES_DEBUGDRAW} {-$DEFINE MICROTILES_DEBUGDRAW_RANDOM_COLORS} {-$DEFINE MICROTILES_DEBUGDRAW_UNOPTIMIZED} {-$DEFINE MICROTILES_NO_ADAPTION} {-$DEFINE MICROTILES_NO_ADAPTION_FORCE_WHOLETILES} // CodeSite test stuff {-$DEFINE CODESITE} {-$DEFINE CODESITE_HIGH} uses {$IFDEF CODESITE} CSIntf, CSAux, {$ENDIF} {$if defined(UseInlining)} Types, {$ifend} SysUtils, Classes, GR32, GR32_System, GR32_Containers, GR32_Layers, GR32_RepaintOpt; const MICROTILE_SHIFT = 5; MICROTILE_SIZE = 1 shl MICROTILE_SHIFT; MICROTILE_EMPTY = 0; // MICROTILE_EMPTY -> Left: 0, Top: 0, Right: 0, Bottom: 0 MICROTILE_FULL = MICROTILE_SIZE shl 8 or MICROTILE_SIZE; // MICROTILE_FULL -> Left: 0, Top: 0, Right: MICROTILE_SIZE, Bottom: MICROTILE_SIZE MicroTileSize = MaxInt div 16; {$IFDEF MICROTILES_DEBUGDRAW} clDebugDrawFill = TColor32($30FF0000); clDebugDrawFrame = TColor32($90FF0000); {$ENDIF} type PMicroTile = ^TMicroTile; TMicroTile = type Integer; PMicroTileArray = ^TMicroTileArray; TMicroTileArray = array[0..MicroTileSize - 1] of TMicroTile; PPMicroTiles = ^PMicroTiles; PMicroTiles = ^TMicroTiles; TMicroTiles = record BoundsRect: TRect; Columns, Rows: Integer; BoundsUsedTiles: TRect; Count: Integer; Tiles: PMicroTileArray; end; // MicroTile auxiliary routines function MakeMicroTile(const Left, Top, Right, Bottom: Integer): TMicroTile; {$IFDEF USEINLINING} inline; {$ENDIF} function MicroTileHeight(const Tile: TMicroTile): Integer; {$IFDEF USEINLINING} inline; {$ENDIF} function MicroTileWidth(const Tile: TMicroTile): Integer; {$IFDEF USEINLINING} inline; {$ENDIF} var MicroTileUnion: procedure(var DstTile: TMicroTile; const SrcTile: TMicroTile); // MicroTiles auxiliary routines function MakeEmptyMicroTiles: TMicroTiles; {$IFDEF USEINLINING} inline; {$ENDIF} procedure MicroTilesCreate(var MicroTiles: TMicroTiles); {$IFDEF USEINLINING} inline; {$ENDIF} procedure MicroTilesDestroy(var MicroTiles: TMicroTiles); {$IFDEF USEINLINING} inline; {$ENDIF} procedure MicroTilesSetSize(var MicroTiles: TMicroTiles; const DstRect: TRect); procedure MicroTilesClear(var MicroTiles: TMicroTiles; const Value: TMicroTile = MICROTILE_EMPTY); {$IFDEF USEINLINING} inline; {$ENDIF} procedure MicroTilesClearUsed(var MicroTiles: TMicroTiles; const Value: TMicroTile = MICROTILE_EMPTY); procedure MicroTilesCopy(var DstTiles: TMicroTiles; SrcTiles: TMicroTiles); procedure MicroTilesAddLine(var MicroTiles: TMicroTiles; X1, Y1, X2, Y2: Integer; LineWidth: Integer; RoundToWholeTiles: Boolean = False); procedure MicroTilesAddRect(var MicroTiles: TMicroTiles; Rect: TRect; RoundToWholeTiles: Boolean = False); procedure MicroTilesUnion(var DstTiles: TMicroTiles; const SrcTiles: TMicroTiles; RoundToWholeTiles: Boolean = False); function MicroTilesCalcRects(const MicroTiles: TMicroTiles; DstRects: TRectList; CountOnly: Boolean = False; RoundToWholeTiles: Boolean = False): Integer; overload; function MicroTilesCalcRects(const MicroTiles: TMicroTiles; DstRects: TRectList; const Clip: TRect; CountOnly: Boolean = False; RoundToWholeTiles: Boolean = False): Integer; overload; function MicroTilesCountEmptyTiles(const MicroTiles: TMicroTiles): Integer; type { TMicroTilesMap } { associative array that is used to map Layers to their MicroTiles } TMicroTilesMap = class(TPointerMap) private function GetData(Item: Pointer): PMicroTiles; procedure SetData(Item: Pointer; const Data: PMicroTiles); protected function Delete(BucketIndex: Integer; ItemIndex: Integer): Pointer; override; public function Add(Item: Pointer): PPMicroTiles; property Data[Item: Pointer]: PMicroTiles read GetData write SetData; default; end; type { TMicroTilesRepaintOptimizer } { Repaint manager that optimizes the repaint process using MicroTiles } TMicroTilesRepaintOptimizer = class(TCustomRepaintOptimizer, ILayerUpdateNotification, IUpdateRectNotification, ILayerListNotification ) private // working tiles FBufferBounds: TRect; FWorkMicroTiles: PMicroTiles; // used by DrawLayerToMicroTiles FTempTiles: TMicroTiles; FInvalidTiles: TMicroTiles; FForcedInvalidTiles: TMicroTiles; // list of invalid layers FInvalidLayers: TList; // association that maps layers to their old invalid tiles FOldInvalidTilesMap: TMicroTilesMap; FWorkingTilesValid: Boolean; FOldInvalidTilesValid: Boolean; FUseInvalidTiles: Boolean; // adaptive stuff... FAdaptiveMode: Boolean; FPerfTimer: TStopWatch; FPerformanceLevel: Integer; FElapsedTimeForLastRepaint: Int64; FElapsedTimeForFullSceneRepaint: Int64; FAdaptionFailed: Boolean; // vars for time based approach FTimedCheck: Boolean; FTimeDelta: Integer; FNextCheck: Integer; FElapsedTimeOnLastPenalty: Int64; // vars for invalid rect difference approach FOldInvalidRectsCount: Integer; {$IFDEF MICROTILES_DEBUGDRAW} FDebugWholeTiles: Boolean; FDebugMicroTiles: TMicroTiles; FDebugInvalidRects: TRectList; {$ENDIF} procedure DrawLayerToMicroTiles(var DstTiles: TMicroTiles; Layer: TCustomLayer); procedure DrawMeasuringHandler(Sender: TObject; const Area: TRect; const Info: Cardinal); procedure ValidateWorkingTiles; procedure UpdateOldInvalidTiles; procedure SetAdaptiveMode(const Value: Boolean); procedure ResetAdaptiveMode; procedure BeginAdaption; procedure EndAdaption; procedure AddArea(var Tiles: TMicroTiles; const Area: TRect; const Info: Cardinal); protected procedure SetEnabled(const Value: Boolean); override; // ILayerUpdateNotification procedure LayerUpdated(ALayer: TCustomLayer); // IUpdateRectNotification procedure AreaUpdated(const AArea: TRect; const AInfo: Cardinal); // ILayerListNotification procedure LayerListNotify(ALayer: TCustomLayer; AAction: TLayerListNotification; AIndex: Integer); public constructor Create(Buffer: TBitmap32; InvalidRects: TRectList); override; destructor Destroy; override; procedure Reset; override; function UpdatesAvailable: Boolean; override; procedure PerformOptimization; override; procedure BeginPaintBuffer; override; procedure EndPaintBuffer; override; // handlers procedure BufferResizedHandler(const NewWidth, NewHeight: Integer); override; // custom settings: property AdaptiveMode: Boolean read FAdaptiveMode write SetAdaptiveMode; end; {$IFDEF CODESITE} TDebugMicroTilesRepaintOptimizer = class(TMicroTilesRepaintOptimizer) protected // ILayerNotification procedure LayerUpdated(ALayer: TCustomLayer); override; procedure LayerAreaUpdated(ALayer: TCustomLayer; const AArea: TRect; const AInfo: Cardinal); override; procedure LayerListNotify(ALayer: TCustomLayer; AAction: TLayerListNotification; AIndex: Integer); override; public procedure Reset; override; function UpdatesAvailable: Boolean; override; procedure PerformOptimization; override; procedure BeginPaintBuffer; override; procedure EndPaintBuffer; override; procedure BufferResizedHandler(const NewWidth, NewHeight: Integer); override; end; {$ENDIF} implementation uses GR32_Bindings, GR32_LowLevel, GR32_Math, Math; var MicroTilesU: procedure(var DstTiles: TMicroTiles; const SrcTiles: TMicroTiles); { MicroTile auxiliary routines } function MakeMicroTile(const Left, Top, Right, Bottom: Integer): TMicroTile; begin Result := Left shl 24 or Top shl 16 or Right shl 8 or Bottom; end; function MicroTileHeight(const Tile: TMicroTile): Integer; begin Result := (Tile and $FF) - (Tile shr 16 and $FF); end; function MicroTileWidth(const Tile: TMicroTile): Integer; begin Result := (Tile shr 8 and $FF) - (Tile shr 24); end; procedure MicroTileUnion_Pas(var DstTile: TMicroTile; const SrcTile: TMicroTile); var SrcLeft, SrcTop, SrcRight, SrcBottom: Integer; begin SrcLeft := SrcTile shr 24; SrcTop := (SrcTile and $FF0000) shr 16; SrcRight := (SrcTile and $FF00) shr 8; SrcBottom := SrcTile and $FF; if (DstTile <> MICROTILE_FULL) and (SrcTile <> MICROTILE_EMPTY) and (SrcRight - SrcLeft <> 0) and (SrcBottom - SrcTop <> 0) then begin if (DstTile = MICROTILE_EMPTY) or (SrcTile = MICROTILE_FULL) then DstTile := SrcTile else begin DstTile := Min(DstTile shr 24, SrcLeft) shl 24 or Min(DstTile shr 16 and $FF, SrcTop) shl 16 or Max(DstTile shr 8 and $FF, SrcRight) shl 8 or Max(DstTile and $FF, SrcBottom); end; end; end; // TODO : rewrite MMX implementations using SSE {$if (not defined(PUREPASCAL)) and (not defined(OMIT_MMX)) and defined(TARGET_x86)} procedure MicroTileUnion_EMMX(var DstTile: TMicroTile; const SrcTile: TMicroTile); var SrcLeft, SrcTop, SrcRight, SrcBottom: Integer; begin SrcLeft := SrcTile shr 24; SrcTop := (SrcTile and $FF0000) shr 16; SrcRight := (SrcTile and $FF00) shr 8; SrcBottom := SrcTile and $FF; if (DstTile <> MICROTILE_FULL) and (SrcTile <> MICROTILE_EMPTY) and (SrcRight - SrcLeft <> 0) and (SrcBottom - SrcTop <> 0) then begin if (DstTile = MICROTILE_EMPTY) or (SrcTile = MICROTILE_FULL) then DstTile := SrcTile else asm MOVD MM1,[SrcTile] MOV EAX,[DstTile] MOVD MM2, [EAX] MOVQ MM3, MM1 MOV ECX,$FFFF0000 // Mask MOVD MM0, ECX PMINUB MM1, MM2 PAND MM1, MM0 PSRLD MM0, 16 // shift mask right by 16 bits PMAXUB MM2, MM3 PAND MM2, MM0 POR MM1, MM2 MOVD [EAX], MM1 EMMS end; end; end; {$ifend} { MicroTiles auxiliary routines } function MakeEmptyMicroTiles: TMicroTiles; begin FillChar(Result, SizeOf(TMicroTiles), 0); ReallocMem(Result.Tiles, 0); end; procedure MicroTilesCreate(var MicroTiles: TMicroTiles); begin FillChar(MicroTiles, SizeOf(TMicroTiles), 0); ReallocMem(MicroTiles.Tiles, 0); end; procedure MicroTilesDestroy(var MicroTiles: TMicroTiles); begin ReallocMem(MicroTiles.Tiles, 0); end; procedure MicroTilesClear(var MicroTiles: TMicroTiles; const Value: TMicroTile); begin MicroTiles.BoundsUsedTiles := MakeRect(MicroTiles.Columns, MicroTiles.Rows, 0, 0); FillLongword(MicroTiles.Tiles^[0], MicroTiles.Count, Value); end; procedure MicroTilesSetSize(var MicroTiles: TMicroTiles; const DstRect: TRect); begin MicroTiles.BoundsRect := DstRect; MicroTiles.Columns := ((DstRect.Right - DstRect.Left) shr MICROTILE_SHIFT) + 1; MicroTiles.Rows := ((DstRect.Bottom - DstRect.Top) shr MICROTILE_SHIFT) + 1; MicroTiles.Count := (MicroTiles.Columns + 1) * (MicroTiles.Rows + 1); ReallocMem(MicroTiles.Tiles, MicroTiles.Count * SizeOf(TMicroTile)); MicroTilesClear(MicroTiles) end; procedure MicroTilesClearUsed(var MicroTiles: TMicroTiles; const Value: TMicroTile); var I: Integer; begin for I := MicroTiles.BoundsUsedTiles.Top to MicroTiles.BoundsUsedTiles.Bottom do FillLongword(MicroTiles.Tiles^[I * MicroTiles.Columns + MicroTiles.BoundsUsedTiles.Left], MicroTiles.BoundsUsedTiles.Right - MicroTiles.BoundsUsedTiles.Left + 1, Value); MicroTiles.BoundsUsedTiles := MakeRect(MicroTiles.Columns, MicroTiles.Rows, 0, 0); end; procedure MicroTilesCopy(var DstTiles: TMicroTiles; SrcTiles: TMicroTiles); var CurRow, Width: Integer; SrcTilePtr, DstTilePtr: PMicroTile; begin if Assigned(DstTiles.Tiles) and (DstTiles.Count > 0) then MicroTilesClearUsed(DstTiles); DstTiles.BoundsRect := SrcTiles.BoundsRect; DstTiles.Columns := SrcTiles.Columns; DstTiles.Rows := SrcTiles.Rows; DstTiles.BoundsUsedTiles := SrcTiles.BoundsUsedTiles; ReallocMem(DstTiles.Tiles, SrcTiles.Count * SizeOf(TMicroTile)); if DstTiles.Count < SrcTiles.Count then FillLongword(DstTiles.Tiles^[DstTiles.Count], SrcTiles.Count - DstTiles.Count, MICROTILE_EMPTY); DstTiles.Count := SrcTiles.Count; SrcTilePtr := @SrcTiles.Tiles^[SrcTiles.BoundsUsedTiles.Top * SrcTiles.Columns + SrcTiles.BoundsUsedTiles.Left]; DstTilePtr := @DstTiles.Tiles^[SrcTiles.BoundsUsedTiles.Top * DstTiles.Columns + SrcTiles.BoundsUsedTiles.Left]; Width := SrcTiles.BoundsUsedTiles.Right - SrcTiles.BoundsUsedTiles.Left + 1; for CurRow := SrcTiles.BoundsUsedTiles.Top to SrcTiles.BoundsUsedTiles.Bottom do begin MoveLongword(SrcTilePtr^, DstTilePtr^, Width); Inc(DstTilePtr, DstTiles.Columns); Inc(SrcTilePtr, SrcTiles.Columns); end end; procedure MicroTilesAddLine(var MicroTiles: TMicroTiles; X1, Y1, X2, Y2: Integer; LineWidth: Integer; RoundToWholeTiles: Boolean = False); var i: Integer; DeltaX, DeltaY: Integer; SignX, SignY: Integer; Rects: Integer; NewX, NewY: Integer; TempRect: TRect; begin LineWidth := (LineWidth + 1) shr 1; // Half line width rounded up DeltaX := X2 - X1; if DeltaX < 0 then begin // Make sure DeltaX*Sign is positive Swap(X1, X2); Swap(Y1, Y2); DeltaX := -DeltaX; SignX := 1 end else if DeltaX > 0 then SignX := 1 else // DeltaX = 0 begin TempRect := MakeRect(X1, Y1, X2, Y2); InflateArea(TempRect, LineWidth, LineWidth); MicroTilesAddRect(MicroTiles, TempRect, RoundToWholeTiles); Exit; end; DeltaY := Y2 - Y1; if DeltaY > 0 then SignY := 1 else if DeltaY < 0 then begin DeltaY := -DeltaY; SignY := -1; end else // DeltaY = 0 begin TempRect := MakeRect(X1, Y1, X2, Y2); InflateArea(TempRect, LineWidth, LineWidth); MicroTilesAddRect(MicroTiles, TempRect, RoundToWholeTiles); Exit; end; X1 := X1 * FixedOne; Y1 := Y1 * FixedOne; DeltaX := DeltaX * FixedOne; DeltaY := DeltaY * FixedOne; if DeltaX >= DeltaY then begin Rects := DeltaX div MICROTILE_SIZE; DeltaX := SignX * MICROTILE_SIZE * FixedOne; DeltaY := SignY * FixedDiv(DeltaY, Rects); end else begin Rects := DeltaY div MICROTILE_SIZE; DeltaY := SignY * MICROTILE_SIZE * FixedOne; DeltaX := SignX * FixedDiv(DeltaX, Rects); end; for i := 1 to FixedCeil(Rects) do begin NewX := X1 + DeltaX; NewY := Y1 + DeltaY; // Make sure rect is positive or MakeRect will not round correctly if (SignY >= 0) then TempRect := MakeRect(FixedRect(X1, Y1, NewX, NewY), rrOutside) else TempRect := MakeRect(FixedRect(X1, NewY, NewX, Y1), rrOutside); InflateArea(TempRect, LineWidth, LineWidth); MicroTilesAddRect(MicroTiles, TempRect, RoundToWholeTiles); X1 := NewX; Y1 := NewY; end; end; procedure MicroTilesAddRect(var MicroTiles: TMicroTiles; Rect: TRect; RoundToWholeTiles: Boolean); var ModLeft, ModRight, ModTop, ModBottom, Temp: Integer; LeftTile, TopTile, RightTile, BottomTile, ColSpread, RowSpread: Integer; CurRow, CurCol: Integer; TilePtr, TilePtr2: PMicroTile; begin if MicroTiles.Count = 0 then Exit; with Rect do begin TestSwap(Left, Right); TestSwap(Top, Bottom); if Left < 0 then Left := 0; if Top < 0 then Top := 0; Temp := MicroTiles.Columns shl MICROTILE_SHIFT; if Right > Temp then Right := Temp; Temp := MicroTiles.Rows shl MICROTILE_SHIFT; if Bottom > Temp then Bottom := Temp; if (Left > Right) or (Top > Bottom) then Exit; end; LeftTile := Rect.Left shr MICROTILE_SHIFT; TopTile := Rect.Top shr MICROTILE_SHIFT; RightTile := Rect.Right shr MICROTILE_SHIFT; BottomTile := Rect.Bottom shr MICROTILE_SHIFT; TilePtr := @MicroTiles.Tiles^[TopTile * MicroTiles.Columns + LeftTile]; if RoundToWholeTiles then begin for CurRow := TopTile to BottomTile do begin FillLongword(TilePtr^, RightTile - LeftTile + 1, MICROTILE_FULL); Inc(TilePtr, MicroTiles.Columns); end; end else begin // calculate number of tiles needed in columns and rows ColSpread := ((Rect.Right + MICROTILE_SIZE) shr MICROTILE_SHIFT) - (Rect.Left shr MICROTILE_SHIFT); RowSpread := ((Rect.Bottom + MICROTILE_SIZE) shr MICROTILE_SHIFT) - (Rect.Top shr MICROTILE_SHIFT); ModLeft := Rect.Left mod MICROTILE_SIZE; ModTop := Rect.Top mod MICROTILE_SIZE; ModRight := Rect.Right mod MICROTILE_SIZE; ModBottom := Rect.Bottom mod MICROTILE_SIZE; if (ColSpread = 1) and (RowSpread = 1) then MicroTileUnion(TilePtr^, MakeMicroTile(ModLeft, ModTop, ModRight, ModBottom)) else if ColSpread = 1 then begin MicroTileUnion(TilePtr^, MakeMicroTile(ModLeft, ModTop, ModRight, MICROTILE_SIZE)); Inc(TilePtr, MicroTiles.Columns); if RowSpread > 2 then for CurCol := TopTile + 1 to BottomTile - 1 do begin MicroTileUnion(TilePtr^, MakeMicroTile(ModLeft, 0, ModRight, MICROTILE_SIZE)); Inc(TilePtr, MicroTiles.Columns); end; MicroTileUnion(TilePtr^, MakeMicroTile(ModLeft, 0, ModRight, ModBottom)); end else if RowSpread = 1 then begin MicroTileUnion(TilePtr^, MakeMicroTile(ModLeft, ModTop, MICROTILE_SIZE, ModBottom)); Inc(TilePtr); if ColSpread > 2 then for CurRow := LeftTile + 1 to RightTile - 1 do begin MicroTileUnion(TilePtr^, MakeMicroTile(0, ModTop, MICROTILE_SIZE, ModBottom)); Inc(TilePtr); end; MicroTileUnion(TilePtr^, MakeMicroTile(0, ModTop, ModRight, ModBottom)); end else begin TilePtr2 := TilePtr; // TOP: // render top-left corner MicroTileUnion(TilePtr2^, MakeMicroTile(ModLeft, ModTop, MICROTILE_SIZE, MICROTILE_SIZE)); Inc(TilePtr2); // render top edge if ColSpread > 2 then for CurRow := LeftTile + 1 to RightTile - 1 do begin MicroTileUnion(TilePtr2^, MakeMicroTile(0, ModTop, MICROTILE_SIZE, MICROTILE_SIZE)); Inc(TilePtr2); end; // render top-right corner MicroTileUnion(TilePtr2^, MakeMicroTile(0, ModTop, ModRight, MICROTILE_SIZE)); Inc(TilePtr, MicroTiles.Columns); // INTERMEDIATE AREA: if RowSpread > 2 then for CurCol := TopTile + 1 to BottomTile - 1 do begin TilePtr2 := TilePtr; // render left edge MicroTileUnion(TilePtr2^, MakeMicroTile(ModLeft, 0, MICROTILE_SIZE, MICROTILE_SIZE)); Inc(TilePtr2); // render content if ColSpread > 2 then begin FillLongword(TilePtr2^, RightTile - LeftTile - 1, MICROTILE_FULL); Inc(TilePtr2, RightTile - LeftTile - 1); end; // render right edge MicroTileUnion(TilePtr2^, MakeMicroTile(0, 0, ModRight, MICROTILE_SIZE)); Inc(TilePtr, MicroTiles.Columns); end; TilePtr2 := TilePtr; // BOTTOM: // render bottom-left corner MicroTileUnion(TilePtr2^, MakeMicroTile(ModLeft, 0, MICROTILE_SIZE, ModBottom)); Inc(TilePtr2); // render bottom edge if ColSpread > 2 then for CurRow := LeftTile + 1 to RightTile - 1 do begin MicroTileUnion(TilePtr2^, MakeMicroTile(0, 0, MICROTILE_SIZE, ModBottom)); Inc(TilePtr2); end; // render bottom-right corner MicroTileUnion(TilePtr2^, MakeMicroTile(0, 0, ModRight, ModBottom)); end; end; with MicroTiles.BoundsUsedTiles do begin if LeftTile < Left then Left := LeftTile; if TopTile < Top then Top := TopTile; if RightTile > Right then Right := RightTile; if BottomTile > Bottom then Bottom := BottomTile; end; end; procedure MicroTilesUnion_Pas(var DstTiles: TMicroTiles; const SrcTiles: TMicroTiles); var SrcTilePtr, DstTilePtr: PMicroTile; SrcTilePtr2, DstTilePtr2: PMicroTile; X, Y: Integer; SrcLeft, SrcTop, SrcRight, SrcBottom: Integer; SrcTile: TMicroTile; begin SrcTilePtr := @SrcTiles.Tiles^[SrcTiles.BoundsUsedTiles.Top * SrcTiles.Columns + SrcTiles.BoundsUsedTiles.Left]; DstTilePtr := @DstTiles.Tiles^[SrcTiles.BoundsUsedTiles.Top * DstTiles.Columns + SrcTiles.BoundsUsedTiles.Left]; for Y := SrcTiles.BoundsUsedTiles.Top to SrcTiles.BoundsUsedTiles.Bottom do begin SrcTilePtr2 := SrcTilePtr; DstTilePtr2 := DstTilePtr; for X := SrcTiles.BoundsUsedTiles.Left to SrcTiles.BoundsUsedTiles.Right do begin SrcTile := SrcTilePtr2^; SrcLeft := SrcTile shr 24; SrcTop := (SrcTile and $FF0000) shr 16; SrcRight := (SrcTile and $FF00) shr 8; SrcBottom := SrcTile and $FF; if (DstTilePtr2^ <> MICROTILE_FULL) and (SrcTilePtr2^ <> MICROTILE_EMPTY) and (SrcRight - SrcLeft <> 0) and (SrcBottom - SrcTop <> 0) then begin if (DstTilePtr2^ = MICROTILE_EMPTY) or (SrcTilePtr2^ = MICROTILE_FULL) then DstTilePtr2^ := SrcTilePtr2^ else DstTilePtr2^ := Min(DstTilePtr2^ shr 24, SrcLeft) shl 24 or Min(DstTilePtr2^ shr 16 and $FF, SrcTop) shl 16 or Max(DstTilePtr2^ shr 8 and $FF, SrcRight) shl 8 or Max(DstTilePtr2^ and $FF, SrcBottom); end; Inc(DstTilePtr2); Inc(SrcTilePtr2); end; Inc(DstTilePtr, DstTiles.Columns); Inc(SrcTilePtr, SrcTiles.Columns); end; end; // TODO : rewrite MMX implementations using SSE {$if (not defined(PUREPASCAL)) and (not defined(OMIT_MMX)) and defined(TARGET_x86)} procedure MicroTilesUnion_EMMX(var DstTiles: TMicroTiles; const SrcTiles: TMicroTiles); var SrcTilePtr, DstTilePtr: PMicroTile; SrcTilePtr2, DstTilePtr2: PMicroTile; X, Y: Integer; SrcLeft, SrcTop, SrcRight, SrcBottom: Integer; begin SrcTilePtr := @SrcTiles.Tiles^[SrcTiles.BoundsUsedTiles.Top * SrcTiles.Columns + SrcTiles.BoundsUsedTiles.Left]; DstTilePtr := @DstTiles.Tiles^[SrcTiles.BoundsUsedTiles.Top * DstTiles.Columns + SrcTiles.BoundsUsedTiles.Left]; asm MOV ECX, $FFFF // Mask MOVD MM0, ECX MOVQ MM4, MM0 PSLLD MM4, 16 // shift mask left by 16 bits end; for Y := SrcTiles.BoundsUsedTiles.Top to SrcTiles.BoundsUsedTiles.Bottom do begin SrcTilePtr2 := SrcTilePtr; DstTilePtr2 := DstTilePtr; for X := SrcTiles.BoundsUsedTiles.Left to SrcTiles.BoundsUsedTiles.Right do begin SrcLeft := SrcTilePtr2^ shr 24; SrcTop := (SrcTilePtr2^ and $FF0000) shr 16; SrcRight := (SrcTilePtr2^ and $FF00) shr 8; SrcBottom := SrcTilePtr2^ and $FF; if (DstTilePtr2^ <> MICROTILE_FULL) and (SrcTilePtr2^ <> MICROTILE_EMPTY) and (SrcRight - SrcLeft <> 0) and (SrcBottom - SrcTop <> 0) then begin if (DstTilePtr2^ = MICROTILE_EMPTY) or (SrcTilePtr2^ = MICROTILE_FULL) then DstTilePtr2^ := SrcTilePtr2^ else asm MOV EAX, [DstTilePtr2] MOVD MM2, [EAX] MOV ECX, [SrcTilePtr2] MOVD MM1, [ECX] MOVQ MM3, MM1 PMINUB MM1, MM2 PAND MM1, MM4 PMAXUB MM2, MM3 PAND MM2, MM0 POR MM1, MM2 MOVD [EAX], MM1 end; end; Inc(DstTilePtr2); Inc(SrcTilePtr2); end; Inc(DstTilePtr, DstTiles.Columns); Inc(SrcTilePtr, SrcTiles.Columns); end; asm db $0F,$77 /// EMMS end; end; {$ifend} procedure MicroTilesUnion(var DstTiles: TMicroTiles; const SrcTiles: TMicroTiles; RoundToWholeTiles: Boolean); var SrcTilePtr, DstTilePtr: PMicroTile; SrcTilePtr2, DstTilePtr2: PMicroTile; X, Y: Integer; SrcLeft, SrcTop, SrcRight, SrcBottom: Integer; begin if SrcTiles.Count = 0 then Exit; if RoundToWholeTiles then begin SrcTilePtr := @SrcTiles.Tiles^[SrcTiles.BoundsUsedTiles.Top * SrcTiles.Columns + SrcTiles.BoundsUsedTiles.Left]; DstTilePtr := @DstTiles.Tiles^[SrcTiles.BoundsUsedTiles.Top * DstTiles.Columns + SrcTiles.BoundsUsedTiles.Left]; for Y := SrcTiles.BoundsUsedTiles.Top to SrcTiles.BoundsUsedTiles.Bottom do begin SrcTilePtr2 := SrcTilePtr; DstTilePtr2 := DstTilePtr; for X := SrcTiles.BoundsUsedTiles.Left to SrcTiles.BoundsUsedTiles.Right do begin SrcLeft := SrcTilePtr2^ shr 24; SrcTop := (SrcTilePtr2^ and $FF0000) shr 16; SrcRight := (SrcTilePtr2^ and $FF00) shr 8; SrcBottom := SrcTilePtr2^ and $FF; if (DstTilePtr2^ <> MICROTILE_FULL) and (SrcTilePtr2^ <> MICROTILE_EMPTY) and (SrcRight - SrcLeft <> 0) and (SrcBottom - SrcTop <> 0) then DstTilePtr2^ := MICROTILE_FULL; Inc(DstTilePtr2); Inc(SrcTilePtr2); end; Inc(DstTilePtr, DstTiles.Columns); Inc(SrcTilePtr, SrcTiles.Columns); end end else MicroTilesU(DstTiles, SrcTiles); with DstTiles.BoundsUsedTiles do begin if SrcTiles.BoundsUsedTiles.Left < Left then Left := SrcTiles.BoundsUsedTiles.Left; if SrcTiles.BoundsUsedTiles.Top < Top then Top := SrcTiles.BoundsUsedTiles.Top; if SrcTiles.BoundsUsedTiles.Right > Right then Right := SrcTiles.BoundsUsedTiles.Right; if SrcTiles.BoundsUsedTiles.Bottom > Bottom then Bottom := SrcTiles.BoundsUsedTiles.Bottom; end; end; function MicroTilesCalcRects(const MicroTiles: TMicroTiles; DstRects: TRectList; CountOnly, RoundToWholeTiles: Boolean): Integer; begin Result := MicroTilesCalcRects(MicroTiles, DstRects, MicroTiles.BoundsRect, CountOnly); end; function MicroTilesCalcRects(const MicroTiles: TMicroTiles; DstRects: TRectList; const Clip: TRect; CountOnly, RoundToWholeTiles: Boolean): Integer; var Rects: Array Of TRect; Rect: PRect; CombLUT: Array Of Integer; StartIndex: Integer; CurTile, TempTile: TMicroTile; Temp: Integer; NewLeft, NewTop, NewRight, NewBottom: Integer; CurCol, CurRow, I, RectsCount: Integer; begin Result := 0; if (MicroTiles.Count = 0) or (MicroTiles.BoundsUsedTiles.Right < MicroTiles.BoundsUsedTiles.Left) or (MicroTiles.BoundsUsedTiles.Bottom < MicroTiles.BoundsUsedTiles.Top) then Exit; SetLength(Rects, MicroTiles.Columns * MicroTiles.Rows); SetLength(CombLUT, MicroTiles.Columns * MicroTiles.Rows); FillLongword(CombLUT[0], Length(CombLUT), Cardinal(-1)); I := 0; RectsCount := 0; if not RoundToWholeTiles then for CurRow := 0 to MicroTiles.Rows - 1 do begin CurCol := 0; while CurCol < MicroTiles.Columns do begin CurTile := MicroTiles.Tiles[I]; if CurTile <> MICROTILE_EMPTY then begin Temp := CurRow shl MICROTILE_SHIFT; NewTop := Constrain(Temp + CurTile shr 16 and $FF, Clip.Top, Clip.Bottom); NewBottom := Constrain(Temp + CurTile and $FF, Clip.Top, Clip.Bottom); NewLeft := Constrain(CurCol shl MICROTILE_SHIFT + CurTile shr 24, Clip.Left, Clip.Right); StartIndex := I; if (CurTile shr 8 and $FF = MICROTILE_SIZE) and (CurCol <> MicroTiles.Columns - 1) then begin while True do begin Inc(CurCol); Inc(I); TempTile := MicroTiles.Tiles[I]; if (CurCol = MicroTiles.Columns) or (TempTile shr 16 and $FF <> CurTile shr 16 and $FF) or (TempTile and $FF <> CurTile and $FF) or (TempTile shr 24 <> 0) then begin Dec(CurCol); Dec(I); Break; end; end; end; NewRight := Constrain(CurCol shl MICROTILE_SHIFT + MicroTiles.Tiles[I] shr 8 and $FF, Clip.Left, Clip.Right); Temp := CombLUT[StartIndex]; Rect := nil; if Temp <> -1 then Rect := @Rects[Temp]; if Assigned(Rect) and (Rect.Left = NewLeft) and (Rect.Right = NewRight) and (Rect.Bottom = NewTop) then begin Rect.Bottom := NewBottom; if CurRow <> MicroTiles.Rows - 1 then CombLUT[StartIndex + MicroTiles.Columns] := Temp; end else with Rects[RectsCount] do begin Left := NewLeft; Top := NewTop; Right := NewRight; Bottom := NewBottom; if CurRow <> MicroTiles.Rows - 1 then CombLUT[StartIndex + MicroTiles.Columns] := RectsCount; Inc(RectsCount); end; end; Inc(I); Inc(CurCol); end; end else for CurRow := 0 to MicroTiles.Rows - 1 do begin CurCol := 0; while CurCol < MicroTiles.Columns do begin CurTile := MicroTiles.Tiles[I]; if CurTile <> MICROTILE_EMPTY then begin Temp := CurRow shl MICROTILE_SHIFT; NewTop := Constrain(Temp, Clip.Top, Clip.Bottom); NewBottom := Constrain(Temp + MICROTILE_SIZE, Clip.Top, Clip.Bottom); NewLeft := Constrain(CurCol shl MICROTILE_SHIFT, Clip.Left, Clip.Right); StartIndex := I; if CurCol <> MicroTiles.Columns - 1 then begin while True do begin Inc(CurCol); Inc(I); TempTile := MicroTiles.Tiles[I]; if (CurCol = MicroTiles.Columns) or (TempTile = MICROTILE_EMPTY) then begin Dec(CurCol); Dec(I); Break; end; end; end; NewRight := Constrain(CurCol shl MICROTILE_SHIFT + MICROTILE_SIZE, Clip.Left, Clip.Right); Temp := CombLUT[StartIndex]; Rect := nil; if Temp <> -1 then Rect := @Rects[Temp]; if Assigned(Rect) and (Rect.Left = NewLeft) and (Rect.Right = NewRight) and (Rect.Bottom = NewTop) then begin Rect.Bottom := NewBottom; if CurRow <> MicroTiles.Rows - 1 then CombLUT[StartIndex + MicroTiles.Columns] := Temp; end else with Rects[RectsCount] do begin Left := NewLeft; Top := NewTop; Right := NewRight; Bottom := NewBottom; if CurRow <> MicroTiles.Rows - 1 then CombLUT[StartIndex + MicroTiles.Columns] := RectsCount; Inc(RectsCount); end; end; Inc(I); Inc(CurCol); end; end; Result := RectsCount; if not CountOnly then for I := 0 to RectsCount - 1 do DstRects.Add(Rects[I]); end; function MicroTilesCountEmptyTiles(const MicroTiles: TMicroTiles): Integer; var CurRow, CurCol: Integer; TilePtr: PMicroTile; begin Result := 0; if MicroTiles.Count > 0 then begin TilePtr := @MicroTiles.Tiles^[0]; for CurRow := 0 to MicroTiles.Rows - 1 do for CurCol := 0 to MicroTiles.Columns - 1 do begin if TilePtr^ = MICROTILE_EMPTY then Inc(Result); Inc(TilePtr); end; end; end; {$IFDEF MICROTILES_DEBUGDRAW} procedure MicroTilesDebugDraw(const MicroTiles: TMicroTiles; DstBitmap: TBitmap32; DrawOptimized, RoundToWholeTiles: Boolean); var I: Integer; TempRect: TRect; Rects: TRectList; C1, C2: TColor32; begin {$IFDEF MICROTILES_DEBUGDRAW_RANDOM_COLORS} C1 := Random(MaxInt) AND $00FFFFFF; C2 := C1 OR $90000000; C1 := C1 OR $30000000; {$ELSE} C1 := clDebugDrawFill; C2 := clDebugDrawFrame; {$ENDIF} if DrawOptimized then begin Rects := TRectList.Create; MicroTilesCalcRects(MicroTiles, Rects, False, RoundToWholeTiles); try if Rects.Count > 0 then begin for I := 0 to Rects.Count - 1 do begin DstBitmap.FillRectTS(Rects[I]^, C1); DstBitmap.FrameRectTS(Rects[I]^, C2); end; end finally Rects.Free; end; end else for I := 0 to MicroTiles.Count - 1 do begin if MicroTiles.Tiles^[i] <> MICROTILE_EMPTY then begin TempRect.Left := ((I mod MicroTiles.Columns) shl MICROTILE_SHIFT) + (MicroTiles.Tiles[i] shr 24); TempRect.Top := ((I div MicroTiles.Columns) shl MICROTILE_SHIFT) + (MicroTiles.Tiles[i] shr 16 and $FF); TempRect.Right := ((I mod MicroTiles.Columns) shl MICROTILE_SHIFT) + (MicroTiles.Tiles[i] shr 8 and $FF); TempRect.Bottom := ((I div MicroTiles.Columns) shl MICROTILE_SHIFT) + (MicroTiles.Tiles[i] and $FF); DstBitmap.FillRectTS(TempRect, C1); DstBitmap.FrameRectTS(TempRect, C2); end; end; end; {$ENDIF} { TMicroTilesMap } function TMicroTilesMap.Add(Item: Pointer): PPMicroTiles; var TilesPtr: PMicroTiles; IsNew: Boolean; begin Result := PPMicroTiles(inherited Add(Item, IsNew)); if IsNew then begin New(TilesPtr); MicroTilesCreate(TilesPtr^); Result^ := TilesPtr; end; end; function TMicroTilesMap.Delete(BucketIndex, ItemIndex: Integer): Pointer; var TilesPtr: PMicroTiles; begin TilesPtr := inherited Delete(BucketIndex, ItemIndex); MicroTilesDestroy(TilesPtr^); Dispose(TilesPtr); Result := nil; end; procedure TMicroTilesMap.SetData(Item: Pointer; const Data: PMicroTiles); begin inherited SetData(Item, Data); end; function TMicroTilesMap.GetData(Item: Pointer): PMicroTiles; begin Result := inherited GetData(Item); end; { TMicroTilesRepaintManager } type TCustomLayerAccess = class(TCustomLayer); const PL_MICROTILES = 0; PL_WHOLETILES = 1; PL_FULLSCENE = 2; TIMER_PENALTY = 250; TIMER_LOWLIMIT = 1000; TIMER_HIGHLIMIT = 5000; INVALIDRECTS_DELTA = 10; constructor TMicroTilesRepaintOptimizer.Create(Buffer: TBitmap32; InvalidRects: TRectList); begin inherited; FOldInvalidTilesMap := TMicroTilesMap.Create; FInvalidLayers := TList.Create; {$IFNDEF MICROTILES_DEBUGDRAW} {$IFNDEF MICROTILES_NO_ADAPTION} FAdaptiveMode := True; {$ENDIF} {$ENDIF} MicroTilesCreate(FInvalidTiles); MicroTilesCreate(FTempTiles); MicroTilesCreate(FForcedInvalidTiles); {$IFDEF MICROTILES_DEBUGDRAW} MicroTilesCreate(FDebugMicroTiles); FDebugInvalidRects := TRectList.Create; {$ENDIF} end; destructor TMicroTilesRepaintOptimizer.Destroy; begin MicroTilesDestroy(FForcedInvalidTiles); MicroTilesDestroy(FTempTiles); MicroTilesDestroy(FInvalidTiles); FInvalidLayers.Free; FOldInvalidTilesMap.Free; {$IFDEF MICROTILES_DEBUGDRAW} FDebugInvalidRects.Free; MicroTilesDestroy(FDebugMicroTiles); {$ENDIF} inherited; end; procedure TMicroTilesRepaintOptimizer.AddArea(var Tiles: TMicroTiles; const Area: TRect; const Info: Cardinal); var LineWidth: Integer; begin if Info and AREAINFO_LINE <> 0 then begin LineWidth := Info and $00FFFFFF; with Area do MicroTilesAddLine(Tiles, Left, Top, Right, Bottom, LineWidth, FPerformanceLevel > PL_MICROTILES); end else MicroTilesAddRect(Tiles, Area, FPerformanceLevel > PL_MICROTILES); end; procedure TMicroTilesRepaintOptimizer.LayerUpdated(ALayer: TCustomLayer); begin if not Enabled then exit; {$IFDEF CODESITE} DumpCallStack('TMicroTilesRepaintOptimizer.LayerUpdated'); {$ENDIF} if (FOldInvalidTilesValid) and (not TCustomLayerAccess(ALayer).Invalid) then begin FInvalidLayers.Add(ALayer); TCustomLayerAccess(ALayer).Invalid := True; FUseInvalidTiles := True; end; end; procedure TMicroTilesRepaintOptimizer.AreaUpdated(const AArea: TRect; const AInfo: Cardinal); begin if not Enabled then exit; {$IFDEF CODESITE} DumpCallStack('TMicroTilesRepaintOptimizer.AreaUpdated'); {$ENDIF} ValidateWorkingTiles; AddArea(FForcedInvalidTiles, AArea, AInfo); FUseInvalidTiles := True; end; procedure TMicroTilesRepaintOptimizer.LayerListNotify(ALayer: TCustomLayer; AAction: TLayerListNotification; AIndex: Integer); var TilesPtr: PMicroTiles; begin if not Enabled then exit; {$IFDEF CODESITE} DumpCallStack('TMicroTilesRepaintOptimizer.LayerListNotify'); {$ENDIF} case AAction of lnLayerAdded, lnLayerInserted: begin TilesPtr := FOldInvalidTilesMap.Add(ALayer)^; MicroTilesSetSize(TilesPtr^, Buffer.BoundsRect); FOldInvalidTilesValid := True; end; lnLayerDeleted: begin if FOldInvalidTilesValid then begin // force repaint of tiles that the layer did previously allocate MicroTilesUnion(FInvalidTiles, FOldInvalidTilesMap[ALayer]^); FUseInvalidTiles := True; end; FInvalidLayers.Remove(ALayer); FOldInvalidTilesMap.Remove(ALayer); end; lnCleared: begin if FOldInvalidTilesValid then begin with TPointerMapIterator.Create(FOldInvalidTilesMap) do try while Next do MicroTilesUnion(FInvalidTiles, PMicroTiles(Data)^); finally Free; end; FUseInvalidTiles := True; ResetAdaptiveMode; end; FOldInvalidTilesMap.Clear; FOldInvalidTilesValid := True; end; end; end; procedure TMicroTilesRepaintOptimizer.ValidateWorkingTiles; begin if not FWorkingTilesValid then // check if working microtiles need resize... begin MicroTilesSetSize(FTempTiles, FBufferBounds); MicroTilesSetSize(FInvalidTiles, FBufferBounds); MicroTilesSetSize(FForcedInvalidTiles, FBufferBounds); FWorkingTilesValid := True; end; end; procedure TMicroTilesRepaintOptimizer.BufferResizedHandler(const NewWidth, NewHeight: Integer); begin FBufferBounds := MakeRect(0, 0, NewWidth, NewHeight); Reset; end; procedure TMicroTilesRepaintOptimizer.Reset; begin FWorkingTilesValid := False; // force resizing of working microtiles FOldInvalidTilesValid := False; // force resizing and rerendering of invalid tiles UpdateOldInvalidTiles; // mark whole buffer area invalid... MicroTilesClear(FForcedInvalidTiles, MICROTILE_FULL); FForcedInvalidTiles.BoundsUsedTiles := MakeRect(0, 0, FForcedInvalidTiles.Columns, FForcedInvalidTiles.Rows); FUseInvalidTiles := True; end; function TMicroTilesRepaintOptimizer.UpdatesAvailable: Boolean; begin UpdateOldInvalidTiles; Result := FUseInvalidTiles; end; procedure TMicroTilesRepaintOptimizer.UpdateOldInvalidTiles; var I, J: Integer; TilesPtr: PMicroTiles; Layer: TCustomLayer; LayerCollection: TLayerCollection; begin if FOldInvalidTilesValid then // check if old Invalid tiles need resize and rerendering... exit; ValidateWorkingTiles; if (LayerCollections <> nil) then for I := 0 to LayerCollections.Count - 1 do begin LayerCollection := LayerCollections[I]; for J := 0 to LayerCollection.Count - 1 do begin Layer := LayerCollection[J]; TilesPtr := FOldInvalidTilesMap.Add(Layer)^; MicroTilesSetSize(TilesPtr^, FBufferBounds); if (Layer.Visible) then DrawLayerToMicroTiles(TilesPtr^, Layer); TCustomLayerAccess(Layer).Invalid := False; end; end; FInvalidLayers.Clear; FOldInvalidTilesValid := True; FUseInvalidTiles := False; end; procedure TMicroTilesRepaintOptimizer.SetEnabled(const Value: Boolean); begin if (Value = Enabled) then exit; if Value then BufferResizedHandler(Buffer.Width, Buffer.Height) else begin MicroTilesDestroy(FInvalidTiles); MicroTilesDestroy(FTempTiles); MicroTilesDestroy(FForcedInvalidTiles); FUseInvalidTiles := False; FOldInvalidTilesValid := False; FOldInvalidTilesMap.Clear; FInvalidLayers.Clear; end; inherited; end; procedure TMicroTilesRepaintOptimizer.SetAdaptiveMode(const Value: Boolean); begin if FAdaptiveMode <> Value then begin FAdaptiveMode := Value; ResetAdaptiveMode; end; end; procedure TMicroTilesRepaintOptimizer.ResetAdaptiveMode; begin FTimeDelta := TIMER_LOWLIMIT; FAdaptionFailed := False; FPerformanceLevel := PL_MICROTILES; end; procedure TMicroTilesRepaintOptimizer.BeginPaintBuffer; begin if AdaptiveMode then FPerfTimer := TStopWatch.StartNew; end; procedure TMicroTilesRepaintOptimizer.EndPaintBuffer; begin FUseInvalidTiles := False; {$IFDEF MICROTILES_DEBUGDRAW} {$IFDEF MICROTILES_DEBUGDRAW_UNOPTIMIZED} MicroTilesDebugDraw(FDebugMicroTiles, Buffer, False, FDebugWholeTiles); {$ELSE} MicroTilesDebugDraw(FDebugMicroTiles, Buffer, True, FDebugWholeTiles); {$ENDIF} MicroTilesClear(FDebugMicroTiles); {$ENDIF} {$IFNDEF MICROTILES_NO_ADAPTION} EndAdaption; {$ENDIF} end; procedure TMicroTilesRepaintOptimizer.DrawLayerToMicroTiles(var DstTiles: TMicroTiles; Layer: TCustomLayer); begin Buffer.BeginMeasuring(DrawMeasuringHandler); FWorkMicroTiles := @DstTiles; TCustomLayerAccess(Layer).DoPaint(Buffer); Buffer.EndMeasuring; end; procedure TMicroTilesRepaintOptimizer.DrawMeasuringHandler(Sender: TObject; const Area: TRect; const Info: Cardinal); begin AddArea(FWorkMicroTiles^, Area, Info); end; procedure TMicroTilesRepaintOptimizer.PerformOptimization; var I: Integer; Layer: TCustomLayer; UseWholeTiles: Boolean; LayerTilesPtr: PMicroTiles; begin if FUseInvalidTiles then begin ValidateWorkingTiles; // Determine if the use of whole tiles is better for current performance level {$IFNDEF MICROTILES_NO_ADAPTION} UseWholeTiles := FPerformanceLevel > PL_MICROTILES; {$ELSE} {$IFDEF MICROTILES_NO_ADAPTION_FORCE_WHOLETILES} UseWholeTiles := True; {$ELSE} UseWholeTiles := False; {$ENDIF} {$ENDIF} if FInvalidLayers.Count > 0 then begin for I := 0 to FInvalidLayers.Count - 1 do begin Layer := FInvalidLayers[I]; if (not Layer.Visible) then continue; // Clear temporary tiles MicroTilesClearUsed(FTempTiles); // Draw layer to temporary tiles DrawLayerToMicroTiles(FTempTiles, Layer); // Combine temporary tiles with the global invalid tiles MicroTilesUnion(FInvalidTiles, FTempTiles, UseWholeTiles); // Retrieve old invalid tiles for the current layer LayerTilesPtr := FOldInvalidTilesMap[Layer]; // Combine old invalid tiles with the global invalid tiles MicroTilesUnion(FInvalidTiles, LayerTilesPtr^, UseWholeTiles); // Copy temporary (current) invalid tiles to the layer MicroTilesCopy(LayerTilesPtr^, FTempTiles); // Unmark layer as invalid TCustomLayerAccess(Layer).Invalid := False; end; FInvalidLayers.Clear; end; // Create union of global invalid tiles and forced invalid tiles MicroTilesUnion(FInvalidTiles, FForcedInvalidTiles); // Calculate optimized rectangles from combined tiles MicroTilesCalcRects(FInvalidTiles, InvalidRects, False, UseWholeTiles); {$IFDEF MICROTILES_DEBUGDRAW} MicroTilesCopy(FDebugMicroTiles, FInvalidTiles); FDebugWholeTiles := UseWholeTiles; {$ENDIF} end; {$IFNDEF MICROTILES_NO_ADAPTION} BeginAdaption; {$ENDIF} {$IFDEF MICROTILES_DEBUGDRAW} if InvalidRects.Count > 0 then begin FDebugInvalidRects.Count := InvalidRects.Count; Move(InvalidRects[0]^, FDebugInvalidRects[0]^, InvalidRects.Count * SizeOf(TRect)); InvalidRects.Clear; end; {$ENDIF} // Rects have been created, so we don't need the tiles any longer, clear them. MicroTilesClearUsed(FInvalidTiles); MicroTilesClearUsed(FForcedInvalidTiles); end; procedure TMicroTilesRepaintOptimizer.BeginAdaption; begin if AdaptiveMode and (FPerformanceLevel > PL_MICROTILES) then begin if Integer(GetTickCount) > FNextCheck then begin FPerformanceLevel := Constrain(FPerformanceLevel - 1, PL_MICROTILES, PL_FULLSCENE); {$IFDEF CODESITE} CodeSite.SendInteger('PrepareInvalidRects(Timed): FPerformanceLevel', FPerformanceLevel); {$ENDIF} FTimedCheck := True; end else if not FAdaptionFailed and (InvalidRects.Count < FOldInvalidRectsCount - INVALIDRECTS_DELTA) then begin FPerformanceLevel := Constrain(FPerformanceLevel - 1, PL_MICROTILES, PL_FULLSCENE); {$IFDEF CODESITE} CodeSite.SendInteger('PrepareInvalidRects: FPerformanceLevel', FPerformanceLevel); {$ENDIF} end else if FPerformanceLevel = PL_FULLSCENE then // we need a full scene rendition, so clear the invalid rects InvalidRects.Clear; end; end; procedure TMicroTilesRepaintOptimizer.EndAdaption; var TimeElapsed: Int64; Level: Integer; begin // our KISS(TM) repaint mode balancing starts here... TimeElapsed := FPerfTimer.ElapsedTicks; {$IFDEF MICROTILES_DEBUGDRAW} if FDebugInvalidRects.Count = 0 then {$ELSE} if InvalidRects.Count = 0 then {$ENDIF} FElapsedTimeForFullSceneRepaint := TimeElapsed else if AdaptiveMode then begin if TimeElapsed > FElapsedTimeForFullSceneRepaint then begin Level := Constrain(FPerformanceLevel + 1, PL_MICROTILES, PL_FULLSCENE); // did performance level change from previous level? if Level <> FPerformanceLevel then begin {$IFDEF MICROTILES_DEBUGDRAW} FOldInvalidRectsCount := FDebugInvalidRects.Count; {$ELSE} // save count of old invalid rects so we can use it in PrepareInvalidRects // the next time... FOldInvalidRectsCount := InvalidRects.Count; {$ENDIF} FPerformanceLevel := Level; {$IFDEF CODESITE} CodeSite.SendInteger('EndPaintBuffer: FPerformanceLevel', FPerformanceLevel); {$ENDIF} // was this a timed check? if FTimedCheck then begin // time based approach failed, so add penalty FTimeDelta := Constrain(Integer(FTimeDelta + TIMER_PENALTY), TIMER_LOWLIMIT, TIMER_HIGHLIMIT); // schedule next check FNextCheck := Integer(GetTickCount) + FTimeDelta; FElapsedTimeOnLastPenalty := TimeElapsed; FTimedCheck := False; {$IFDEF CODESITE} CodeSite.SendInteger('timed check failed, new delta', FTimeDelta); {$ENDIF} end; {$IFDEF CODESITE} CodeSite.AddSeparator; {$ENDIF} FAdaptionFailed := True; end; end else if TimeElapsed < FElapsedTimeForFullSceneRepaint then begin if FTimedCheck then begin // time based approach had success!! // reset time delta back to lower limit, ie. remove penalties FTimeDelta := TIMER_LOWLIMIT; // schedule next check FNextCheck := Integer(GetTickCount) + FTimeDelta; FTimedCheck := False; {$IFDEF CODESITE} CodeSite.SendInteger('timed check succeeded, new delta', FTimeDelta); CodeSite.AddSeparator; {$ENDIF} FAdaptionFailed := False; end else begin // invalid rect count approach had success!! // shorten time for next check to benefit nonetheless in case we have a fallback... if FTimeDelta > TIMER_LOWLIMIT then begin // remove the penalty value 4 times from the current time delta FTimeDelta := Constrain(FTimeDelta - 4 * TIMER_PENALTY, TIMER_LOWLIMIT, TIMER_HIGHLIMIT); // schedule next check FNextCheck := Integer(GetTickCount) + FTimeDelta; {$IFDEF CODESITE} CodeSite.SendInteger('invalid rect count approach succeeded, new timer delta', FTimeDelta); CodeSite.AddSeparator; {$ENDIF} end; FAdaptionFailed := False; end; end else if (TimeElapsed < FElapsedTimeOnLastPenalty) and FTimedCheck then begin // time approach had success optimizing the situation, so shorten time until next check FTimeDelta := Constrain(FTimeDelta - TIMER_PENALTY, TIMER_LOWLIMIT, TIMER_HIGHLIMIT); // schedule next check FNextCheck := Integer(GetTickCount) + FTimeDelta; FTimedCheck := False; {$IFDEF CODESITE} CodeSite.SendInteger('timed check succeeded, new delta', FTimeDelta); CodeSite.AddSeparator; {$ENDIF} end; end; FElapsedTimeForLastRepaint := TimeElapsed; end; {$IFDEF CODESITE} { TDebugMicroTilesRepaintOptimizer } procedure TDebugMicroTilesRepaintOptimizer.BeginPaintBuffer; begin DumpCallStack('TDebugMicroTilesRepaintOptimizer.BeginPaintBuffer'); inherited; end; procedure TDebugMicroTilesRepaintOptimizer.BufferResizedHandler(const NewWidth, NewHeight: Integer); begin DumpCallStack('TDebugMicroTilesRepaintOptimizer.BufferResizedHandler'); inherited; end; procedure TDebugMicroTilesRepaintOptimizer.EndPaintBuffer; begin DumpCallStack('TDebugMicroTilesRepaintOptimizer.EndPaintBuffer'); inherited; CodeSite.AddSeparator; end; procedure TDebugMicroTilesRepaintOptimizer.PerformOptimization; begin DumpCallStack('TDebugMicroTilesRepaintOptimizer.PerformOptimization'); inherited; end; procedure TDebugMicroTilesRepaintOptimizer.Reset; begin DumpCallStack('TDebugMicroTilesRepaintOptimizer.Reset'); inherited; CodeSite.AddSeparator; end; function TDebugMicroTilesRepaintOptimizer.UpdatesAvailable: Boolean; begin DumpCallStack('TDebugMicroTilesRepaintOptimizer.UpdatesAvailable'); Result := inherited UpdatesAvailable; end; {$ENDIF} var Registry: TFunctionRegistry; procedure RegisterBindings; begin Registry := NewRegistry('GR32_MicroTiles bindings'); Registry.RegisterBinding(@@MicroTileUnion, 'MicroTileUnion'); Registry.RegisterBinding(@@MicroTilesU, 'MicroTilesU'); Registry[@@MicroTileUnion].Add( @MicroTileUnion_Pas, [isPascal]).Name := 'MicroTileUnion_Pas'; Registry[@@MicroTilesU].Add( @MicroTilesUnion_Pas, [isPascal]).Name := 'MicroTilesUnion_Pas'; // TODO : rewrite MMX implementations using SSE {$if (not defined(PUREPASCAL)) and (not defined(OMIT_MMX)) and defined(TARGET_x86)} Registry[@@MicroTileUnion].Add( @MicroTileUnion_EMMX, [isExMMX]).Name := 'MicroTileUnion_EMMX'; Registry[@@MicroTilesU].Add( @MicroTilesUnion_EMMX, [isExMMX]).Name := 'MicroTilesUnion_EMMX'; {$ifend} Registry.RebindAll; end; initialization RegisterBindings; end.