fork download
copy 
  1. program CircularBufferIntU;
  2. {$MODE DELPHI}
  3.  
  4. uses
  5.   SysUtils;
  6.  
  7. type
  8.   TIntegerCircularBuffer = class(TObject)
  9.   private
  10.     FBuffer: PIntegerArray;
  11.     FFullSize: integer;
  12.     FWritePos: integer;
  13.     FReadPos: integer;
  14.     FSampleCount: integer;
  15.     function GetIntAtIndex(AIndex: word): integer;
  16.     function GetReadAvail: integer;
  17.     function GetWriteAvail: integer;
  18.   public
  19.  
  20.     constructor Create(ASize: Integer); virtual;
  21.     destructor Destroy; override;
  22.  
  23.     function AddSample(const AValue: integer): boolean;
  24.     procedure Delete(ACount: integer);
  25.     procedure SetFillPoint(AFillPoint: integer);
  26.  
  27.     property FullSize: integer read FFullSize;
  28.     property ReadAvail: integer read GetReadAvail;
  29.     property WriteAvail: integer read GetWriteAvail;
  30.     property SampleCount: integer read FSampleCount;
  31.     property Samples[Index: word]: integer read GetIntAtIndex; default;
  32.   end;
  33.  
  34. constructor TIntegerCircularBuffer.Create(ASize: Integer);
  35. begin
  36.   inherited Create;
  37.  
  38.   FFullSize := ASize;
  39.   FSampleCount := 0;
  40.   FReadPos := 0;
  41.   FWritePos := 0;
  42.   FBuffer := AllocMem(ASize * sizeof(integer));
  43. end;
  44.  
  45. destructor TIntegerCircularBuffer.Destroy;
  46. begin
  47.   FreeMem(FBuffer);
  48.  
  49.   inherited Destroy;
  50. end;
  51.  
  52. function TIntegerCircularBuffer.AddSample(const AValue: integer): boolean;
  53. begin
  54.   result := true;
  55.   if (GetWriteAvail < 1) then begin
  56.     result := false;
  57.     Exit;
  58.   end;
  59.  
  60.   FBuffer^[FWritePos] := AValue;
  61.  
  62.   if (FWritePos = FFullSize -1) then FWritePos := 0 else inc(FWritePos);
  63.  
  64.   inc(FSampleCount);
  65. end;
  66.  
  67. procedure TIntegerCircularBuffer.Delete(ACount: integer);
  68. begin
  69.   if (ACount <= 0 ) then begin
  70.     Exit;
  71.   end;
  72.  
  73.   if (ACount >= FSampleCount) then begin
  74.     FSampleCount := 0;
  75.     FReadPos := FWritePos;
  76.     Exit;
  77.   end;
  78.  
  79.   inc(FReadPos, ACount);
  80.   FReadPos := FReadPos mod FFullSize;
  81.  
  82.   dec(FSampleCount, ACount);
  83. end;
  84.  
  85. function TIntegerCircularBuffer.GetIntAtIndex(AIndex: word): integer;
  86. var
  87.   ii: integer;
  88. begin
  89.   ii := FReadPos + AIndex;
  90.   if (ii > FFullSize -1) then
  91.     ii := ii - FFullSize;
  92.  
  93.   result := FBuffer^[ii];
  94. end;
  95.  
  96. function TIntegerCircularBuffer.GetReadAvail: integer;
  97. begin
  98.   result := FSampleCount;
  99. end;
  100.  
  101. function TIntegerCircularBuffer.GetWriteAvail: integer;
  102. begin
  103.   result := FFullSize - FSampleCount;
  104. end;
  105.  
  106. procedure TIntegerCircularBuffer.SetFillPoint(AFillPoint: integer);
  107. begin
  108.   FReadPos := 0;
  109.   FWritePos := AFillPoint;
  110.  
  111.   FillChar(FBuffer^[0], SizeOf(Integer)* FFullSize, 0);
  112. end;
  113.  
  114. procedure ReadValues(icb: TIntegerCircularBuffer; NextExpectedRead: Integer; const msg2: string);
  115. var
  116.   j: Integer;
  117.   ReadVal: Integer;
  118.   msg3: string;
  119. begin
  120.   Assert(icb.WriteAvail = 0, msg2);
  121.   for j := 0 to Pred(icb.FullSize) do begin
  122.     msg3 := Format('%s; j = %d', [msg2, j]);
  123.     ReadVal := icb[j];
  124.     Assert(ReadVal = NextExpectedRead, msg3);
  125.     Inc(NextExpectedRead);
  126.   end;
  127. end;
  128.  
  129. procedure TestUsingBuffer(Size: Integer);
  130. var
  131.   icb: TIntegerCircularBuffer;
  132.   i: Integer;
  133.   NextAdd: Integer;
  134.   NextExpectedRead: Integer;
  135.   msg1, msg2: string;
  136. begin
  137.   icb := TIntegerCircularBuffer.Create(Size);
  138.   try
  139.     msg1 := Format('size = %d', [Size]);
  140.     Assert(icb.FullSize = Size, msg1);
  141.     Assert(icb.ReadAvail = 0, msg1);
  142.     Assert(icb.WriteAvail = Size, msg1);
  143.     Assert(icb.SampleCount = 0, msg1);
  144.  
  145.     NextAdd := 1000;
  146.     NextExpectedRead := 1000;
  147.  
  148.     for i := 1 to 1000 do begin
  149.       msg2 := Format('size = %d; i = %d', [Size, i]);
  150.       while icb.WriteAvail > 0 do begin
  151.         icb.AddSample(NextAdd);
  152.         Inc(NextAdd);
  153.       end;
  154.  
  155.       ReadValues(icb, NextExpectedRead, msg2);
  156.  
  157.       icb.Delete(5);
  158.       Inc(NextExpectedRead, 5);
  159.       Assert(icb.ReadAvail = Size - 5, msg2);
  160.       Assert(icb.WriteAvail = 5, msg2);
  161.       Assert(icb.SampleCount = Size - 5, msg2);
  162.     end;
  163.   finally
  164.     icb.Free;
  165.   end;
  166. end;
  167.  
  168. begin
  169.   TestUsingBuffer(17);
  170.   TestUsingBuffer(29);
  171.   TestUsingBuffer(501);
  172.   Writeln('Done');
  173. end.
Success #stdin #stdout 0.56s 384KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Done
https://ideone.com/1yhh3
language:
Pascal (fpc 3.0.4)
created:
14 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!