Changeset 6 for trunk

Timestamp:

Mar 30, 2016, 10:50:22 PM (9 years ago)

Author:

chronos

Message:

• Modified: TBlockMap reworked to sparse map using list of value changes. Now much less memory is required to keep sector map of high capacity drives. Also drawing of map is much faster.

Location:

trunk

Files:

• UBlockMap.pas (modified) (9 diffs)
• UDriveScan.pas (modified) (5 diffs)
• UFormMain.pas (modified) (3 diffs)

trunk/UBlockMap.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, Graphics, Math;
+  Classes, SysUtils, Graphics, Math, Contnrs, Dialogs;
 
 type
   TSectorState = (bsNone, bsOk, bsDamaged);
+
+  TChange = class
+    Index: Integer;
+    Value: TSectorState;
+  end;
 
   { TBlockMap }
@@ -18 +23 @@
     FDrawSize: TPoint;
     FSectorPerBlock: Integer;
-    FSectors: array of TSectorState;
-    FBlocks: array of TSectorState;
+    FSectorCount: Integer;
+    FBlockCount: Integer;
+    FChanges: TObjectList; // TObjectList<TChange>
     function GetBlockCount: Integer;
     function GetSector(Index: Integer): TSectorState;
-    function GetSectorCount: Integer;
     procedure SetBlockCount(AValue: Integer);
     procedure SetBlockSize(AValue: TPoint);
@@ -30 +35 @@
     procedure SetSectorPerBlock(AValue: Integer);
     procedure UpdateBlockSize;
-    procedure UpdateBlocks;
+    function FindChange(Index: Integer): TChange;
+    function GetCombinedSectors(StartIndex, EndIndex: Integer): TSectorState;
   public
     ItemsCount: TPoint;
-    function CombineSectors(From, Count: Integer): TSectorState;
     procedure Draw(Canvas: TCanvas);
     procedure Clear;
     constructor Create;
+    destructor Destroy; override;
     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 GetSectorCount write SetSectorCount;
+    property SectorCount: Integer read FSectorCount write SetSectorCount;
     property BlockCount: Integer read GetBlockCount;
     property Sectors[Index: Integer]: TSectorState read GetSector write SetSector;
@@ -48 +54 @@
 implementation
 
+resourcestring
+  SBlockSizeZeroNotAllowed = 'BlockSize can''t be set to 0';
+  SIndexOutOfRange = 'Index %d out of range';
+  SEmptyChangesList = 'Empty changes list';
+  SUnexpectedCombination = 'Unexpected combination';
+
 { TBlockMap }
 
-function TBlockMap.GetSectorCount: Integer;
-begin
-  Result := Length(FSectors);
-end;
-
 procedure TBlockMap.SetBlockCount(AValue: Integer);
 begin
-  SetLength(FBlocks, AValue);
+  if FBlockCount = AValue then Exit;
+  FBlockCount := AValue;
 end;
 
@@ -64 +72 @@
   if (FBlockSize.X = AValue.X) and (FBlockSize.Y = AValue.Y) then Exit;
   if (AValue.X = 0) or (AValue.Y = 0) then
-    raise Exception.Create('BlockSize can''t be set to 0');
+    raise Exception.Create(SBlockSizeZeroNotAllowed);
   FBlockSize := AValue;
 end;
@@ -76 +84 @@
 
 function TBlockMap.GetSector(Index: Integer): TSectorState;
-begin
-  Result := FSectors[Index];
+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 := Length(FBlocks);
+  Result := FBlockCount;
 end;
 
 procedure TBlockMap.SetSector(Index: Integer; AValue: TSectorState);
 var
-  BlockIndex: Integer;
-begin
-  FSectors[Index] := AValue;
-
-  // Update block
-  BlockIndex := Index div FSectorPerBlock;
-  if (AValue = bsDamaged) then FBlocks[BlockIndex] := bsDamaged
-  else if (AValue = bsOk) and (FBlocks[BlockIndex] = bsNone) then
-    FBlocks[BlockIndex] := bsOk;
+  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
+        TChange(FChanges[ChangeIndex]).Value := AValue;
+    end else raise Exception.Create(SUnexpectedCombination);
+  end else raise Exception.Create(Format(SIndexOutOfRange, [Index]));
 end;
 
 procedure TBlockMap.SetSectorCount(AValue: Integer);
-begin
-  if Length(FSectors) = AValue then Exit;
-  SetLength(FSectors, AValue);
+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 TChange(FChanges[I]).Index >= FSectorCount do Dec(I);
+  if TChange(FChanges[I]).Index >= FSectorCount then FChanges.Count := I;
+
   UpdateBlockSize;
 end;
