unit Fifou;

interface
uses SysUtils;
type
  TFifo = class(TObject)
  private
    FBuf: PByteArray;
    FRecSize: integer;
    FSlotCount: integer;
    FRecCount: integer;
    FHead: integer;
    FTail: integer;
    procedure SetRecSlots(ARecSize, ASlotCount:integer);
  protected
    function GetRec(AIndex: integer; var ARec): boolean;
  public
    constructor Create(ARecSize: integer; ASlotCount: integer); reintroduce;
    destructor Destroy;override;
    function Put(const ARec): boolean;virtual;
    function Get(var ARec): boolean;virtual;
    procedure Clear;
    property RecCount: integer read FRecCount;
    property Head: integer read FHead;
    property Tail: integer read FTail;
  end;

  TCircularBuffer = class(TFifo)
    function Put(const ARec): boolean; override;
  end;
implementation

{TFifo}
constructor TFifo.Create(ARecSize: integer; ASlotCount: integer);
begin
  inherited Create;
  FBuf := nil;
  FHead := 0;
  FTail := 0;
  FRecSize := 0;
  FSlotCount := 0;
  FRecCount := 0;
  SetRecSlots(ARecSize, ASlotCount);
end;

procedure TFifo.Clear;
begin
  FRecCount := 0;
  FHead := 0;
  FTail := 0;
end;

procedure TFifo.SetRecSlots(ARecSize, ASlotCount: integer);
begin
  if FBuf <> nil then begin
    FreeMem(FBuf);
  end;
  GetMem(FBuf, ARecSize * ASlotCount);
  FRecSize := ARecSize;
  FSlotCount := ASlotCount;
end;

destructor TFifo.Destroy;
begin
  if FBuf <> nil then
    FreeMem(FBuf);
end;

function TFifo.Put(const ARec): boolean;
begin
  Result := false;
  if FRecCount = FSlotCount then
    exit;
  Move(ARec, FBuf^[FHead * FRecSize], FRecSize);
  inc(FRecCount);
  inc(FHead);
  if FHead = FSlotCount then
    FHead := 0;
  Result := true;
end;

function TFifo.Get(var ARec): boolean;
begin
  Result := false;
  if FRecCount = 0 then
    exit;
  Move(FBuf^[FTail * FRecSize], ARec, FRecSize);
  dec(FRecCount);
  inc(FTail);
  if FTail = FSlotCount then
    FTail := 0;
  Result := true;
end;

function TFifo.GetRec(AIndex: integer; var ARec): boolean;
begin
  Result := false;
  if AIndex < 0 then
    exit;
  if AIndex >= FRecCount then
    exit;
  inc(AIndex, FTail);
  if AIndex >= FSlotCount then
    dec(AIndex, FSlotCount);
  Move(FBuf^[AIndex * FRecSize], ARec, FRecSize);
end;

{/TFifo}

{TCircularBuffer}
function TCircularBuffer.Put(const ARec): boolean;
begin
  if FRecCount = FSlotCount then begin
    dec(FRecCount);
    inc(FTail);
    if FTail = FSlotCount then
      FTail := 0;
  end;
  Result := inherited Put(ARec);
end;
{/TCircularBuffer}

end.
