source: trunk/UBlockMap.pas

unit UBlockMap;

{$mode delphi}

interface

uses
  Classes, SysUtils, Graphics, Math, Contnrs, Dialogs, DOM, UXMLUtils;

type
  TSectorState = (bsNone, bsRead, bsDamaged, bsWrite);

  TChange = class
    Index: Integer;
    Value: TSectorState;
  end;

  { TBlockMap }

  TBlockMap = class
  private
    FBlockSize: TPoint;
    FDrawSize: TPoint;
    FSectorPerBlock: Integer;
    FSectorCount: Integer;
    FBlockCount: Integer;
    FChanges: TObjectList; // TObjectList<TChange>
    function GetBlockCount: Integer;
    function GetSector(Index: Integer): TSectorState;
    procedure SetBlockCount(AValue: Integer);
    procedure SetBlockSize(AValue: TPoint);
    procedure SetDrawSize(AValue: TPoint);
    procedure SetSector(Index: Integer; AValue: TSectorState);
    procedure SetSectorCount(AValue: Integer);
    procedure SetSectorPerBlock(AValue: Integer);
    procedure UpdateBlockSize;
    function FindChange(Index: Integer): TChange;
    function GetCombinedSectors(StartIndex, EndIndex: Integer): TSectorState;
  public
    ItemsCount: TPoint;
    procedure Draw(Canvas: TCanvas);
    procedure Clear;
    constructor Create;
    destructor Destroy; override;
    procedure SaveToNode(Node: TDOMNode);
    procedure LoadFromNode(Node: TDOMNode);
    property BlockSize: TPoint read FBlockSize write SetBlockSize;
    property DrawSize: TPoint read FDrawSize write SetDrawSize;
    property SectorPerBlock: Integer read FSectorPerBlock write SetSectorPerBlock;
    property SectorCount: Integer read FSectorCount write SetSectorCount;
    property BlockCount: Integer read GetBlockCount;
    property Sectors[Index: Integer]: TSectorState read GetSector write SetSector;
  end;


implementation

resourcestring
  SBlockSizeZeroNotAllowed = 'BlockSize can''t be set to 0';
  SIndexOutOfRange = 'Index %d out of range';
  SEmptyChangesList = 'Empty changes list';
  SUnexpectedCombination = 'Unexpected combination';

{ TBlockMap }

procedure TBlockMap.SetBlockCount(AValue: Integer);
begin
  if FBlockCount = AValue then Exit;
  FBlockCount := AValue;
end;

procedure TBlockMap.SetBlockSize(AValue: TPoint);
begin
  if (FBlockSize.X = AValue.X) and (FBlockSize.Y = AValue.Y) then Exit;
  if (AValue.X = 0) or (AValue.Y = 0) then
    raise Exception.Create(SBlockSizeZeroNotAllowed);
  FBlockSize := AValue;
end;

procedure TBlockMap.SetDrawSize(AValue: TPoint);
begin
  if (FDrawSize.X = AValue.X) and (FDrawSize.Y = AValue.Y) then Exit;
  FDrawSize := AValue;
  UpdateBlockSize;
end;

function TBlockMap.GetSector(Index: Integer): TSectorState;
var
  Change: TChange;
begin
  if Index < FSectorCount then begin
    Change := FindChange(Index);
    if Assigned(Change) then Result := Change.Value
      else raise Exception.Create(SIndexOutOfRange);
  end else raise Exception.Create(SIndexOutOfRange);
end;

function TBlockMap.GetBlockCount: Integer;
begin
  Result := FBlockCount;
end;

procedure TBlockMap.SetSector(Index: Integer; AValue: TSectorState);
var
  LeftBeforeSame, RightBeforeSame: Boolean;
  LeftAfterSame, RightAfterSame: Boolean;
  Change: TChange;
  ChangeIndex: Integer;