@@ -117 +217 @@
   FSectorPerBlock := Ceil(SectorCount / (ItemsCount.X * ItemsCount.Y));
   SetBlockCount(Ceil(SectorCount / FSectorPerBlock));
-  UpdateBlocks;
-end;
-
-procedure TBlockMap.UpdateBlocks;
-var
-  I: Integer;
-begin
-  for I := 0 to BlockCount - 1 do
-    FBlocks[I] := CombineSectors(I * FSectorPerBlock, FSectorPerBlock);
-end;
-
-function TBlockMap.CombineSectors(From, Count: Integer): TSectorState;
-var
-  I: Integer;
-  UpTo: Integer;
+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;
-  UpTo := From + Count - 1;
-  if UpTo >= SectorCount then Upto := SectorCount - 1;
-  for I := From to UpTo do begin
-
-    if (Result = bsNone) and (Sectors[I] = bsOk) then Result := bsOk
-    else if (Result = bsOk) and (Sectors[I] = bsDamaged) then Result := bsDamaged;
+  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 = bsNone) and (TChange(FChanges[ChangeIndex]).Value = bsOk) then Result := bsOk
+        else if TChange(FChanges[ChangeIndex]).Value = bsDamaged then Result := bsDamaged;
+      Inc(ChangeIndex);
+    end;
   end;
 end;
@@ -161 +287 @@
       Rect := Bounds((I mod ItemsCount.X) * BlockSize.X,
         (I div ItemsCount.X) * BlockSize.Y, BlockSize.X - 1, BlockSize.Y - 1);
-      BlockState := FBlocks[I];
+      BlockState := GetCombinedSectors(I * SectorPerBlock, (I + 1) * SectorPerBlock);
       if BlockState = bsOk then Canvas.Brush.Color := clGreen
         else if BlockState = bsDamaged then Canvas.Brush.Color := clRed
@@ -172 +298 @@
 
 procedure TBlockMap.Clear;
-var
-  I: Integer;
-begin
-  for I := 0 to SectorCount - 1 do
-    FSectors[I] := bsNone;
+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;
 

trunk/UDriveScan.pas

@@ -54 +54 @@
 implementation
 
+resourcestring
+  SUnknownRunMode = 'Unknown run mode';
+
 
 { TScanThread }
@@ -82 +85 @@
 procedure TDriveScan.Start;
 begin
-  ScanThread := TScanThread.Create(True);
-  ScanThread.Scan := Self;
-  ScanThread.Start;
+  if Terminated then begin
+    Terminated := False;
+    ScanThread := TScanThread.Create(True);
+    ScanThread.Scan := Self;
+    ScanThread.Start;
+  end;
 end;
 
@@ -120 +126 @@
         if Mode = rmRead then RealSize := F.Read(Buffer[0], SectorSize)
           else if Mode = rmWrite then RealSize := F.Write(Buffer[0], SectorSize)
-          else raise Exception.Create('Unknwon run mode');
+          else raise Exception.Create(SUnknownRunMode);
       end;
     finally
@@ -144 +150 @@
 procedure TDriveScan.Stop;
 begin
-  Terminated := True;
-  ScanThread.Terminate;
-  ScanThread.WaitFor;
-  FreeAndNil(ScanThread);
+  if not Terminated then begin
+    Terminated := True;
+    ScanThread.Terminate;
+    ScanThread.WaitFor;
+    FreeAndNil(ScanThread);
+  end;
 end;
 
@@ -160 +168 @@
 destructor TDriveScan.Destroy;
 begin
+  Stop;
   FreeAndNil(BlockMap);
   FreeAndNil(Lock);

trunk/UFormMain.pas

@@ -120 +120 @@
   DriveScan.Drive := EditDrive.Text;
   DriveScan.SectorSize := Project.SectorSize;
-  DriveScan.Terminated := False;
   DriveScan.Mode := TRunMode(ComboBoxRunMode.ItemIndex);
   DriveScan.WritePattern := StrToInt(EditPattern.Text);
@@ -145 +144 @@
 procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
 begin
-  DriveScan.Terminated := True;
 end;
 
 procedure TFormMain.FormDestroy(Sender: TObject);
 begin
+  Timer1.Enabled := False;
   FreeAndNil(Project);
   FreeAndNil(DriveScan);
@@ -208 +207 @@
 procedure TFormMain.UpdateInterface;
 begin
-  AScanStart.Enabled := DriveScan.Terminated = True;
-  AScanStop.Enabled := DriveScan.Terminated = False;
+  if Assigned(DriveScan) then begin
+    AScanStart.Enabled := DriveScan.Terminated = True;
+    AScanStop.Enabled := DriveScan.Terminated = False;
+  end;
 end;