source: trunk/Packages/Graphics32/GR32_MicroTiles.pas

Last change on this file was 2, checked in by chronos, 6 years ago
File size: 52.5 KB
Line 
1unit GR32_MicroTiles;
2
3(* ***** BEGIN LICENSE BLOCK *****
4 * Version: MPL 1.1 or LGPL 2.1 with linking exception
5 *
6 * The contents of this file are subject to the Mozilla Public License Version
7 * 1.1 (the "License"); you may not use this file except in compliance with
8 * the License. You may obtain a copy of the License at
9 * http://www.mozilla.org/MPL/
10 *
11 * Software distributed under the License is distributed on an "AS IS" basis,
12 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
13 * for the specific language governing rights and limitations under the
14 * License.
15 *
16 * Alternatively, the contents of this file may be used under the terms of the
17 * Free Pascal modified version of the GNU Lesser General Public License
18 * Version 2.1 (the "FPC modified LGPL License"), in which case the provisions
19 * of this license are applicable instead of those above.
20 * Please see the file LICENSE.txt for additional information concerning this
21 * license.
22 *
23 * The Original Code is MicroTiles Repaint Optimizer Extension for Graphics32
24 *
25 * The Initial Developer of the Original Code is
26 * Andre Beckedorf - metaException
27 * Andre@metaException.de
28 *
29 * Portions created by the Initial Developer are Copyright (C) 2005-2009
30 * the Initial Developer. All Rights Reserved.
31 *
32 * Contributor(s):
33 *
34 * ***** END LICENSE BLOCK ***** *)
35
36interface
37
38{$I GR32.inc}
39{-$DEFINE CODESITE}
40{-$DEFINE CODESITE_HIGH}
41{-$DEFINE PROFILINGDRYRUN}
42{-$DEFINE MICROTILES_DEBUGDRAW}
43 {-$DEFINE MICROTILES_DEBUGDRAW_RANDOM_COLORS}
44 {-$DEFINE MICROTILES_DEBUGDRAW_UNOPTIMIZED}
45{-$DEFINE MICROTILES_NO_ADAPTION}
46 {-$DEFINE MICROTILES_NO_ADAPTION_FORCE_WHOLETILES}
47
48uses
49{$IFDEF FPC}
50 Types,
51 {$IFDEF Windows}
52 Windows,
53 {$ENDIF}
54{$ELSE}
55 Windows,
56{$ENDIF}
57{$IFDEF CODESITE}
58 CSIntf, CSAux,
59{$ENDIF}
60{$IFDEF COMPILER2005_UP}
61 Types,
62{$ENDIF}
63 SysUtils, Classes,
64 GR32, GR32_System, GR32_Containers, GR32_Layers, GR32_RepaintOpt;
65
66const
67 MICROTILE_SHIFT = 5;
68 MICROTILE_SIZE = 1 shl MICROTILE_SHIFT;
69
70 MICROTILE_EMPTY = 0;
71 // MICROTILE_EMPTY -> Left: 0, Top: 0, Right: 0, Bottom: 0
72
73 MICROTILE_FULL = MICROTILE_SIZE shl 8 or MICROTILE_SIZE;
74 // MICROTILE_FULL -> Left: 0, Top: 0, Right: MICROTILE_SIZE, Bottom: MICROTILE_SIZE
75
76 MicroTileSize = MaxInt div 16;
77
78{$IFDEF MICROTILES_DEBUGDRAW}
79 clDebugDrawFill = TColor32($30FF0000);
80 clDebugDrawFrame = TColor32($90FF0000);
81{$ENDIF}
82
83type
84 PMicroTile = ^TMicroTile;
85 TMicroTile = type Integer;
86
87 PMicroTileArray = ^TMicroTileArray;
88 TMicroTileArray = array[0..MicroTileSize - 1] of TMicroTile;
89
90 PPMicroTiles = ^PMicroTiles;
91 PMicroTiles = ^TMicroTiles;
92 TMicroTiles = record
93 BoundsRect: TRect;
94 Columns, Rows: Integer;
95 BoundsUsedTiles: TRect;
96 Count: Integer;
97 Tiles: PMicroTileArray;
98 end;
99
100// MicroTile auxiliary routines
101function MakeMicroTile(const Left, Top, Right, Bottom: Integer): TMicroTile; {$IFDEF USEINLINING} inline; {$ENDIF}
102function MicroTileHeight(const Tile: TMicroTile): Integer; {$IFDEF USEINLINING} inline; {$ENDIF}
103function MicroTileWidth(const Tile: TMicroTile): Integer; {$IFDEF USEINLINING} inline; {$ENDIF}
104
105var
106 MicroTileUnion: procedure(var DstTile: TMicroTile; const SrcTile: TMicroTile);
107
108// MicroTiles auxiliary routines
109function MakeEmptyMicroTiles: TMicroTiles; {$IFDEF USEINLINING} inline; {$ENDIF}
110procedure MicroTilesCreate(var MicroTiles: TMicroTiles); {$IFDEF USEINLINING} inline; {$ENDIF}
111procedure MicroTilesDestroy(var MicroTiles: TMicroTiles); {$IFDEF USEINLINING} inline; {$ENDIF}
112procedure MicroTilesSetSize(var MicroTiles: TMicroTiles; const DstRect: TRect);
113procedure MicroTilesClear(var MicroTiles: TMicroTiles; const Value: TMicroTile = MICROTILE_EMPTY); {$IFDEF USEINLINING} inline; {$ENDIF}
114procedure MicroTilesClearUsed(var MicroTiles: TMicroTiles; const Value: TMicroTile = MICROTILE_EMPTY);
115procedure MicroTilesCopy(var DstTiles: TMicroTiles; SrcTiles: TMicroTiles);
116procedure MicroTilesAddLine(var MicroTiles: TMicroTiles; X1, Y1, X2, Y2: Integer; LineWidth: Integer; RoundToWholeTiles: Boolean = False);
117procedure MicroTilesAddRect(var MicroTiles: TMicroTiles; Rect: TRect; RoundToWholeTiles: Boolean = False);
118procedure MicroTilesUnion(var DstTiles: TMicroTiles; const SrcTiles: TMicroTiles; RoundToWholeTiles: Boolean = False);
119function MicroTilesCalcRects(const MicroTiles: TMicroTiles; DstRects: TRectList; CountOnly: Boolean = False; RoundToWholeTiles: Boolean = False): Integer; overload;
120function MicroTilesCalcRects(const MicroTiles: TMicroTiles; DstRects: TRectList; const Clip: TRect; CountOnly: Boolean = False; RoundToWholeTiles: Boolean = False): Integer; overload;
121function MicroTilesCountEmptyTiles(const MicroTiles: TMicroTiles): Integer;
122
123type
124 { TMicroTilesMap }
125 { associative array that is used to map Layers to their MicroTiles }
126 TMicroTilesMap = class(TPointerMap)
127 private
128 function GetData(Item: Pointer): PMicroTiles;
129 procedure SetData(Item: Pointer; const Data: PMicroTiles);
130 protected
131 function Delete(BucketIndex: Integer; ItemIndex: Integer): Pointer; override;
132 public
133 function Add(Item: Pointer): PPMicroTiles;
134 property Data[Item: Pointer]: PMicroTiles read GetData write SetData; default;
135 end;
136
137
138type
139 { TMicroTilesRepaintOptimizer }
140 { Repaint manager that optimizes the repaint process using MicroTiles }
141 TMicroTilesRepaintOptimizer = class(TCustomRepaintOptimizer)
142 private
143 // working tiles
144 FBufferBounds: TRect;
145 FWorkMicroTiles: PMicroTiles; // used by DrawLayerToMicroTiles
146 FTempTiles: TMicroTiles;
147 FInvalidTiles: TMicroTiles;
148 FForcedInvalidTiles: TMicroTiles;
149
150 // list of invalid layers
151 FInvalidLayers: TList;
152
153 // association that maps layers to their old invalid tiles
154 FOldInvalidTilesMap: TMicroTilesMap;
155
156 FWorkingTilesValid: Boolean;
157 FOldInvalidTilesValid: Boolean;
158 FUseInvalidTiles: Boolean;
159
160 // adaptive stuff...
161 FAdaptiveMode: Boolean;
162
163 FPerfTimer: TPerfTimer;
164 FPerformanceLevel: Integer;
165 FElapsedTimeForLastRepaint: Int64;
166 FElapsedTimeForFullSceneRepaint: Int64;
167 FAdaptionFailed: Boolean;
168
169 // vars for time based approach
170 FTimedCheck: Boolean;
171 FTimeDelta: Integer;
172 FNextCheck: Integer;
173 FElapsedTimeOnLastPenalty: Int64;
174
175 // vars for invalid rect difference approach
176 FOldInvalidRectsCount: Integer;
177
178{$IFDEF MICROTILES_DEBUGDRAW}
179 FDebugWholeTiles: Boolean;
180 FDebugMicroTiles: TMicroTiles;
181 FDebugInvalidRects: TRectList;
182{$ENDIF}
183
184 procedure DrawLayerToMicroTiles(var DstTiles: TMicroTiles; Layer: TCustomLayer);
185 procedure DrawMeasuringHandler(Sender: TObject; const Area: TRect; const Info: Cardinal);
186
187 procedure ValidateWorkingTiles;
188 procedure UpdateOldInvalidTiles;
189 procedure SetAdaptiveMode(const Value: Boolean);
190 procedure ResetAdaptiveMode;
191 procedure BeginAdaption;
192 procedure EndAdaption;
193
194 procedure AddArea(var Tiles: TMicroTiles; const Area: TRect; const Info: Cardinal);
195 protected
196 procedure SetEnabled(const Value: Boolean); override;
197
198 // LayerCollection handler
199 procedure LayerCollectionNotifyHandler(Sender: TLayerCollection;
200 Action: TLayerListNotification; Layer: TCustomLayer; Index: Integer); override;
201 public
202 constructor Create(Buffer: TBitmap32; InvalidRects: TRectList); override;
203 destructor Destroy; override;
204
205 procedure RegisterLayerCollection(Layers: TLayerCollection); override;
206 procedure UnregisterLayerCollection(Layers: TLayerCollection); override;
207
208 procedure Reset; override;
209
210 function UpdatesAvailable: Boolean; override;
211 procedure PerformOptimization; override;
212
213 procedure BeginPaintBuffer; override;
214 procedure EndPaintBuffer; override;
215
216 // handlers
217 procedure AreaUpdateHandler(Sender: TObject; const Area: TRect; const Info: Cardinal); override;
218 procedure LayerUpdateHandler(Sender: TObject; Layer: TCustomLayer); override;
219 procedure BufferResizedHandler(const NewWidth, NewHeight: Integer); override;
220
221 // custom settings:
222 property AdaptiveMode: Boolean read FAdaptiveMode write SetAdaptiveMode;
223 end;
224
225{$IFDEF CODESITE}
226 TDebugMicroTilesRepaintOptimizer = class(TMicroTilesRepaintOptimizer)
227 public
228 procedure Reset; override;
229 function UpdatesAvailable: Boolean; override;
230 procedure PerformOptimization; override;
231
232 procedure BeginPaintBuffer; override;
233 procedure EndPaintBuffer; override;
234
235 procedure AreaUpdateHandler(Sender: TObject; const Area: TRect; const Info: Cardinal); override;
236 procedure LayerUpdateHandler(Sender: TObject; Layer: TCustomLayer); override;
237 procedure BufferResizedHandler(const NewWidth, NewHeight: Integer); override;
238 end;
239{$ENDIF}
240
241implementation
242
243uses
244 GR32_Bindings, GR32_LowLevel, GR32_Math, Math;
245
246var
247 MicroTilesU: procedure(var DstTiles: TMicroTiles; const SrcTiles: TMicroTiles);
248
249{ MicroTile auxiliary routines }
250
251function MakeMicroTile(const Left, Top, Right, Bottom: Integer): TMicroTile;
252begin
253 Result := Left shl 24 or Top shl 16 or Right shl 8 or Bottom;
254end;
255
256function MicroTileHeight(const Tile: TMicroTile): Integer;
257begin
258 Result := (Tile and $FF) - (Tile shr 16 and $FF);
259end;
260
261function MicroTileWidth(const Tile: TMicroTile): Integer;
262begin
263 Result := (Tile shr 8 and $FF) - (Tile shr 24);
264end;
265
266procedure MicroTileUnion_Pas(var DstTile: TMicroTile; const SrcTile: TMicroTile);
267var
268 SrcLeft, SrcTop, SrcRight, SrcBottom: Integer;
269begin
270 SrcLeft := SrcTile shr 24;
271 SrcTop := (SrcTile and $FF0000) shr 16;
272 SrcRight := (SrcTile and $FF00) shr 8;
273 SrcBottom := SrcTile and $FF;
274
275 if (DstTile <> MICROTILE_FULL) and (SrcTile <> MICROTILE_EMPTY) and
276 (SrcRight - SrcLeft <> 0) and (SrcBottom - SrcTop <> 0) then
277 begin
278 if (DstTile = MICROTILE_EMPTY) or (SrcTile = MICROTILE_FULL) then
279 DstTile := SrcTile
280 else
281 begin
282 DstTile := Min(DstTile shr 24, SrcLeft) shl 24 or
283 Min(DstTile shr 16 and $FF, SrcTop) shl 16 or
284 Max(DstTile shr 8 and $FF, SrcRight) shl 8 or
285 Max(DstTile and $FF, SrcBottom);
286 end;
287 end;
288end;
289
290{$IFDEF TARGET_x86}
291procedure MicroTileUnion_EMMX(var DstTile: TMicroTile; const SrcTile: TMicroTile);
292var
293 SrcLeft, SrcTop, SrcRight, SrcBottom: Integer;
294begin
295 SrcLeft := SrcTile shr 24;
296 SrcTop := (SrcTile and $FF0000) shr 16;
297 SrcRight := (SrcTile and $FF00) shr 8;
298 SrcBottom := SrcTile and $FF;
299
300 if (DstTile <> MICROTILE_FULL) and (SrcTile <> MICROTILE_EMPTY) and
301 (SrcRight - SrcLeft <> 0) and (SrcBottom - SrcTop <> 0) then
302 begin
303 if (DstTile = MICROTILE_EMPTY) or (SrcTile = MICROTILE_FULL) then
304 DstTile := SrcTile
305 else
306 asm
307 MOVD MM1,[SrcTile]
308
309 MOV EAX,[DstTile]
310 MOVD MM2, [EAX]
311
312 MOVQ MM3, MM1
313
314 MOV ECX,$FFFF0000 // Mask
315 MOVD MM0, ECX
316 PMINUB MM1, MM2
317 PAND MM1, MM0
318
319 PSRLD MM0, 16 // shift mask right by 16 bits
320 PMAXUB MM2, MM3
321 PAND MM2, MM0
322
323 POR MM1, MM2
324
325 MOVD [EAX], MM1
326
327 EMMS
328 end;
329 end;
330end;
331{$ENDIF}
332
333{ MicroTiles auxiliary routines }
334
335function MakeEmptyMicroTiles: TMicroTiles;
336begin
337 FillChar(Result, SizeOf(TMicroTiles), 0);
338 ReallocMem(Result.Tiles, 0);
339end;
340
341procedure MicroTilesCreate(var MicroTiles: TMicroTiles);
342begin
343 FillChar(MicroTiles, SizeOf(TMicroTiles), 0);
344 ReallocMem(MicroTiles.Tiles, 0);
345end;
346
347procedure MicroTilesDestroy(var MicroTiles: TMicroTiles);
348begin
349 ReallocMem(MicroTiles.Tiles, 0);
350end;
351
352procedure MicroTilesSetSize(var MicroTiles: TMicroTiles; const DstRect: TRect);
353begin
354 MicroTiles.BoundsRect := DstRect;
355 MicroTiles.Columns := ((DstRect.Right - DstRect.Left) shr MICROTILE_SHIFT) + 1;
356 MicroTiles.Rows := ((DstRect.Bottom - DstRect.Top) shr MICROTILE_SHIFT) + 1;
357
358 MicroTiles.Count := (MicroTiles.Columns + 1) * (MicroTiles.Rows + 1);
359 ReallocMem(MicroTiles.Tiles, MicroTiles.Count * SizeOf(TMicroTile));
360
361 MicroTilesClear(MicroTiles)
362end;
363
364procedure MicroTilesClear(var MicroTiles: TMicroTiles; const Value: TMicroTile);
365begin
366 MicroTiles.BoundsUsedTiles := MakeRect(MicroTiles.Columns, MicroTiles.Rows, 0, 0);
367 FillLongword(MicroTiles.Tiles^[0], MicroTiles.Count, Value);
368end;
369
370procedure MicroTilesClearUsed(var MicroTiles: TMicroTiles; const Value: TMicroTile);
371var
372 I: Integer;
373begin
374 for I := MicroTiles.BoundsUsedTiles.Top to MicroTiles.BoundsUsedTiles.Bottom do
375 FillLongword(MicroTiles.Tiles^[I * MicroTiles.Columns + MicroTiles.BoundsUsedTiles.Left],
376 MicroTiles.BoundsUsedTiles.Right - MicroTiles.BoundsUsedTiles.Left + 1, Value);
377
378 MicroTiles.BoundsUsedTiles := MakeRect(MicroTiles.Columns, MicroTiles.Rows, 0, 0);
379end;
380
381procedure MicroTilesCopy(var DstTiles: TMicroTiles; SrcTiles: TMicroTiles);
382var
383 CurRow, Width: Integer;
384 SrcTilePtr, DstTilePtr: PMicroTile;
385begin
386 if Assigned(DstTiles.Tiles) and (DstTiles.Count > 0) then
387 MicroTilesClearUsed(DstTiles);
388
389 DstTiles.BoundsRect := SrcTiles.BoundsRect;
390 DstTiles.Columns := SrcTiles.Columns;
391 DstTiles.Rows := SrcTiles.Rows;
392 DstTiles.BoundsUsedTiles := SrcTiles.BoundsUsedTiles;
393
394 ReallocMem(DstTiles.Tiles, SrcTiles.Count * SizeOf(TMicroTile));
395
396 if DstTiles.Count < SrcTiles.Count then
397 FillLongword(DstTiles.Tiles^[DstTiles.Count], SrcTiles.Count - DstTiles.Count, MICROTILE_EMPTY);
398
399 DstTiles.Count := SrcTiles.Count;
400
401 SrcTilePtr := @SrcTiles.Tiles^[SrcTiles.BoundsUsedTiles.Top * SrcTiles.Columns + SrcTiles.BoundsUsedTiles.Left];
402 DstTilePtr := @DstTiles.Tiles^[SrcTiles.BoundsUsedTiles.Top * DstTiles.Columns + SrcTiles.BoundsUsedTiles.Left];
403 Width := SrcTiles.BoundsUsedTiles.Right - SrcTiles.BoundsUsedTiles.Left + 1;
404
405 for CurRow := SrcTiles.BoundsUsedTiles.Top to SrcTiles.BoundsUsedTiles.Bottom do
406 begin
407 MoveLongword(SrcTilePtr^, DstTilePtr^, Width);
408 Inc(DstTilePtr, DstTiles.Columns);
409 Inc(SrcTilePtr, SrcTiles.Columns);
410 end
411end;
412
413procedure MicroTilesAddLine(var MicroTiles: TMicroTiles; X1, Y1, X2, Y2: Integer; LineWidth: Integer; RoundToWholeTiles: Boolean = False);
414var
415 I: Integer;
416 Dx, Dy: Integer;
417 Sx, Sy: Integer;
418 DeltaX, DeltaY: Integer;
419 Rects: Integer;
420 NewX, NewY: Integer;
421 TempRect: TRect;
422 Swapped: Boolean;
423begin
424 Dx := X2 - X1;
425 Dy := Y2 - Y1;
426
427 LineWidth := LineWidth shl 1;
428
429 if Dx > 0 then
430 Sx := 1
431 else if Dx < 0 then
432 begin
433 Dx := -Dx;
434 Sx := -1;
435 end
436 else // Dx = 0
437 begin
438 TempRect := MakeRect(X1, Y1, X2, Y2);
439 InflateArea(TempRect, LineWidth, LineWidth);
440 MicroTilesAddRect(MicroTiles, TempRect, RoundToWholeTiles);
441 Exit;
442 end;
443
444 if Dy > 0 then
445 Sy := 1
446 else if Dy < 0 then
447 begin
448 Dy := -Dy;
449 Sy := -1;
450 end
451 else // Dy = 0
452 begin
453 TempRect := MakeRect(X1, Y1, X2, Y2);
454 InflateArea(TempRect, LineWidth, LineWidth);
455 MicroTilesAddRect(MicroTiles, TempRect, RoundToWholeTiles);
456 Exit;
457 end;
458
459 X1 := X1 * FixedOne;
460 Y1 := Y1 * FixedOne;
461
462 Dx := Dx * FixedOne;
463 Dy := Dy * FixedOne;
464
465 if Dx < Dy then
466 begin
467 Swapped := True;
468 Swap(Dx, Dy);
469 end
470 else
471 Swapped := False;
472
473 Rects := Dx div MICROTILE_SIZE;
474
475 DeltaX := MICROTILE_SIZE * FixedOne;
476 DeltaY := FixedDiv(Dy, Rects);
477
478 if Swapped then
479 Swap(DeltaX, DeltaY);
480
481 DeltaX := Sx * DeltaX;
482 DeltaY := Sy * DeltaY;
483
484 for I := 1 to FixedCeil(Rects) do
485 begin
486 NewX := X1 + DeltaX;
487 NewY := Y1 + DeltaY;
488
489 TempRect := MakeRect(FixedRect(X1, Y1, NewX, NewY));
490 InflateArea(TempRect, LineWidth, LineWidth);
491 MicroTilesAddRect(MicroTiles, TempRect, RoundToWholeTiles);
492
493 X1 := NewX;
494 Y1 := NewY;
495 end;
496end;
497
498procedure MicroTilesAddRect(var MicroTiles: TMicroTiles; Rect: TRect; RoundToWholeTiles: Boolean);
499var
500 ModLeft, ModRight, ModTop, ModBottom, Temp: Integer;
501 LeftTile, TopTile, RightTile, BottomTile, ColSpread, RowSpread: Integer;
502 CurRow, CurCol: Integer;
503 TilePtr, TilePtr2: PMicroTile;
504begin
505 if MicroTiles.Count = 0 then Exit;
506
507 with Rect do
508 begin
509 TestSwap(Left, Right);
510 TestSwap(Top, Bottom);
511
512 if Left < 0 then Left := 0;
513 if Top < 0 then Top := 0;
514 Temp := MicroTiles.Columns shl MICROTILE_SHIFT;
515 if Right > Temp then Right := Temp;
516 Temp := MicroTiles.Rows shl MICROTILE_SHIFT;
517 if Bottom > Temp then Bottom := Temp;
518
519 if (Left > Right) or (Top > Bottom) then Exit;
520 end;
521
522 LeftTile := Rect.Left shr MICROTILE_SHIFT;
523 TopTile := Rect.Top shr MICROTILE_SHIFT;
524 RightTile := Rect.Right shr MICROTILE_SHIFT;
525 BottomTile := Rect.Bottom shr MICROTILE_SHIFT;
526
527 TilePtr := @MicroTiles.Tiles^[TopTile * MicroTiles.Columns + LeftTile];
528
529 if RoundToWholeTiles then
530 begin
531 for CurRow := TopTile to BottomTile do
532 begin
533 FillLongword(TilePtr^, RightTile - LeftTile + 1, MICROTILE_FULL);
534 Inc(TilePtr, MicroTiles.Columns);
535 end;
536 end
537 else
538 begin
539 // calculate number of tiles needed in columns and rows
540 ColSpread := ((Rect.Right + MICROTILE_SIZE) shr MICROTILE_SHIFT) -
541 (Rect.Left shr MICROTILE_SHIFT);
542 RowSpread := ((Rect.Bottom + MICROTILE_SIZE) shr MICROTILE_SHIFT) -
543 (Rect.Top shr MICROTILE_SHIFT);
544
545 ModLeft := Rect.Left mod MICROTILE_SIZE;
546 ModTop := Rect.Top mod MICROTILE_SIZE;
547 ModRight := Rect.Right mod MICROTILE_SIZE;
548 ModBottom := Rect.Bottom mod MICROTILE_SIZE;
549
550 if (ColSpread = 1) and (RowSpread = 1) then
551 MicroTileUnion(TilePtr^, MakeMicroTile(ModLeft, ModTop, ModRight, ModBottom))
552 else if ColSpread = 1 then
553 begin
554 MicroTileUnion(TilePtr^, MakeMicroTile(ModLeft, ModTop, ModRight, MICROTILE_SIZE));
555 Inc(TilePtr, MicroTiles.Columns);
556
557 if RowSpread > 2 then
558 for CurCol := TopTile + 1 to BottomTile - 1 do
559 begin
560 MicroTileUnion(TilePtr^, MakeMicroTile(ModLeft, 0, ModRight, MICROTILE_SIZE));
561 Inc(TilePtr, MicroTiles.Columns);
562 end;
563
564 MicroTileUnion(TilePtr^, MakeMicroTile(ModLeft, 0, ModRight, ModBottom));
565 end
566 else if RowSpread = 1 then
567 begin
568 MicroTileUnion(TilePtr^, MakeMicroTile(ModLeft, ModTop, MICROTILE_SIZE, ModBottom));
569 Inc(TilePtr);
570
571 if ColSpread > 2 then
572 for CurRow := LeftTile + 1 to RightTile - 1 do
573 begin
574 MicroTileUnion(TilePtr^, MakeMicroTile(0, ModTop, MICROTILE_SIZE, ModBottom));
575 Inc(TilePtr);
576 end;
577
578 MicroTileUnion(TilePtr^, MakeMicroTile(0, ModTop, ModRight, ModBottom));
579 end
580 else
581 begin
582 TilePtr2 := TilePtr;
583
584 // TOP:
585 // render top-left corner
586 MicroTileUnion(TilePtr2^, MakeMicroTile(ModLeft, ModTop, MICROTILE_SIZE, MICROTILE_SIZE));
587 Inc(TilePtr2);
588
589 // render top edge
590 if ColSpread > 2 then
591 for CurRow := LeftTile + 1 to RightTile - 1 do
592 begin
593 MicroTileUnion(TilePtr2^, MakeMicroTile(0, ModTop, MICROTILE_SIZE, MICROTILE_SIZE));
594 Inc(TilePtr2);
595 end;
596
597 // render top-right corner
598 MicroTileUnion(TilePtr2^, MakeMicroTile(0, ModTop, ModRight, MICROTILE_SIZE));
599
600 Inc(TilePtr, MicroTiles.Columns);
601
602 // INTERMEDIATE AREA:
603 if RowSpread > 2 then
604 for CurCol := TopTile + 1 to BottomTile - 1 do
605 begin
606 TilePtr2 := TilePtr;
607
608 // render left edge
609 MicroTileUnion(TilePtr2^, MakeMicroTile(ModLeft, 0, MICROTILE_SIZE, MICROTILE_SIZE));
610 Inc(TilePtr2);
611
612 // render content
613 if ColSpread > 2 then
614 begin
615 FillLongword(TilePtr2^, RightTile - LeftTile - 1, MICROTILE_FULL);
616 Inc(TilePtr2, RightTile - LeftTile - 1);
617 end;
618
619 // render right edge
620 MicroTileUnion(TilePtr2^, MakeMicroTile(0, 0, ModRight, MICROTILE_SIZE));
621
622 Inc(TilePtr, MicroTiles.Columns);
623 end;
624
625 TilePtr2 := TilePtr;
626
627 // BOTTOM:
628 // render bottom-left corner
629 MicroTileUnion(TilePtr2^, MakeMicroTile(ModLeft, 0, MICROTILE_SIZE, ModBottom));
630 Inc(TilePtr2);
631
632 // render bottom edge
633 if ColSpread > 2 then
634 for CurRow := LeftTile + 1 to RightTile - 1 do
635 begin
636 MicroTileUnion(TilePtr2^, MakeMicroTile(0, 0, MICROTILE_SIZE, ModBottom));
637 Inc(TilePtr2);
638 end;
639
640 // render bottom-right corner
641 MicroTileUnion(TilePtr2^, MakeMicroTile(0, 0, ModRight, ModBottom));
642 end;
643 end;
644
645 with MicroTiles.BoundsUsedTiles do
646 begin
647 if LeftTile < Left then Left := LeftTile;
648 if TopTile < Top then Top := TopTile;
649 if RightTile > Right then Right := RightTile;
650 if BottomTile > Bottom then Bottom := BottomTile;
651 end;
652end;
653
654
655procedure MicroTilesUnion_Pas(var DstTiles: TMicroTiles; const SrcTiles: TMicroTiles);
656var
657 SrcTilePtr, DstTilePtr: PMicroTile;
658 SrcTilePtr2, DstTilePtr2: PMicroTile;
659 X, Y: Integer;
660 SrcLeft, SrcTop, SrcRight, SrcBottom: Integer;
661 SrcTile: TMicroTile;
662begin
663 SrcTilePtr := @SrcTiles.Tiles^[SrcTiles.BoundsUsedTiles.Top * SrcTiles.Columns + SrcTiles.BoundsUsedTiles.Left];
664 DstTilePtr := @DstTiles.Tiles^[SrcTiles.BoundsUsedTiles.Top * DstTiles.Columns + SrcTiles.BoundsUsedTiles.Left];
665
666 for Y := SrcTiles.BoundsUsedTiles.Top to SrcTiles.BoundsUsedTiles.Bottom do
667 begin
668 SrcTilePtr2 := SrcTilePtr;
669 DstTilePtr2 := DstTilePtr;
670 for X := SrcTiles.BoundsUsedTiles.Left to SrcTiles.BoundsUsedTiles.Right do
671 begin
672 SrcTile := SrcTilePtr2^;
673 SrcLeft := SrcTile shr 24;
674 SrcTop := (SrcTile and $FF0000) shr 16;
675 SrcRight := (SrcTile and $FF00) shr 8;
676 SrcBottom := SrcTile and $FF;
677
678 if (DstTilePtr2^ <> MICROTILE_FULL) and (SrcTilePtr2^ <> MICROTILE_EMPTY) and
679 (SrcRight - SrcLeft <> 0) and (SrcBottom - SrcTop <> 0) then
680 begin
681 if (DstTilePtr2^ = MICROTILE_EMPTY) or (SrcTilePtr2^ = MICROTILE_FULL) then
682 DstTilePtr2^ := SrcTilePtr2^
683 else
684 DstTilePtr2^ := Min(DstTilePtr2^ shr 24, SrcLeft) shl 24 or
685 Min(DstTilePtr2^ shr 16 and $FF, SrcTop) shl 16 or
686 Max(DstTilePtr2^ shr 8 and $FF, SrcRight) shl 8 or
687 Max(DstTilePtr2^ and $FF, SrcBottom);
688 end;
689
690 Inc(DstTilePtr2);
691 Inc(SrcTilePtr2);
692 end;
693 Inc(DstTilePtr, DstTiles.Columns);
694 Inc(SrcTilePtr, SrcTiles.Columns);
695 end;
696end;
697
698{$IFDEF TARGET_x86}
699procedure MicroTilesUnion_EMMX(var DstTiles: TMicroTiles; const SrcTiles: TMicroTiles);
700var
701 SrcTilePtr, DstTilePtr: PMicroTile;
702 SrcTilePtr2, DstTilePtr2: PMicroTile;
703 X, Y: Integer;
704 SrcLeft, SrcTop, SrcRight, SrcBottom: Integer;
705begin
706 SrcTilePtr := @SrcTiles.Tiles^[SrcTiles.BoundsUsedTiles.Top * SrcTiles.Columns + SrcTiles.BoundsUsedTiles.Left];
707 DstTilePtr := @DstTiles.Tiles^[SrcTiles.BoundsUsedTiles.Top * DstTiles.Columns + SrcTiles.BoundsUsedTiles.Left];
708
709 asm
710 MOV ECX, $FFFF // Mask
711 MOVD MM0, ECX
712 MOVQ MM4, MM0
713 PSLLD MM4, 16 // shift mask left by 16 bits
714 end;
715
716 for Y := SrcTiles.BoundsUsedTiles.Top to SrcTiles.BoundsUsedTiles.Bottom do
717 begin
718 SrcTilePtr2 := SrcTilePtr;
719 DstTilePtr2 := DstTilePtr;
720 for X := SrcTiles.BoundsUsedTiles.Left to SrcTiles.BoundsUsedTiles.Right do
721 begin
722 SrcLeft := SrcTilePtr2^ shr 24;
723 SrcTop := (SrcTilePtr2^ and $FF0000) shr 16;
724 SrcRight := (SrcTilePtr2^ and $FF00) shr 8;
725 SrcBottom := SrcTilePtr2^ and $FF;
726
727 if (DstTilePtr2^ <> MICROTILE_FULL) and (SrcTilePtr2^ <> MICROTILE_EMPTY) and
728 (SrcRight - SrcLeft <> 0) and (SrcBottom - SrcTop <> 0) then
729 begin
730 if (DstTilePtr2^ = MICROTILE_EMPTY) or (SrcTilePtr2^ = MICROTILE_FULL) then
731 DstTilePtr2^ := SrcTilePtr2^
732 else
733 asm
734 MOV EAX, [DstTilePtr2]
735 MOVD MM2, [EAX]
736
737 MOV ECX, [SrcTilePtr2]
738 MOVD MM1, [ECX]
739 MOVQ MM3, MM1
740
741 PMINUB MM1, MM2
742 PAND MM1, MM4
743
744 PMAXUB MM2, MM3
745 PAND MM2, MM0
746
747 POR MM1, MM2
748
749 MOVD [EAX], MM1
750 end;
751 end;
752
753 Inc(DstTilePtr2);
754 Inc(SrcTilePtr2);
755 end;
756 Inc(DstTilePtr, DstTiles.Columns);
757 Inc(SrcTilePtr, SrcTiles.Columns);
758 end;
759
760 asm
761 db $0F,$77 /// EMMS
762 end;
763end;
764{$ENDIF}
765
766procedure MicroTilesUnion(var DstTiles: TMicroTiles; const SrcTiles: TMicroTiles; RoundToWholeTiles: Boolean);
767var
768 SrcTilePtr, DstTilePtr: PMicroTile;
769 SrcTilePtr2, DstTilePtr2: PMicroTile;
770 X, Y: Integer;
771 SrcLeft, SrcTop, SrcRight, SrcBottom: Integer;
772begin
773 if SrcTiles.Count = 0 then Exit;
774
775 if RoundToWholeTiles then
776 begin
777 SrcTilePtr := @SrcTiles.Tiles^[SrcTiles.BoundsUsedTiles.Top * SrcTiles.Columns + SrcTiles.BoundsUsedTiles.Left];
778 DstTilePtr := @DstTiles.Tiles^[SrcTiles.BoundsUsedTiles.Top * DstTiles.Columns + SrcTiles.BoundsUsedTiles.Left];
779
780 for Y := SrcTiles.BoundsUsedTiles.Top to SrcTiles.BoundsUsedTiles.Bottom do
781 begin
782 SrcTilePtr2 := SrcTilePtr;
783 DstTilePtr2 := DstTilePtr;
784 for X := SrcTiles.BoundsUsedTiles.Left to SrcTiles.BoundsUsedTiles.Right do
785 begin
786 SrcLeft := SrcTilePtr2^ shr 24;
787 SrcTop := (SrcTilePtr2^ and $FF0000) shr 16;
788 SrcRight := (SrcTilePtr2^ and $FF00) shr 8;
789 SrcBottom := SrcTilePtr2^ and $FF;
790
791 if (DstTilePtr2^ <> MICROTILE_FULL) and (SrcTilePtr2^ <> MICROTILE_EMPTY) and
792 (SrcRight - SrcLeft <> 0) and (SrcBottom - SrcTop <> 0) then
793 DstTilePtr2^ := MICROTILE_FULL;
794
795 Inc(DstTilePtr2);
796 Inc(SrcTilePtr2);
797 end;
798 Inc(DstTilePtr, DstTiles.Columns);
799 Inc(SrcTilePtr, SrcTiles.Columns);
800 end
801 end
802 else
803 MicroTilesU(DstTiles, SrcTiles);
804
805 with DstTiles.BoundsUsedTiles do
806 begin
807 if SrcTiles.BoundsUsedTiles.Left < Left then Left := SrcTiles.BoundsUsedTiles.Left;
808 if SrcTiles.BoundsUsedTiles.Top < Top then Top := SrcTiles.BoundsUsedTiles.Top;
809 if SrcTiles.BoundsUsedTiles.Right > Right then Right := SrcTiles.BoundsUsedTiles.Right;
810 if SrcTiles.BoundsUsedTiles.Bottom > Bottom then Bottom := SrcTiles.BoundsUsedTiles.Bottom;
811 end;
812end;
813
814function MicroTilesCalcRects(const MicroTiles: TMicroTiles; DstRects: TRectList;
815 CountOnly, RoundToWholeTiles: Boolean): Integer;
816begin
817 Result := MicroTilesCalcRects(MicroTiles, DstRects, MicroTiles.BoundsRect, CountOnly);
818end;
819
820
821function MicroTilesCalcRects(const MicroTiles: TMicroTiles; DstRects: TRectList;
822 const Clip: TRect; CountOnly, RoundToWholeTiles: Boolean): Integer;
823var
824 Rects: Array Of TRect;
825 Rect: PRect;
826 CombLUT: Array Of Integer;
827 StartIndex: Integer;
828 CurTile, TempTile: TMicroTile;
829 Temp: Integer;
830 NewLeft, NewTop, NewRight, NewBottom: Integer;
831 CurCol, CurRow, I, RectsCount: Integer;
832begin
833 Result := 0;
834
835 if (MicroTiles.Count = 0) or
836 (MicroTiles.BoundsUsedTiles.Right - MicroTiles.BoundsUsedTiles.Left < 0) or
837 (MicroTiles.BoundsUsedTiles.Bottom - MicroTiles.BoundsUsedTiles.Top < 0) then Exit;
838
839 SetLength(Rects, MicroTiles.Columns * MicroTiles.Rows);
840 SetLength(CombLUT, MicroTiles.Columns * MicroTiles.Rows);
841 FillLongword(CombLUT[0], Length(CombLUT), Cardinal(-1));
842
843 I := 0;
844 RectsCount := 0;
845
846 if not RoundToWholeTiles then
847 for CurRow := 0 to MicroTiles.Rows - 1 do
848 begin
849 CurCol := 0;
850 while CurCol < MicroTiles.Columns do
851 begin
852 CurTile := MicroTiles.Tiles[I];
853
854 if CurTile <> MICROTILE_EMPTY then
855 begin
856 Temp := CurRow shl MICROTILE_SHIFT;
857 NewTop := Constrain(Temp + CurTile shr 16 and $FF, Clip.Top, Clip.Bottom);
858 NewBottom := Constrain(Temp + CurTile and $FF, Clip.Top, Clip.Bottom);
859 NewLeft := Constrain(CurCol shl MICROTILE_SHIFT + CurTile shr 24, Clip.Left, Clip.Right);
860
861 StartIndex := I;
862
863 if (CurTile shr 8 and $FF = MICROTILE_SIZE) and (CurCol <> MicroTiles.Columns - 1) then
864 begin
865 while True do
866 begin
867 Inc(CurCol);
868 Inc(I);
869
870 TempTile := MicroTiles.Tiles[I];
871 if (CurCol = MicroTiles.Columns) or
872 (TempTile shr 16 and $FF <> CurTile shr 16 and $FF) or
873 (TempTile and $FF <> CurTile and $FF) or
874 (TempTile shr 24 <> 0) then
875 begin
876 Dec(CurCol);
877 Dec(I);
878 Break;
879 end;
880 end;
881 end;
882
883 NewRight := Constrain(CurCol shl MICROTILE_SHIFT + MicroTiles.Tiles[I] shr 8 and $FF, Clip.Left, Clip.Right);
884
885 Temp := CombLUT[StartIndex];
886
887 Rect := nil;
888 if Temp <> -1 then Rect := @Rects[Temp];
889
890 if Assigned(Rect) and
891 (Rect.Left = NewLeft) and
892 (Rect.Right = NewRight) and
893 (Rect.Bottom = NewTop) then
894 begin
895 Rect.Bottom := NewBottom;
896
897 if CurRow <> MicroTiles.Rows - 1 then
898 CombLUT[StartIndex + MicroTiles.Columns] := Temp;
899 end
900 else
901 with Rects[RectsCount] do
902 begin
903 Left := NewLeft; Top := NewTop;
904 Right := NewRight; Bottom := NewBottom;
905
906 if CurRow <> MicroTiles.Rows - 1 then
907 CombLUT[StartIndex + MicroTiles.Columns] := RectsCount;
908
909 Inc(RectsCount);
910 end;
911 end;
912
913 Inc(I);
914 Inc(CurCol);
915 end;
916 end
917 else
918 for CurRow := 0 to MicroTiles.Rows - 1 do
919 begin
920 CurCol := 0;
921 while CurCol < MicroTiles.Columns do
922 begin
923 CurTile := MicroTiles.Tiles[I];
924
925 if CurTile <> MICROTILE_EMPTY then
926 begin
927 Temp := CurRow shl MICROTILE_SHIFT;
928 NewTop := Constrain(Temp, Clip.Top, Clip.Bottom);
929 NewBottom := Constrain(Temp + MICROTILE_SIZE, Clip.Top, Clip.Bottom);
930 NewLeft := Constrain(CurCol shl MICROTILE_SHIFT, Clip.Left, Clip.Right);
931
932 StartIndex := I;
933
934 if CurCol <> MicroTiles.Columns - 1 then
935 begin
936 while True do
937 begin
938 Inc(CurCol);
939 Inc(I);
940
941 TempTile := MicroTiles.Tiles[I];
942 if (CurCol = MicroTiles.Columns) or (TempTile = MICROTILE_EMPTY) then
943 begin
944 Dec(CurCol);
945 Dec(I);
946 Break;
947 end;
948 end;
949 end;
950
951 NewRight := Constrain(CurCol shl MICROTILE_SHIFT + MICROTILE_SIZE, Clip.Left, Clip.Right);
952
953 Temp := CombLUT[StartIndex];
954
955 Rect := nil;
956 if Temp <> -1 then Rect := @Rects[Temp];
957
958 if Assigned(Rect) and
959 (Rect.Left = NewLeft) and
960 (Rect.Right = NewRight) and
961 (Rect.Bottom = NewTop) then
962 begin
963 Rect.Bottom := NewBottom;
964
965 if CurRow <> MicroTiles.Rows - 1 then
966 CombLUT[StartIndex + MicroTiles.Columns] := Temp;
967 end
968 else
969 with Rects[RectsCount] do
970 begin
971 Left := NewLeft; Top := NewTop;
972 Right := NewRight; Bottom := NewBottom;
973
974 if CurRow <> MicroTiles.Rows - 1 then
975 CombLUT[StartIndex + MicroTiles.Columns] := RectsCount;
976
977 Inc(RectsCount);
978 end;
979 end;
980
981 Inc(I);
982 Inc(CurCol);
983 end;
984 end;
985
986
987 Result := RectsCount;
988
989 if not CountOnly then
990 for I := 0 to RectsCount - 1 do DstRects.Add(Rects[I]);
991end;
992
993function MicroTilesCountEmptyTiles(const MicroTiles: TMicroTiles): Integer;
994var
995 CurRow, CurCol: Integer;
996 TilePtr: PMicroTile;
997begin
998 Result := 0;
999 if MicroTiles.Count > 0 then
1000 begin
1001 TilePtr := @MicroTiles.Tiles^[0];
1002 for CurRow := 0 to MicroTiles.Rows - 1 do
1003 for CurCol := 0 to MicroTiles.Columns - 1 do
1004 begin
1005 if TilePtr^ = MICROTILE_EMPTY then Inc(Result);
1006 Inc(TilePtr);
1007 end;
1008 end;
1009end;
1010
1011{$IFDEF MICROTILES_DEBUGDRAW}
1012procedure MicroTilesDebugDraw(const MicroTiles: TMicroTiles; DstBitmap: TBitmap32; DrawOptimized, RoundToWholeTiles: Boolean);
1013var
1014 I: Integer;
1015 TempRect: TRect;
1016 Rects: TRectList;
1017
1018 C1, C2: TColor32;
1019begin
1020{$IFDEF MICROTILES_DEBUGDRAW_RANDOM_COLORS}
1021 C1 := Random(MaxInt) AND $00FFFFFF;
1022 C2 := C1 OR $90000000;
1023 C1 := C1 OR $30000000;
1024{$ELSE}
1025 C1 := clDebugDrawFill;
1026 C2 := clDebugDrawFrame;
1027{$ENDIF}
1028
1029 if DrawOptimized then
1030 begin
1031 Rects := TRectList.Create;
1032 MicroTilesCalcRects(MicroTiles, Rects, False, RoundToWholeTiles);
1033 try
1034 if Rects.Count > 0 then
1035 begin
1036 for I := 0 to Rects.Count - 1 do
1037 begin
1038 DstBitmap.FillRectTS(Rects[I]^, C1);
1039 DstBitmap.FrameRectTS(Rects[I]^, C2);
1040 end;
1041 end
1042 finally
1043 Rects.Free;
1044 end;
1045 end
1046 else
1047 for I := 0 to MicroTiles.Count - 1 do
1048 begin
1049 if MicroTiles.Tiles^[i] <> MICROTILE_EMPTY then
1050 begin
1051 TempRect.Left := ((I mod MicroTiles.Columns) shl MICROTILE_SHIFT) + (MicroTiles.Tiles[i] shr 24);
1052 TempRect.Top := ((I div MicroTiles.Columns) shl MICROTILE_SHIFT) + (MicroTiles.Tiles[i] shr 16 and $FF);
1053 TempRect.Right := ((I mod MicroTiles.Columns) shl MICROTILE_SHIFT) + (MicroTiles.Tiles[i] shr 8 and $FF);
1054 TempRect.Bottom := ((I div MicroTiles.Columns) shl MICROTILE_SHIFT) + (MicroTiles.Tiles[i] and $FF);
1055
1056 DstBitmap.FillRectTS(TempRect, C1);
1057 DstBitmap.FrameRectTS(TempRect, C2);
1058 end;
1059 end;
1060end;
1061{$ENDIF}
1062
1063{ TMicroTilesMap }
1064
1065function TMicroTilesMap.Add(Item: Pointer): PPMicroTiles;
1066var
1067 TilesPtr: PMicroTiles;
1068 IsNew: Boolean;
1069begin
1070 Result := PPMicroTiles(inherited Add(Item, IsNew));
1071 if IsNew then
1072 begin
1073 New(TilesPtr);
1074 MicroTilesCreate(TilesPtr^);
1075 Result^ := TilesPtr;
1076 end;
1077end;
1078
1079function TMicroTilesMap.Delete(BucketIndex, ItemIndex: Integer): Pointer;
1080var
1081 TilesPtr: PMicroTiles;
1082begin
1083 TilesPtr := inherited Delete(BucketIndex, ItemIndex);
1084 MicroTilesDestroy(TilesPtr^);
1085 Dispose(TilesPtr);
1086 Result := nil;
1087end;
1088
1089procedure TMicroTilesMap.SetData(Item: Pointer; const Data: PMicroTiles);
1090begin
1091 inherited SetData(Item, Data);
1092end;
1093
1094function TMicroTilesMap.GetData(Item: Pointer): PMicroTiles;
1095begin
1096 Result := inherited GetData(Item);
1097end;
1098
1099
1100
1101{ TMicroTilesRepaintManager }
1102
1103type
1104 TLayerCollectionAccess = class(TLayerCollection);
1105 TCustomLayerAccess = class(TCustomLayer);
1106
1107const
1108 PL_MICROTILES = 0;
1109 PL_WHOLETILES = 1;
1110 PL_FULLSCENE = 2;
1111
1112 TIMER_PENALTY = 250;
1113 TIMER_LOWLIMIT = 1000;
1114 TIMER_HIGHLIMIT = 5000;
1115
1116 INVALIDRECTS_DELTA = 10;
1117
1118constructor TMicroTilesRepaintOptimizer.Create(Buffer: TBitmap32; InvalidRects: TRectList);
1119begin
1120 inherited;
1121 FOldInvalidTilesMap := TMicroTilesMap.Create;
1122 FInvalidLayers := TList.Create;
1123 FPerfTimer := TPerfTimer.Create;
1124{$IFNDEF MICROTILES_DEBUGDRAW}
1125 {$IFNDEF MICROTILES_NO_ADAPTION}
1126 FAdaptiveMode := True;
1127 {$ENDIF}
1128{$ENDIF}
1129
1130 MicroTilesCreate(FInvalidTiles);
1131 MicroTilesCreate(FTempTiles);
1132 MicroTilesCreate(FForcedInvalidTiles);
1133
1134{$IFDEF MICROTILES_DEBUGDRAW}
1135 MicroTilesCreate(FDebugMicroTiles);
1136 FDebugInvalidRects := TRectList.Create;
1137{$ENDIF}
1138end;
1139
1140destructor TMicroTilesRepaintOptimizer.Destroy;
1141begin
1142 MicroTilesDestroy(FForcedInvalidTiles);
1143 MicroTilesDestroy(FTempTiles);
1144 MicroTilesDestroy(FInvalidTiles);
1145
1146 FPerfTimer.Free;
1147 FInvalidLayers.Free;
1148 FOldInvalidTilesMap.Free;
1149
1150{$IFDEF MICROTILES_DEBUGDRAW}
1151 FDebugInvalidRects.Free;
1152 MicroTilesDestroy(FDebugMicroTiles);
1153{$ENDIF}
1154
1155 inherited;
1156end;
1157
1158procedure TMicroTilesRepaintOptimizer.AreaUpdateHandler(Sender: TObject; const Area: TRect;
1159 const Info: Cardinal);
1160begin
1161 ValidateWorkingTiles;
1162 AddArea(FForcedInvalidTiles, Area, Info);
1163 FUseInvalidTiles := True;
1164end;
1165
1166procedure TMicroTilesRepaintOptimizer.AddArea(var Tiles: TMicroTiles; const Area: TRect;
1167 const Info: Cardinal);
1168var
1169 LineWidth: Integer;
1170 TempRect: TRect;
1171begin
1172 if Info and AREAINFO_LINE <> 0 then
1173 begin
1174 LineWidth := Info and $00FFFFFF;
1175 TempRect := Area;
1176 InflateArea(TempRect, LineWidth, LineWidth);
1177 with TempRect do
1178 MicroTilesAddLine(Tiles, Left, Top, Right, Bottom, LineWidth, FPerformanceLevel > PL_MICROTILES);
1179 end
1180 else
1181 MicroTilesAddRect(Tiles, Area, FPerformanceLevel > PL_MICROTILES);
1182end;
1183
1184procedure TMicroTilesRepaintOptimizer.LayerUpdateHandler(Sender: TObject; Layer: TCustomLayer);
1185begin
1186 if FOldInvalidTilesValid and not TCustomLayerAccess(Layer).Invalid then
1187 begin
1188 FInvalidLayers.Add(Layer);
1189 TCustomLayerAccess(Layer).Invalid := True;
1190 FUseInvalidTiles := True;
1191 end;
1192end;
1193
1194procedure TMicroTilesRepaintOptimizer.LayerCollectionNotifyHandler(Sender: TLayerCollection;
1195 Action: TLayerListNotification; Layer: TCustomLayer; Index: Integer);
1196var
1197 TilesPtr: PMicroTiles;
1198begin
1199 case Action of
1200 lnLayerAdded, lnLayerInserted:
1201 begin
1202 TilesPtr := FOldInvalidTilesMap.Add(Layer)^;
1203 MicroTilesSetSize(TilesPtr^, Buffer.BoundsRect);
1204 FOldInvalidTilesValid := True;
1205 end;
1206
1207 lnLayerDeleted:
1208 begin
1209 if FOldInvalidTilesValid then
1210 begin
1211 // force repaint of tiles that the layer did previously allocate
1212 MicroTilesUnion(FInvalidTiles, FOldInvalidTilesMap[Layer]^);
1213 FUseInvalidTiles := True;
1214 end;
1215 FInvalidLayers.Remove(Layer);
1216 FOldInvalidTilesMap.Remove(Layer);
1217 end;
1218
1219 lnCleared:
1220 begin
1221 if FOldInvalidTilesValid then
1222 begin
1223 with TPointerMapIterator.Create(FOldInvalidTilesMap) do
1224 try
1225 while Next do
1226 MicroTilesUnion(FInvalidTiles, PMicroTiles(Data)^);
1227 finally
1228 Free;
1229 end;
1230
1231 FUseInvalidTiles := True;
1232 ResetAdaptiveMode;
1233 end;
1234 FOldInvalidTilesMap.Clear;
1235 FOldInvalidTilesValid := True;
1236 end;
1237 end;
1238end;
1239
1240procedure TMicroTilesRepaintOptimizer.ValidateWorkingTiles;
1241begin
1242 if not FWorkingTilesValid then // check if working microtiles need resize...
1243 begin
1244 MicroTilesSetSize(FTempTiles, FBufferBounds);
1245 MicroTilesSetSize(FInvalidTiles, FBufferBounds);
1246 MicroTilesSetSize(FForcedInvalidTiles, FBufferBounds);
1247 FWorkingTilesValid := True;
1248 end;
1249end;
1250
1251procedure TMicroTilesRepaintOptimizer.BufferResizedHandler(const NewWidth, NewHeight: Integer);
1252begin
1253 FBufferBounds := MakeRect(0, 0, NewWidth, NewHeight);
1254 Reset;
1255end;
1256
1257procedure TMicroTilesRepaintOptimizer.Reset;
1258begin
1259 FWorkingTilesValid := False; // force resizing of working microtiles
1260 FOldInvalidTilesValid := False; // force resizing and rerendering of invalid tiles
1261 UpdateOldInvalidTiles;
1262
1263 // mark whole buffer area invalid...
1264 MicroTilesClear(FForcedInvalidTiles, MICROTILE_FULL);
1265 FForcedInvalidTiles.BoundsUsedTiles := MakeRect(0, 0, FForcedInvalidTiles.Columns, FForcedInvalidTiles.Rows);
1266 FUseInvalidTiles := True;
1267end;
1268
1269function TMicroTilesRepaintOptimizer.UpdatesAvailable: Boolean;
1270begin
1271 UpdateOldInvalidTiles;
1272 Result := FUseInvalidTiles;
1273end;
1274
1275procedure TMicroTilesRepaintOptimizer.UpdateOldInvalidTiles;
1276var
1277 I, J: Integer;
1278 TilesPtr: PMicroTiles;
1279 Layer: TCustomLayer;
1280begin
1281 if not FOldInvalidTilesValid then // check if old Invalid tiles need resize and rerendering...
1282 begin
1283 ValidateWorkingTiles;
1284
1285 for I := 0 to LayerCollections.Count - 1 do
1286 with TLayerCollection(LayerCollections[I]) do
1287 for J := 0 to Count - 1 do
1288 begin
1289 Layer := Items[J];
1290 TilesPtr := FOldInvalidTilesMap.Add(Layer)^;
1291
1292 MicroTilesSetSize(TilesPtr^, FBufferBounds);
1293 DrawLayerToMicroTiles(TilesPtr^, Layer);
1294 TCustomLayerAccess(Layer).Invalid := False;
1295 end;
1296
1297 FInvalidLayers.Clear;
1298
1299 FOldInvalidTilesValid := True;
1300 FUseInvalidTiles := False;
1301 end;
1302end;
1303
1304procedure TMicroTilesRepaintOptimizer.RegisterLayerCollection(Layers: TLayerCollection);
1305begin
1306 inherited;
1307
1308 if Enabled then
1309 with TLayerCollectionAccess(Layers) do
1310 begin
1311 OnLayerUpdated := LayerUpdateHandler;
1312 OnAreaUpdated := AreaUpdateHandler;
1313 OnListNotify := LayerCollectionNotifyHandler;
1314 end;
1315end;
1316
1317procedure TMicroTilesRepaintOptimizer.UnregisterLayerCollection(Layers: TLayerCollection);
1318begin
1319 with TLayerCollectionAccess(Layers) do
1320 begin
1321 OnLayerUpdated := nil;
1322 OnAreaUpdated := nil;
1323 OnListNotify := nil;
1324 end;
1325
1326 inherited;
1327end;
1328
1329procedure TMicroTilesRepaintOptimizer.SetEnabled(const Value: Boolean);
1330var
1331 I: Integer;
1332begin
1333 if Value <> Enabled then
1334 begin
1335 if Value then
1336 begin
1337 // initialize:
1338 for I := 0 to LayerCollections.Count - 1 do
1339 with TLayerCollectionAccess(LayerCollections[I]) do
1340 begin
1341 OnLayerUpdated := LayerUpdateHandler;
1342 OnAreaUpdated := AreaUpdateHandler;
1343 OnListNotify := LayerCollectionNotifyHandler;
1344 end;
1345
1346 BufferResizedHandler(Buffer.Width, Buffer.Height);
1347 end
1348 else
1349 begin
1350 // clean up:
1351 for I := 0 to LayerCollections.Count - 1 do
1352 with TLayerCollectionAccess(LayerCollections[I]) do
1353 begin
1354 OnLayerUpdated := nil;
1355 OnAreaUpdated := nil;
1356 OnListNotify := nil;
1357 end;
1358
1359 MicroTilesDestroy(FInvalidTiles);
1360 MicroTilesDestroy(FTempTiles);
1361 MicroTilesDestroy(FForcedInvalidTiles);
1362
1363 FUseInvalidTiles := False;
1364 FOldInvalidTilesValid := False;
1365 FOldInvalidTilesMap.Clear;
1366 FInvalidLayers.Clear;
1367 end;
1368 inherited;
1369 end;
1370end;
1371
1372procedure TMicroTilesRepaintOptimizer.SetAdaptiveMode(const Value: Boolean);
1373begin
1374 if FAdaptiveMode <> Value then
1375 begin
1376 FAdaptiveMode := Value;
1377 ResetAdaptiveMode;
1378 end;
1379end;
1380
1381procedure TMicroTilesRepaintOptimizer.ResetAdaptiveMode;
1382begin
1383 FTimeDelta := TIMER_LOWLIMIT;
1384 FAdaptionFailed := False;
1385 FPerformanceLevel := PL_MICROTILES;
1386end;
1387
1388procedure TMicroTilesRepaintOptimizer.BeginPaintBuffer;
1389begin
1390 if AdaptiveMode then FPerfTimer.Start;
1391end;
1392
1393procedure TMicroTilesRepaintOptimizer.EndPaintBuffer;
1394begin
1395 FUseInvalidTiles := False;
1396
1397{$IFDEF MICROTILES_DEBUGDRAW}
1398 {$IFDEF MICROTILES_DEBUGDRAW_UNOPTIMIZED}
1399 MicroTilesDebugDraw(FDebugMicroTiles, Buffer, False, FDebugWholeTiles);
1400 {$ELSE}
1401 MicroTilesDebugDraw(FDebugMicroTiles, Buffer, True, FDebugWholeTiles);
1402 {$ENDIF}
1403 MicroTilesClear(FDebugMicroTiles);
1404{$ENDIF}
1405
1406{$IFNDEF MICROTILES_NO_ADAPTION}
1407 EndAdaption;
1408{$ENDIF}
1409end;
1410
1411procedure TMicroTilesRepaintOptimizer.DrawLayerToMicroTiles(var DstTiles: TMicroTiles; Layer: TCustomLayer);
1412begin
1413 Buffer.BeginMeasuring(DrawMeasuringHandler);
1414 FWorkMicroTiles := @DstTiles;
1415 TCustomLayerAccess(Layer).DoPaint(Buffer);
1416 Buffer.EndMeasuring;
1417end;
1418
1419procedure TMicroTilesRepaintOptimizer.DrawMeasuringHandler(Sender: TObject; const Area: TRect;
1420 const Info: Cardinal);
1421begin
1422 AddArea(FWorkMicroTiles^, Area, Info);
1423end;
1424
1425procedure TMicroTilesRepaintOptimizer.PerformOptimization;
1426var
1427 I: Integer;
1428 Layer: TCustomLayer;
1429 UseWholeTiles: Boolean;
1430 LayerTilesPtr: PMicroTiles;
1431begin
1432 if FUseInvalidTiles then
1433 begin
1434 ValidateWorkingTiles;
1435 // Determine if the use of whole tiles is better for current performance level
1436{$IFNDEF MICROTILES_NO_ADAPTION}
1437 UseWholeTiles := FPerformanceLevel > PL_MICROTILES;
1438{$ELSE}
1439 {$IFDEF MICROTILES_NO_ADAPTION_FORCE_WHOLETILES}
1440 UseWholeTiles := True;
1441 {$ELSE}
1442 UseWholeTiles := False;
1443 {$ENDIF}
1444{$ENDIF}
1445
1446 if FInvalidLayers.Count > 0 then
1447 begin
1448 for I := 0 to FInvalidLayers.Count - 1 do
1449 begin
1450 Layer := FInvalidLayers[I];
1451
1452 // Clear temporary tiles
1453 MicroTilesClearUsed(FTempTiles);
1454 // Draw layer to temporary tiles
1455 DrawLayerToMicroTiles(FTempTiles, Layer);
1456
1457 // Combine temporary tiles with the global invalid tiles
1458 MicroTilesUnion(FInvalidTiles, FTempTiles, UseWholeTiles);
1459
1460 // Retrieve old invalid tiles for the current layer
1461 LayerTilesPtr := FOldInvalidTilesMap[Layer];
1462
1463 // Combine old invalid tiles with the global invalid tiles
1464 MicroTilesUnion(FInvalidTiles, LayerTilesPtr^, UseWholeTiles);
1465
1466 // Copy temporary (current) invalid tiles to the layer
1467 MicroTilesCopy(LayerTilesPtr^, FTempTiles);
1468
1469 // Unmark layer as invalid
1470 TCustomLayerAccess(Layer).Invalid := False;
1471 end;
1472 FInvalidLayers.Clear;
1473 end;
1474
1475{$IFDEF MICROTILES_DEBUGDRAW}
1476 MicroTilesCalcRects(FInvalidTiles, InvalidRects, False, UseWholeTiles);
1477 MicroTilesCalcRects(FForcedInvalidTiles, InvalidRects, False, UseWholeTiles);
1478 MicroTilesCopy(FDebugMicroTiles, FInvalidTiles);
1479 MicroTilesUnion(FDebugMicroTiles, FForcedInvalidTiles);
1480 FDebugWholeTiles := UseWholeTiles;
1481{$ELSE}
1482 // Calculate optimized rectangles from global invalid tiles
1483 MicroTilesCalcRects(FInvalidTiles, InvalidRects, False, UseWholeTiles);
1484 // Calculate optimized rectangles from forced invalid tiles
1485 MicroTilesCalcRects(FForcedInvalidTiles, InvalidRects, False, UseWholeTiles);
1486{$ENDIF}
1487 end;
1488
1489{$IFNDEF MICROTILES_NO_ADAPTION}
1490 BeginAdaption;
1491{$ENDIF}
1492
1493{$IFDEF MICROTILES_DEBUGDRAW}
1494 if InvalidRects.Count > 0 then
1495 begin
1496 FDebugInvalidRects.Count := InvalidRects.Count;
1497 Move(InvalidRects[0]^, FDebugInvalidRects[0]^, InvalidRects.Count * SizeOf(TRect));
1498 InvalidRects.Clear;
1499 end;
1500{$ENDIF}
1501
1502 // Rects have been created, so we don't need the tiles any longer, clear them.
1503 MicroTilesClearUsed(FInvalidTiles);
1504 MicroTilesClearUsed(FForcedInvalidTiles);
1505end;
1506
1507procedure TMicroTilesRepaintOptimizer.BeginAdaption;
1508begin
1509 if AdaptiveMode and (FPerformanceLevel > PL_MICROTILES) then
1510 begin
1511 if Integer(GetTickCount) > FNextCheck then
1512 begin
1513 FPerformanceLevel := Constrain(FPerformanceLevel - 1, PL_MICROTILES, PL_FULLSCENE);
1514 {$IFDEF CODESITE}
1515 CodeSite.SendInteger('PrepareInvalidRects(Timed): FPerformanceLevel', FPerformanceLevel);
1516 {$ENDIF}
1517 FTimedCheck := True;
1518 end
1519 else if not FAdaptionFailed and (InvalidRects.Count < FOldInvalidRectsCount - INVALIDRECTS_DELTA) then
1520 begin
1521 FPerformanceLevel := Constrain(FPerformanceLevel - 1, PL_MICROTILES, PL_FULLSCENE);
1522 {$IFDEF CODESITE}
1523 CodeSite.SendInteger('PrepareInvalidRects: FPerformanceLevel', FPerformanceLevel);
1524 {$ENDIF}
1525 end
1526 else if FPerformanceLevel = PL_FULLSCENE then
1527 // we need a full scene rendition, so clear the invalid rects
1528 InvalidRects.Clear;
1529 end;
1530end;
1531
1532procedure TMicroTilesRepaintOptimizer.EndAdaption;
1533var
1534 TimeElapsed: Int64;
1535 Level: Integer;
1536begin
1537 // our KISS(TM) repaint mode balancing starts here...
1538 TimeElapsed := FPerfTimer.ReadValue;
1539
1540{$IFDEF MICROTILES_DEBUGDRAW}
1541 if FDebugInvalidRects.Count = 0 then
1542{$ELSE}
1543 if InvalidRects.Count = 0 then
1544{$ENDIF}
1545 FElapsedTimeForFullSceneRepaint := TimeElapsed
1546 else if AdaptiveMode then
1547 begin
1548 if TimeElapsed > FElapsedTimeForFullSceneRepaint then
1549 begin
1550 Level := Constrain(FPerformanceLevel + 1, PL_MICROTILES, PL_FULLSCENE);
1551 // did performance level change from previous level?
1552 if Level <> FPerformanceLevel then
1553 begin
1554{$IFDEF MICROTILES_DEBUGDRAW}
1555 FOldInvalidRectsCount := FDebugInvalidRects.Count;
1556{$ELSE}
1557 // save count of old invalid rects so we can use it in PrepareInvalidRects
1558 // the next time...
1559 FOldInvalidRectsCount := InvalidRects.Count;
1560{$ENDIF}
1561 FPerformanceLevel := Level;
1562 {$IFDEF CODESITE}
1563 CodeSite.SendInteger('EndPaintBuffer: FPerformanceLevel', FPerformanceLevel);
1564 {$ENDIF}
1565 // was this a timed check?
1566 if FTimedCheck then
1567 begin
1568 // time based approach failed, so add penalty
1569 FTimeDelta := Constrain(Integer(FTimeDelta + TIMER_PENALTY), TIMER_LOWLIMIT, TIMER_HIGHLIMIT);
1570 // schedule next check
1571 FNextCheck := Integer(GetTickCount) + FTimeDelta;
1572 FElapsedTimeOnLastPenalty := TimeElapsed;
1573 FTimedCheck := False;
1574 {$IFDEF CODESITE}
1575 CodeSite.SendInteger('timed check failed, new delta', FTimeDelta);
1576 {$ENDIF}
1577 end;
1578 {$IFDEF CODESITE}
1579 CodeSite.AddSeparator;
1580 {$ENDIF}
1581 FAdaptionFailed := True;
1582 end;
1583 end
1584 else if TimeElapsed < FElapsedTimeForFullSceneRepaint then
1585 begin
1586 if FTimedCheck then
1587 begin
1588 // time based approach had success!!
1589 // reset time delta back to lower limit, ie. remove penalties
1590 FTimeDelta := TIMER_LOWLIMIT;
1591 // schedule next check
1592 FNextCheck := Integer(GetTickCount) + FTimeDelta;
1593 FTimedCheck := False;
1594 {$IFDEF CODESITE}
1595 CodeSite.SendInteger('timed check succeeded, new delta', FTimeDelta);
1596 CodeSite.AddSeparator;
1597 {$ENDIF}
1598 FAdaptionFailed := False;
1599 end
1600 else
1601 begin
1602 // invalid rect count approach had success!!
1603 // shorten time for next check to benefit nonetheless in case we have a fallback...
1604 if FTimeDelta > TIMER_LOWLIMIT then
1605 begin
1606 // remove the penalty value 4 times from the current time delta
1607 FTimeDelta := Constrain(FTimeDelta - 4 * TIMER_PENALTY, TIMER_LOWLIMIT, TIMER_HIGHLIMIT);
1608 // schedule next check
1609 FNextCheck := Integer(GetTickCount) + FTimeDelta;
1610 {$IFDEF CODESITE}
1611 CodeSite.SendInteger('invalid rect count approach succeeded, new timer delta', FTimeDelta);
1612 CodeSite.AddSeparator;
1613 {$ENDIF}
1614 end;
1615 FAdaptionFailed := False;
1616 end;
1617 end
1618 else if (TimeElapsed < FElapsedTimeOnLastPenalty) and FTimedCheck then
1619 begin
1620 // time approach had success optimizing the situation, so shorten time until next check
1621 FTimeDelta := Constrain(FTimeDelta - TIMER_PENALTY, TIMER_LOWLIMIT, TIMER_HIGHLIMIT);
1622 // schedule next check
1623 FNextCheck := Integer(GetTickCount) + FTimeDelta;
1624 FTimedCheck := False;
1625 {$IFDEF CODESITE}
1626 CodeSite.SendInteger('timed check succeeded, new delta', FTimeDelta);
1627 CodeSite.AddSeparator;
1628 {$ENDIF}
1629 end;
1630 end;
1631
1632 FElapsedTimeForLastRepaint := TimeElapsed;
1633end;
1634
1635{$IFDEF CODESITE}
1636
1637{ TDebugMicroTilesRepaintOptimizer }
1638
1639procedure TDebugMicroTilesRepaintOptimizer.AreaUpdateHandler(Sender: TObject;
1640 const Area: TRect; const Info: Cardinal);
1641begin
1642 DumpCallStack('TDebugMicroTilesRepaintOptimizer.AreaUpdateHandler');
1643 inherited;
1644end;
1645
1646procedure TDebugMicroTilesRepaintOptimizer.BeginPaintBuffer;
1647begin
1648 DumpCallStack('TDebugMicroTilesRepaintOptimizer.BeginPaintBuffer');
1649 inherited;
1650end;
1651
1652procedure TDebugMicroTilesRepaintOptimizer.BufferResizedHandler(const NewWidth,
1653 NewHeight: Integer);
1654begin
1655 DumpCallStack('TDebugMicroTilesRepaintOptimizer.BufferResizedHandler');
1656 inherited;
1657end;
1658
1659procedure TDebugMicroTilesRepaintOptimizer.EndPaintBuffer;
1660begin
1661 DumpCallStack('TDebugMicroTilesRepaintOptimizer.EndPaintBuffer');
1662 inherited;
1663 CodeSite.AddSeparator;
1664end;
1665
1666procedure TDebugMicroTilesRepaintOptimizer.LayerUpdateHandler(Sender: TObject;
1667 Layer: TCustomLayer);
1668begin
1669 DumpCallStack('TDebugMicroTilesRepaintOptimizer.LayerUpdateHandler');
1670 inherited;
1671end;
1672
1673procedure TDebugMicroTilesRepaintOptimizer.PerformOptimization;
1674begin
1675 DumpCallStack('TDebugMicroTilesRepaintOptimizer.PerformOptimization');
1676 inherited;
1677end;
1678
1679procedure TDebugMicroTilesRepaintOptimizer.Reset;
1680begin
1681 DumpCallStack('TDebugMicroTilesRepaintOptimizer.Reset');
1682 inherited;
1683 CodeSite.AddSeparator;
1684end;
1685
1686function TDebugMicroTilesRepaintOptimizer.UpdatesAvailable: Boolean;
1687begin
1688 DumpCallStack('TDebugMicroTilesRepaintOptimizer.UpdatesAvailable');
1689 Result := inherited UpdatesAvailable;
1690end;
1691
1692{$ENDIF}
1693
1694const
1695 FID_MICROTILEUNION = 0;
1696 FID_MICROTILESUNION = 1;
1697
1698var
1699 Registry: TFunctionRegistry;
1700
1701procedure RegisterBindings;
1702begin
1703 Registry := NewRegistry('GR32_MicroTiles bindings');
1704 Registry.RegisterBinding(FID_MICROTILEUNION, @@MicroTileUnion);
1705 Registry.RegisterBinding(FID_MICROTILESUNION, @@MicroTilesU);
1706 Registry.Add(FID_MICROTILEUNION, @MicroTileUnion_Pas);
1707 Registry.Add(FID_MICROTILESUNION, @MicroTilesUnion_Pas);
1708
1709{$IFNDEF PUREPASCAL}
1710{$IFDEF TARGET_x86}
1711 Registry.Add(FID_MICROTILEUNION, @MicroTileUnion_EMMX, [ciEMMX]);
1712 Registry.Add(FID_MICROTILESUNION, @MicroTilesUnion_EMMX, [ciEMMX]);
1713{$ENDIF}
1714{$ENDIF}
1715 Registry.RebindAll;
1716end;
1717
1718initialization
1719 RegisterBindings;
1720
1721end.
Note: See TracBrowser for help on using the repository browser.