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);
  public
    constructor Create(ARecSize: integer; ASlotCount: integer); reintroduce;
    destructor Destroy;override;
    function Put(const ARec): boolean;
    function Get(var ARec): boolean;
    procedure Clear;
    property RecCount: integer read FRecCount;
  end;

implementation

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;

end.