begin
  Change := FindChange(Index);
  if Assigned(Change) then begin
    if Change.Value = AValue then Exit;

    ChangeIndex := FChanges.IndexOf(Change);
    // Before
    if ChangeIndex > 0 then begin
      if (Index - TChange(FChanges[ChangeIndex]).Index) > 0 then LeftBeforeSame := True
        else LeftBeforeSame := TChange(FChanges[ChangeIndex - 1]).Value = Change.Value;
    end else begin
      LeftBeforeSame := Change.Value = bsNone;
    end;
    if ChangeIndex < (FChanges.Count - 1) then begin
      if (TChange(FChanges[ChangeIndex]).Index - Index) > 0 then RightBeforeSame := True
        else RightBeforeSame := TChange(FChanges[ChangeIndex + 1]).Value = Change.Value;
    end else begin
      RightBeforeSame := Change.Value = bsNone;
    end;
    // After
    if ChangeIndex > 0 then begin
      if (Index - TChange(FChanges[ChangeIndex]).Index) > 0 then LeftAfterSame := True
        else LeftAfterSame := TChange(FChanges[ChangeIndex - 1]).Value = AValue;
    end else begin
      LeftAfterSame := AValue = bsNone;
    end;
    if ChangeIndex < (FChanges.Count - 1) then begin
      if (TChange(FChanges[ChangeIndex]).Index - Index) > 0 then RightAfterSame := True
        else RightAfterSame := TChange(FChanges[ChangeIndex + 1]).Value = AValue;
    end else begin
      RightAfterSame := AValue = bsNone;
    end;

    // Update items
    if not LeftBeforeSame and not RightBeforeSame and not LeftAfterSame and not RightAfterSame then begin
      Change.Value := AValue
    end else
    if not LeftBeforeSame and not RightBeforeSame and not LeftAfterSame and RightAfterSame then begin
      FChanges.Delete(ChangeIndex + 1);
      Change.Value := AValue;
    end else
    if not LeftBeforeSame and not RightBeforeSame and LeftAfterSame and not RightAfterSame then begin
      FChanges.Delete(ChangeIndex);
    end else
    if not LeftBeforeSame and not RightBeforeSame and LeftAfterSame and RightAfterSame then begin
      FChanges.Delete(ChangeIndex + 1);
      FChanges.Delete(ChangeIndex);
    end else
    if not LeftBeforeSame and RightBeforeSame and not LeftAfterSame and not RightAfterSame then begin
      FChanges.Insert(ChangeIndex + 1, TChange.Create);
      TChange(FChanges[ChangeIndex + 1]).Index := Index + 1;
      TChange(FChanges[ChangeIndex + 1]).Value := Change.Value;
      Change.Value := AValue;
    end else
    if not LeftBeforeSame and RightBeforeSame and LeftAfterSame and not RightAfterSame then begin
      Change.Index := Index + 1;
    end else
    if not LeftBeforeSame and RightBeforeSame and not LeftAfterSame and not RightAfterSame then begin
      FChanges.Insert(ChangeIndex, TChange.Create);
      TChange(FChanges[ChangeIndex]).Index := Index;
      TChange(FChanges[ChangeIndex]).Value := AValue;
    end else
    if LeftBeforeSame and not RightBeforeSame and not LeftAfterSame and RightAfterSame then begin
      TChange(FChanges[ChangeIndex + 1]).Index := Index;
    end else
    if LeftBeforeSame and RightBeforeSame and not LeftAfterSame and not RightAfterSame then begin
      if ChangeIndex > 0 then begin
        FChanges.Insert(ChangeIndex, TChange.Create);
        TChange(FChanges[ChangeIndex]).Index := Index;
        TChange(FChanges[ChangeIndex]).Value := AValue;
      end;
      FChanges.Insert(ChangeIndex + 1, TChange.Create);
      TChange(FChanges[ChangeIndex + 1]).Index := Index + 1;
      TChange(FChanges[ChangeIndex + 1]).Value := Change.Value;
      if ChangeIndex = 0 then begin
        TChange(FChanges[ChangeIndex]).Index := Index;
        TChange(FChanges[ChangeIndex]).Value := AValue;
        FChanges.Insert(ChangeIndex, TChange.Create);
        TChange(FChanges[ChangeIndex]).Index := 0;
        TChange(FChanges[ChangeIndex]).Value := bsNone;
      end;
    end else raise Exception.Create(SUnexpectedCombination);
  end else raise Exception.Create(Format(SIndexOutOfRange, [Index]));
end;

procedure TBlockMap.SetSectorCount(AValue: Integer);
var
  I: Integer;
begin
  if FSectorCount = AValue then Exit;
  if (FChanges.Count = 0) and (AValue > 0) then begin
    FChanges.Add(TChange.Create);
    TChange(FChanges[0]).Index := 0;
    TChange(FChanges[0]).Value := bsNone;
  end;
  FSectorCount := AValue;

  // Cut changes outside of max sector count
  I := FChanges.Count - 1;
  while (I >= 0) and (TChange(FChanges[I]).Index >= FSectorCount) do Dec(I);
  if (I >= 0) and (TChange(FChanges[I]).Index >= FSectorCount) then FChanges.Count := I;

  UpdateBlockSize;
end;

procedure TBlockMap.SetSectorPerBlock(AValue: Integer);
begin
  if FSectorPerBlock = AValue then Exit;
  FSectorPerBlock := AValue;
  UpdateBlockSize;
end;

procedure TBlockMap.UpdateBlockSize;
begin
  ItemsCount := Point(Trunc(FDrawSize.X / BlockSize.X), Trunc(FDrawSize.Y / BlockSize.Y));
  if (ItemsCount.X > 0) and (ItemsCount.Y > 0) then begin
    FSectorPerBlock := Ceil(SectorCount / (ItemsCount.X * ItemsCount.Y));
  end else FSectorPerBlock := 1;
  if FSectorPerBlock < 1 then FSectorPerBlock := 1;
  SetBlockCount(Ceil(SectorCount / FSectorPerBlock));
end;

function TBlockMap.FindChange(Index: Integer): TChange;
var
  LeftIndex, MiddleIndex, RightIndex: Integer;
