gr32_microtiles.pas

skin components for design of your applicastions

      for J := 0 to Count - 1 do
      begin
        Layer := Items[J];
        TilesPtr := FOldInvalidTilesMap.Add(Layer)^;

        MicroTilesSetSize(TilesPtr^, FBufferBounds);
        DrawLayerToMicroTiles(TilesPtr^, Layer);
        TCustomLayerAccess(Layer).Invalid := False;
      end;

    FInvalidLayers.Clear;

    FOldInvalidTilesValid := True;
    FUseInvalidTiles := False;
  end;
end;

procedure TMicroTilesRepaintOptimizer.RegisterLayerCollection(Layers: TLayerCollection);
begin
  inherited;

  if Enabled then
    with TLayerCollectionAccess(Layers) do
    begin
      OnLayerUpdated := LayerUpdateHandler;
      OnAreaUpdated := AreaUpdateHandler;
      OnListNotify := LayerCollectionNotifyHandler;
    end;
end;

procedure TMicroTilesRepaintOptimizer.UnregisterLayerCollection(Layers: TLayerCollection);
begin
  with TLayerCollectionAccess(Layers) do
  begin
    OnLayerUpdated := nil;
    OnAreaUpdated := nil;
    OnListNotify := nil;
  end;

  inherited;
end;

procedure TMicroTilesRepaintOptimizer.SetEnabled(const Value: Boolean);
var
  I: Integer;
begin
  if Value <> Enabled then
  begin
    if Value then
    begin
      // initialize:
      for I := 0 to LayerCollections.Count - 1 do
      with TLayerCollectionAccess(LayerCollections[I]) do
      begin
        OnLayerUpdated := LayerUpdateHandler;
        OnAreaUpdated := AreaUpdateHandler;
        OnListNotify := LayerCollectionNotifyHandler;
      end;

      BufferResizedHandler(Buffer.Width, Buffer.Height);
    end
    else
    begin
      // clean up:
      for I := 0 to LayerCollections.Count - 1 do
      with TLayerCollectionAccess(LayerCollections[I]) do
      begin
        OnLayerUpdated := nil;
        OnAreaUpdated := nil;
        OnListNotify := nil;
      end;

      MicroTilesDestroy(FInvalidTiles);
      MicroTilesDestroy(FTempTiles);
      MicroTilesDestroy(FForcedInvalidTiles);

      FUseInvalidTiles := False;
      FOldInvalidTilesValid := False;
      FOldInvalidTilesMap.Clear;
      FInvalidLayers.Clear;
    end;
    inherited;
  end;
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.Start;
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];

        // 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;

{$IFDEF MICROTILES_DEBUGDRAW}
    MicroTilesCalcRects(FInvalidTiles, InvalidRects, False, UseWholeTiles);
    MicroTilesCalcRects(FForcedInvalidTiles, InvalidRects, False, UseWholeTiles);
    MicroTilesCopy(FDebugMicroTiles, FInvalidTiles);
    MicroTilesUnion(FDebugMicroTiles, FForcedInvalidTiles);
    FDebugWholeTiles := UseWholeTiles;
{$ELSE}
    // Calculate optimized rectangles from global invalid tiles
    MicroTilesCalcRects(FInvalidTiles, InvalidRects, False, UseWholeTiles);
    // Calculate optimized rectangles from forced invalid tiles
    MicroTilesCalcRects(FForcedInvalidTiles, InvalidRects, False, 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.ReadValue;

{$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.AreaUpdateHandler(Sender: TObject;
  const Area: TRect; const Info: Cardinal);
begin
  DumpCallStack('TDebugMicroTilesRepaintOptimizer.AreaUpdateHandler');
  inherited;
end;

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.LayerUpdateHandler(Sender: TObject;
  Layer: TCustomLayer);
begin
  DumpCallStack('TDebugMicroTilesRepaintOptimizer.LayerUpdateHandler');
  inherited;
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}

procedure SetupFunctions;
begin
  if HasEMMX then
  begin
    MicroTileUnion := M_MicroTileUnion;
    MicroTilesU := M_MicroTilesUnion;    // internal
  end
  else
  begin
    MicroTileUnion := _MicroTileUnion;
    MicroTilesU := _MicroTilesUnion;     // internal
  end;
end;


initialization
  SetupFunctions;

end.