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;

  { Fifo of buffers allocated by GetMem, storing the pointers,
    caller should call FreeMem when used Get the get the pointer.
    Destroy will call FreeMem for all remaining buffers. }
  TBufRec = record
    Buf: pointer;
    Size: integer;
  end;

  TFifoOfBuffers = class(TFifo)
    constructor Create(ASlotCount: integer); reintroduce;
    destructor Destroy; override;
    function PutBuf(ABuf: pointer; ASize: integer): boolean ;
    function GetBuf(var ABuf: pointer; var ASize: integer): boolean;
  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}

{TFifoOfBuffers.}
constructor TFifoOfBuffers.Create(ASlotCount: integer);
begin
  inherited Create(sizeof(TBufRec), ASlotCount);
end;

destructor TFifoOfBuffers.Destroy;
var br: TBufRec;
begin
  while GetBuf(br.Buf, br.Size) do
    FreeMem(br.Buf);
  inherited;
end;

function TFifoOfBuffers.PutBuf(ABuf: pointer; ASize: integer): boolean ;
var br: TBufRec;
begin
  br.Buf := ABuf; br.Size := ASize;
  Result := Put(br);
end;


function TFifoOfBuffers.GetBuf(var ABuf: pointer; var ASize: integer): boolean;

var br: TBufRec;
begin
  Result := Get(br);
  if Result then begin
    ABuf := br.Buf;
    ASize := br.Size;
  end;
end;
{/TFifoOfBuffers.}
end.
