bds.mr.dpg/src.rtl/dpgrtl.charqueue.pas

unit dpgrtl.charqueue;

interface
uses
   dpgrtl.types;

type
   TCharQueue = class( TInterfacedObject)
      private
         fBlockLog   : integer;     // log2 of block size
         fBlockSize  : integer;     // block size

         fOffset     : integer;     // logical start of the vector
         fCount      : integer;     // items in a vector
         fArray      : TCharMatrix; // data

      private
         procedure   Expand( i: integer);

      protected
         function    GetItem( i:integer): AnsiChar;
         procedure   SetItem( i:integer; Value:AnsiChar);

      public
         procedure   Clear;
         procedure   Add(     Value : AnsiChar);
         procedure   Remove(  ACount: integer);

      public
         procedure   AfterConstruction; override;
         procedure   BeforeDestruction; override;

      public
         property    Count             : integer   read  fCount;
         property    Items[i:integer]  : AnsiChar  read  GetItem  write SetItem;
   end;

implementation
uses
   System.Math,
   System.SysUtils;

{ TCharQueue }

// @@@: construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
//                                   construction/destruction
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// After Construction
// ================================================================================================
procedure TCharQueue.AfterConstruction;
begin
   inherited;

   fBlockLog   := trunc( log2( 4096));
   fBlockSize  := trunc( IntPower(2, fBlockLog));

   fArray      := nil;
   fOffset     := 0;
   fCount      := 0;
end;

// ================================================================================================
// Before Destruction
// ================================================================================================
procedure TCharQueue.BeforeDestruction;
var
   i: integer;

begin
   Clear;

   for i:=Low(fArray) to High(fArray) do
      fArray[i] := nil;

   fArray := nil;
   inherited;
end;

// @@@: Interface +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
//                                           Interface
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Add
// ================================================================================================
procedure TCharQueue.Add(Value: AnsiChar);
begin
   Items[ fCount +1] := Value
end;

// ================================================================================================
// Remove
//
//    Removes 'Count' items from the beginning of the queue. If the 'Count' is bigger than the
//    count then simply clear the Queue.
// ================================================================================================
procedure TCharQueue.Remove( ACount: integer);
var
   tmp: TCharMatrix;
   i  : integer;

begin
   if ACount > 0 then
   begin
      // ------------------------------------------------------------
      // if the removable item count > than the item count, then
      // simply clear the queue...
      // ------------------------------------------------------------
      if ACount > fCount then
         Clear


      // ------------------------------------------------------------
      // ...else calculate the new offset and count values. If the
      // one or more blocks in the vector beginning is freed, then
      // move these blocks to the end of the vector.
      // ------------------------------------------------------------
      else begin
         INC( fOffset, ACount);
         DEC( fCount,  ACount);

         SetLength( tmp, 1);

         // ---------------------------------------------------------
         // Well, not so efficient, but simple
         // ---------------------------------------------------------
         while fOffset > fBlockSize -1 do
         begin
            tmp[0] := fArray[0];

            // --------------------------------------------
            // clear the free block
            // --------------------------------------------
            for i:=0 to High(tmp[0]) do
               tmp[0,i] := #0;

            // --------------------------------------------
            // shift blocks down
            // --------------------------------------------
            for i:=0 to High(fArray)-1 do
               fArray[i] := fArray[i+1];

            // --------------------------------------------
            // set the vector's last block
            // --------------------------------------------
            fArray[High(fArray)] := tmp[0];

            DEC( fOffset, fBlockSize)
         end;

         tmp := nil
      end
   end
end;

// ================================================================================================
// Clear
//
//    This is a real pain in the ass. I'm not in the mood to optimize it.
// ================================================================================================
procedure TCharQueue.Clear;
var
   i: integer;

begin
   for i:=1 to fCount do
      Items[i] := #0;

   fOffset := 0;
   fCount  := 0;
end;


// @@@: Property Handlers +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
//                                       Property Handlers
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Get Item
//
//    Get the item specified by it's index. If the index less than 1 or bigger than the size of
//    the queue, an ERangeError exception will be generated.
// ================================================================================================
function TCharQueue.GetItem(i: integer): AnsiChar;
var
   block: integer;
   index: integer;

begin
   // -------------------------------------------------------------------------
   // Check for valid index value.
   // -------------------------------------------------------------------------
   if i > fCount then raise ERangeError.CreateFmt( 'Index "%d" is too big', [i]);
   if i < 1      then raise ERangeError.CreateFmt( 'Index is less than 1', []);

   // -------------------------------------------------------------------------
   // Now process the request.
   // -------------------------------------------------------------------------
   block  := (i -1 +fOffset) shr  fBlockLog;
   index  := (i -1 +fOffset) and (fBlockSize -1);

   result := fArray[block,index];
end;

// ================================================================================================
// Set Item
//
//    Set the item specified by it's index. If the the index bigger than the count of the Queue
//    then the Queue will be resized to hold this data. If the index less than 1 an ERangeError
//    exception will be generated.
// ================================================================================================
procedure TCharQueue.SetItem(i: integer; Value: AnsiChar);
var
   block: integer;
   index: integer;

begin
   // -------------------------------------------------------------------------
   // Check for valid index value.
   // -------------------------------------------------------------------------
   if i < 1 then raise ERangeError.CreateFmt( 'Index is less than 1', []);

   // -------------------------------------------------------------------------
   // If the index bigger than the size of the Queue then expand the Queue.
   // -------------------------------------------------------------------------
   if i > fCount then
   begin
      Expand(i);
      fCount := i;
   end;

   // -------------------------------------------------------------------------
   // Now process the request.
   // -------------------------------------------------------------------------
   block  := (i -1 +fOffset) shr  fBlockLog;
   index  := (i -1 +fOffset) and (fBlockSize -1);

   fArray[block,index] := Value
end;

// @@@: Internals +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
//                                           Internals
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Expand
//
//    Expands the Queue. The size of expanding is always fBlockSize*n.
// ================================================================================================
procedure TCharQueue.Expand(i: integer);
var
   hi: integer;
   bn: integer;
   j : integer;

begin
   if (i-1)+fOffset >= (High(fArray)+1) * fBlockSize then
   begin
      hi := High(fArray) +1;
      bn := (i-1+fOffset) shr fBlockLog;

      SetLength( fArray, bn+1);

      for j:=hi to bn do
         SetLength( fArray[j], fBlockSize);
   end;
end;

end.