Lista jednokierunkowa - Furious Programming

unit List;

interface

uses
  SysUtils, Classes;

type
  TData = Cardinal;

type
  PElement = ^TElement;
  TElement = record
    Next: PElement;
    Data: TData;
  end;

const
  ELEMENT_DATA_SIZE = SizeOf(TData);

type
  TSimpleList = class(TObject)
  private
    FFirst: PElement;
    FLast: PElement;
    FCount: Cardinal;
    FCapacity: Cardinal;
  protected
    procedure ZeroFields();
    procedure CreateElement(AData: TData; out AElement: PElement);
    procedure FindByIndex(AIndex: Cardinal; out APrevious, AToken: PElement);
  public
    constructor Create();
    destructor Destroy(); override;
  public
    procedure Add(AData: TData);
    procedure Insert(AIndex: Cardinal; AData: TData);
    procedure Remove(AIndex: Cardinal);
    procedure Clear();
  public
    function Read(AIndex: Cardinal): TData;
    function Find(AData: TData): Integer;
  public
    procedure Print();
  public
    procedure SaveToFile(AFileName: TFileName);
    procedure LoadFromFile(AFileName: TFileName; AAppend: Boolean = False);
  public
    property Count: Cardinal read FCount;
    property Capacity: Cardinal read FCapacity;
  end;


implementation


  constructor TSimpleList.Create();
  begin
    inherited Create();
    ZeroFields();
  end;

  destructor TSimpleList.Destroy();
  begin
    Clear();
    inherited Destroy();
  end;

  procedure TSimpleList.ZeroFields();
  begin
    FFirst := nil;
    FLast := nil;
    FCount := 0;
    FCapacity := 0;
  end;

  procedure TSimpleList.CreateElement(AData: TData; out AElement: PElement);
  begin
    New(AElement);
    AElement^.Next := nil;
    AElement^.Data := AData;
  end;

  procedure TSimpleList.FindByIndex(AIndex: Cardinal; out APrevious, AToken: PElement);
  begin
    AToken := FFirst;
    APrevious := nil;

    while AIndex > 0 do
    begin
      APrevious := AToken;
      AToken := AToken^.Next;
      Dec(AIndex);
    end;
  end;

  procedure TSimpleList.Add(AData: TData);
  var
    peNew: PElement;
  begin
    CreateElement(AData, peNew);

    if FFirst = nil then
    begin
      FFirst := peNew;
      FLast := peNew;
    end
    else
    begin
      FLast^.Next := peNew;
      FLast := peNew;
    end;

    Inc(FCount);
    Inc(FCapacity, ELEMENT_DATA_SIZE);
  end;

  procedure TSimpleList.Insert(AIndex: Cardinal; AData: TData);
  var
    peNew, peToken, pePrevious: PElement;
  begin
    CreateElement(AData, peNew);

    if FFirst = nil then
    begin
      FFirst := peNew;
      FLast := peNew;
    end
    else
    begin
      FindByIndex(AIndex, pePrevious, peToken);

      if peToken = FFirst then
      begin
        peNew^.Next := FFirst;
        FFirst := peNew;
      end
      else
      begin
        pePrevious^.Next := peNew;
        peNew^.Next := peToken;

        if peNew^.Next = nil then
          FLast := peNew;
      end;
    end;

    Inc(FCount);
    Inc(FCapacity, ELEMENT_DATA_SIZE);
  end;

  procedure TSimpleList.Remove(AIndex: Cardinal);
  var
    peToken, pePrevious: PElement;
  begin
    if AIndex = 0 then
    begin
      peToken := FFirst;
      FFirst := FFirst^.Next;

      if FFirst = nil then
        FLast := nil;
    end
    else
    begin
      FindByIndex(AIndex, pePrevious, peToken);

      if peToken^.Next = nil then
      begin
        FLast := pePrevious;
        pePrevious^.Next := nil;
      end
      else
        pePrevious^.Next := peToken^.Next;
    end;

    Dispose(peToken);
    Dec(FCount);
    Dec(FCapacity, ELEMENT_DATA_SIZE);
  end;

  procedure TSimpleList.Clear();
  var
    peToken, peNext: PElement;
  begin
    peToken := FFirst;

    while peToken <> nil do
    begin
      peNext := peToken^.Next;
      Dispose(peToken);
      peToken := peNext;
    end;

    ZeroFields();
  end;

  function TSimpleList.Read(AIndex: Cardinal): TData;
  var
    peToken, pePrevious: PElement;
  begin
    FindByIndex(AIndex, pePrevious, peToken);
    Result := peToken^.Data;
  end;

  function TSimpleList.Find(AData: TData): Integer;
  var
    peToken: PElement;
  begin
    Result := 0;
    peToken := FFirst;

    while peToken <> nil do
      if peToken^.Data = AData then
        Exit
      else
      begin
        peToken := peToken^.Next;
        Inc(Result);
      end;

    Result := -1;
  end;

  procedure TSimpleList.Print();
  var
    peToken: PElement;
    intIndex: Cardinal;
  begin
    WriteLn('Count:    ', FCount);
    WriteLn('Capacity: ', FCapacity, ' bytes'#10);

    peToken := FFirst;
    intIndex := 0;

    while peToken <> nil do
    begin
      WriteLn('Index: ', intIndex:2, ' | Data: ', peToken^.Data:4);
      peToken := peToken^.Next;
      Inc(intIndex);
    end;
  end;

  procedure TSimpleList.SaveToFile(AFileName: TFileName);
  var
    fsOutput: TFileStream;
    peToken: PElement;
  begin
    fsOutput := TFileStream.Create(AFileName, fmCreate or fmShareExclusive);
    try
      peToken := FFirst;

      while peToken <> nil do
      begin
        fsOutput.WriteBuffer(peToken^.Data, ELEMENT_DATA_SIZE);
        peToken := peToken^.Next;
      end;
    finally
      fsOutput.Free();
    end;
  end;

  procedure TSimpleList.LoadFromFile(AFileName: TFileName; AAppend: Boolean = False);
  var
    fsInput: TFileStream;
    dtToken: TData;
  begin
    if not AAppend then
      Clear();

    fsInput := TFileStream.Create(AFileName, fmOpenRead or fmShareExclusive);
    try
      while fsInput.Position < fsInput.Size do
      begin
        fsInput.ReadBuffer(dtToken, ELEMENT_DATA_SIZE);
        Add(dtToken);
      end;
    finally
      fsInput.Free;
    end;
  end;


end.