gr32_microtiles.pas

skin components for design of your applicastions

          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
  TLayerCollectionAccess = class(TLayerCollection);
  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;
  FPerfTimer := TPerfTimer.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);

  FPerfTimer.Free;
  FInvalidLayers.Free;
  FOldInvalidTilesMap.Free;

{$IFDEF MICROTILES_DEBUGDRAW}
  FDebugInvalidRects.Free;
  MicroTilesDestroy(FDebugMicroTiles);
{$ENDIF}

  inherited;
end;

procedure TMicroTilesRepaintOptimizer.AreaUpdateHandler(Sender: TObject; const Area: TRect;
  const Info: Cardinal);
begin
  ValidateWorkingTiles;
  AddArea(FForcedInvalidTiles, Area, Info);
  FUseInvalidTiles := True;
end;

procedure TMicroTilesRepaintOptimizer.AddArea(var Tiles: TMicroTiles; const Area: TRect;
  const Info: Cardinal);
var
  LineWidth: Integer;
  TempRect: TRect;
begin
  if Info and AREAINFO_LINE <> 0 then
  begin
    LineWidth := Info and $00FFFFFF;
    TempRect := Area;
    InflateArea(TempRect, LineWidth, LineWidth);
    with TempRect do
      MicroTilesAddLine(Tiles, Left, Top, Right, Bottom, LineWidth, FPerformanceLevel > PL_MICROTILES);
  end
  else
    MicroTilesAddRect(Tiles, Area, FPerformanceLevel > PL_MICROTILES);
end;

procedure TMicroTilesRepaintOptimizer.LayerUpdateHandler(Sender: TObject; Layer: TCustomLayer);
begin
  if FOldInvalidTilesValid and not TCustomLayerAccess(Layer).Invalid then
  begin
    FInvalidLayers.Add(Layer);
    TCustomLayerAccess(Layer).Invalid := True;
    FUseInvalidTiles := True;
  end;
end;

procedure TMicroTilesRepaintOptimizer.LayerCollectionNotifyHandler(Sender: TLayerCollection;
  Action: TLayerListNotification; Layer: TCustomLayer; Index: Integer);
var
  TilesPtr: PMicroTiles;
begin
  case Action of
    lnLayerAdded, lnLayerInserted:
      begin
        TilesPtr := FOldInvalidTilesMap.Add(Layer)^;
        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[Layer]^);
          FUseInvalidTiles := True;
        end;
        FInvalidLayers.Remove(Layer);
        FOldInvalidTilesMap.Remove(Layer);
      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;
begin
  if not FOldInvalidTilesValid then  // check if old Invalid tiles need resize and rerendering...
  begin
    ValidateWorkingTiles;

    for I := 0 to LayerCollections.Count - 1 do
    with TLayerCollection(LayerCollections[I]) do