unit Fifou; { First In First Out records queue object }
{
  (C) 2000 - 2002 Jindrich Jindrich, Pavel Pisa, PiKRON Ltd.

  Originators of the CHROMuLAN project:

  Jindrich Jindrich - http://www.jindrich.com
                      http://orgchem.natur.cuni.cz/Chromulan/
                      software developer, project coordinator
  Pavel Pisa        - http://cmp.felk.cvut.cz/~pisa
                      embeded software developer
  PiKRON Ltd.       - http://www.pikron.com
                      project initiator, sponsor, instrument developer

  The CHROMuLAN project is distributed under the GNU General Public Licence.
  See file COPYING for details.

  Originators reserve the right to use and publish sources
  under different conditions too. If third party contributors
  do not accept this condition, they can delete this statement
  and only GNU license will apply.
}

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.