begin
  if Fchanges.Count = 0 then raise Exception.Create(SEmptyChangesList);
  if FChanges.Count = 1 then begin
    Result := TChange(FChanges[0]);
    Exit;
  end;
  Result := nil;
  LeftIndex := 0;
  RightIndex := FChanges.Count - 1;
  while (LeftIndex <= RightIndex) do begin
    MiddleIndex := LeftIndex + (RightIndex - LeftIndex) div 2;
    if (TChange(FChanges[MiddleIndex]).Index <= Index) and
    ((FChanges.Count = (MiddleIndex + 1)) or
    (TChange(FChanges[MiddleIndex + 1]).Index > Index)) then begin
      Result := TChange(FChanges[MiddleIndex]);
      Break;
    end;
    // Cut interval in half and use nearest section
    if TChange(FChanges[MiddleIndex]).Index < Index then begin
      if MiddleIndex = LeftIndex then Inc(LeftIndex)
        else LeftIndex := MiddleIndex
      end else begin
        if MiddleIndex = RightIndex then Dec(RightIndex)
          else RightIndex := MiddleIndex
      end;
  end;
end;

function TBlockMap.GetCombinedSectors(StartIndex, EndIndex: Integer
  ): TSectorState;
var
  Change: TChange;
  ChangeIndex: Integer;
begin
  Result := bsNone;
  Change := FindChange(StartIndex);
  if Assigned(Change) then begin
    ChangeIndex := FChanges.IndexOf(Change);
    while (ChangeIndex < FChanges.Count) and
     (TChange(FChanges[ChangeIndex]).Index <= EndIndex) do begin
      if (Result <> bsDamaged) and (TChange(FChanges[ChangeIndex]).Value = bsRead) then Result := bsRead
        else if (Result <> bsDamaged) and (TChange(FChanges[ChangeIndex]).Value = bsWrite) then Result := bsWrite
        else if TChange(FChanges[ChangeIndex]).Value = bsDamaged then Result := bsDamaged;
      Inc(ChangeIndex);
    end;
  end;
end;

procedure TBlockMap.Draw(Canvas: TCanvas);
var
  I: Integer;
  Rect: TRect;
  BlockState: TSectorState;
begin
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Color := clBlack;
  // Clean background
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := clBlack;
  Canvas.FillRect(0, 0, Canvas.Width, Canvas.Height);

  DrawSize := Point(Canvas.Width, Canvas.Height);
  if SectorPerBlock >= 1 then begin
    for I := 0 to BlockCount - 1 do begin
      Rect := Bounds((I mod ItemsCount.X) * BlockSize.X,
        (I div ItemsCount.X) * BlockSize.Y, BlockSize.X - 1, BlockSize.Y - 1);
      BlockState := GetCombinedSectors(I * SectorPerBlock, (I + 1) * SectorPerBlock);
      if BlockState = bsRead then Canvas.Brush.Color := clGreen
        else if BlockState = bsDamaged then Canvas.Brush.Color := clRed
        else if BlockState = bsWrite then Canvas.Brush.Color := clBlue
        else Canvas.Brush.Color := clSilver;
      Canvas.FillRect(Rect);
      //Canvas.TextOut(Rect.Left, Rect.Top, IntToStr(I));
    end;
  end;
end;

procedure TBlockMap.Clear;
begin
  FChanges.Clear;
  if FSectorCount > 0 then begin
    FChanges.Add(TChange.Create);
    TChange(FChanges[0]).Index := 0;
    TChange(FChanges[0]).Value := bsNone;
  end;
end;

constructor TBlockMap.Create;
begin
  FChanges := TObjectList.Create;
  FBlockSize := Point(12, 12);
  SectorPerBlock := 1;
  FSectorCount := 0;
end;

destructor TBlockMap.Destroy;
begin
  FreeAndNil(FChanges);
  inherited Destroy;
end;

procedure TBlockMap.SaveToNode(Node: TDOMNode);
var
  NewNode: TDOMNode;
  NewNode2: TDOMNode;
  I: Integer;
begin
  NewNode := Node.OwnerDocument.CreateElement('Changes');
  Node.AppendChild(NewNode);
  for I := 0 to FChanges.Count - 1 do begin
    NewNode2 := NewNode.OwnerDocument.CreateElement('Change');
    NewNode.AppendChild(NewNode2);
    WriteInteger(NewNode2, 'Index', TChange(FChanges[I]).Index);
    WriteInteger(NewNode2, 'Value', Integer(TChange(FChanges[I]).Value));
  end;
end;

procedure TBlockMap.LoadFromNode(Node: TDOMNode);
var
  NewNode: TDOMNode;
  NewNode2: TDOMNode;
  NewChange: TChange;
begin
  NewNode := Node.FindNode('Changes');
  if Assigned(NewNode) then begin
    FChanges.Count := 0;
    NewNode2 := NewNode.FirstChild;
    while Assigned(NewNode2) and (NewNode2.NodeName = 'Change') do begin
      NewChange := TChange.Create;
      NewChange.Index := ReadInteger(NewNode2, 'Index', 0);
      NewChange.Value := TSectorState(ReadInteger(NewNode2, 'Value', 0));
      FChanges.Add(NewChange);
      NewNode2 := NewNode2.NextSibling;
    end;
  end;
end;

end.