unit BitHose;

//  ////////////////////////////////////////////////////////////////////////////
//
//  Copyright (C) 2004 .. 2006 Jan Punter
//
//  This program is free software; you can redistribute it and/or modify
//  it under the terms of the GNU General Public License as published by
//  the Free Software Foundation; either version 2 of the License, or
//  (at your option) any later version.
//
//  This program is distributed in the hope that it will be useful,
//  but WITHOUT ANY WARRANTY; without even the implied warranty of
//  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
//  GNU General Public License for more details.
//
//  You should have received a copy of the GNU General Public License
//  along with this program; if not, write to the Free Software
//  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
//
//  ////////////////////////////////////////////////////////////////////////////
//
//    lupd : 2006-03-26
//
//  ////////////////////////////////////////////////////////////////////////////


interface

uses

  Math;

type

  TBitCell   = type Cardinal;            // Cardinals used for bit cells - strong type checking
  TByteArray = array of Byte;            // Array of byte with a variable number of elements

const

  CellSize = 8 * SizeOf( TBitCell);      // Nr of bits in  each cell
  AllOnes  = TBitCell( -1);              // A TBitCell with all bits set to 1

type

  TBitIndex = 0 .. CellSize - 1;         // Range for bit indices
  TBitCount = 0 .. CellSize;             // Range for bit counts
  TBitValue = 0 .. 1;                    // Possible values for a single bit.

  TBitHose = class
  private
    FData     : array of TBitCell;
    FSize     : Integer;
    FWritePtr : Integer;
    FReadPtr  : Integer;
  private
    Procedure   SetSize( aValue: Integer);
    Function    GetBits( anIndex: Integer; aBitCount: TBitCount): TBitCell;
    Procedure   SetBits( anIndex: Integer; aBitCount: TBitCount; aValue: TBitCell);
  public
    Constructor Create;
    Destructor  Destroy;                                               Override;
    Procedure   AddBits( aBitCount: TBitCount; aValue: TBitCell);
    Procedure   ShiftInSeptets( Const aData: TByteArray);
    Procedure   ShiftInOctets ( Const aData: TByteArray);
    Procedure   AddSeptets( Const aData: TByteArray);
    Procedure   AddOctets ( Const aData: TByteArray);
    Procedure   Reset;
    Procedure   Clear;
    Function    GetOctets : TByteArray;
    Function    GetSeptets: TByteArray;
    function    ShiftOutBits( anAmount: TBitCount): TBitCell;          overload;
    procedure   ShiftOutBits( var aData: TByteArray; anAmount: Integer);   overload;
  public
    Property    Size: Integer Read FSize Write SetSize;
    Property    Bits[ aBitIndex: Integer; aBitCount: TBitCount]: TBitCell Read GetBits Write SetBits; default;
    Property    ReadPointer: Integer Read FReadPtr Write FReadPtr;
  end;


implementation


{ ========
  TBitHose = Class
  Private
    FData     : Array Of TBitCell;
    FSize     : Integer;
    FWritePtr : Integer;
    FReadPtr  : Integer;
  Public
    Property    Size: Integer Read FSize Write SetSize;
    Property    Bits[ anBitIndex: Integer; aBitCount: TBitCount]: TBitCell Read GetBits Write SetBits;
    Property    ReadPointer: Integer Read FReadPtr Write FReadPtr;
  Private
}

    Procedure   TBitHose.SetSize( aValue: Integer);
    Begin
      SetLength( FData, ( aValue + CellSize - 1 ) Div CellSize);
      FSize := aValue;
    End;

    Function    TBitHose.GetBits( anIndex: Integer; aBitCount: TBitCount): TBitCell;
    Var
      CellPtr : Integer;
      BitPtr  : TBitIndex;
      Filled  : TBitCount;   // Nr of bits available in byte pointed to by CellPtr
      Shift   : Integer;     // >= 0 -> right shift,  < 0 -> left shift
    Begin
      If aBitCount > 0
      Then Begin
        CellPtr := anIndex Div CellSize;
        BitPtr  := anIndex Mod CellSize;
        Filled  := CellSize - BitPtr;
        Shift   := Filled - aBitCount;
        If Shift >= 0
        Then Result := ( FData[ CellPtr] Shr Shift) And ( AllOnes Shr ( CellSize - aBitCount))
        Else
          Result :=
            (( FData[ CellPtr] And ( AllOnes Shr BitPtr)) Shl -Shift) Or
            ( FData[ CellPtr + 1] Shr ( CellSize + Shift));
      End
      Else Result := 0;
    End;

    Procedure   TBitHose.SetBits( anIndex: Integer; aBitCount: TBitCount; aValue: TBitCell);
    Var
      CellPtr : Integer;
      BitPtr  : TBitIndex;
      Free    : TBitCount;  // Free bits in cell pointed to by CellPtr
      Shift   : Integer;    // >= 0 -> left shift, < 0 -> right shift
    Begin
      If aBitCount > 0
      Then Begin
        CellPtr := anIndex Div CellSize;
        BitPtr  := anIndex Mod CellSize;
        Size    := Max( anIndex + aBitCount, Size); // Ensure the new bits will fit.
        Free    := CellSize - BitPtr;               //   so we indeed always have 1 .. 32 free bits ...
        Shift   := Free - aBitCount;
        aValue  := aValue And ( AllOnes Shr ( CellSize - aBitCount));
        If Shift >= 0
        Then FData[ CellPtr] := ( FData[ CellPtr] And ( AllOnes Shl Free)) Or ( aValue Shl Shift)
        Else Begin
          FData[ CellPtr    ] := ( FData[ CellPtr] And ( AllOnes Shl Free)) Or ( aValue Shr -Shift);
          FData[ CellPtr + 1] := aValue Shl ( CellSize + Shift);
        End;
      End;
    End;

//   Public

    Constructor TBitHose.Create;
    Begin
      Inherited;
      Clear;
    End;

    Destructor  TBitHose.Destroy; // Override;
    Begin
      Clear;
      Inherited;
    End;

    Procedure   TBitHose.AddBits( aBitCount: TBitCount; aValue: TBitCell);
    Begin
      Bits[ FWritePtr, aBitCount] := aValue;
      Inc( FWritePtr, aBitCount);
    End;

    Procedure   TBitHose.ShiftInSeptets( Const aData: TByteArray);
    Var
      i : Integer;
    Begin
      For i := 0 To Length( aData) - 1 Do
        AddBits( 7, aData[ i]);
    End;

    Procedure   TBitHose.ShiftInOctets( Const aData: TByteArray);
    Var
      i : Integer;
    Begin
      For i := 0 To Length( aData) - 1 Do
        AddBits( 8, aData[ i]);
    End;

    Procedure   TBitHose.AddSeptets( Const aData: TByteArray);
    Begin
      ShiftInSeptets( aData);
    End;

    Procedure   TBitHose.AddOctets ( Const aData: TByteArray);
    Begin
      ShiftInOctets( aData);
    End;

    Procedure   TBitHose.Reset;
    Begin
      FReadPtr  := 0;
      FWritePtr := 0;
    End;

    Procedure   TBitHose.Clear;
    Begin
      Reset;
      Size := 0;
    End;

    Function    TBitHose.GetOctets: TByteArray;
    Var
      i : Integer;
    Begin
      SetLength( Result, Size Div 8); // todo : bug ?   "( Size + 7) div 8" seems better ...
      For i := 0 To Length( Result) - 1 Do
        Result[ i] := Bits[ i * 8, 8] And $ff;
    End;

    Function    TBitHose.GetSeptets: TByteArray;
    Var
      i : Integer;
    Begin
      SetLength( Result, ( Size + 6) Div 7);
      For i := 0 To Length( Result) - 1 Do
        Result[ i] := Bits[ i * 7, 7] And $7f;
    End;

    function    TBitHose.ShiftOutBits( anAmount: TBitCount): TBitCell;
    begin
      Result := Bits[ FReadPtr, anAmount];
      Inc( FReadPtr, anAmount);
    end;

    procedure   TBitHose.ShiftOutBits( var aData: TByteArray; anAmount: Integer); // overload;
    var
      i : Integer;
    begin
      SetLength( aData, 0);
      i := 0;
      while anAmount > 0
      do begin
        SetLength( aData, Length( aData) + 1);
        if anAmount > 8
        then aData[ i] := ShiftOutBits( 8)
        else aData[ i] := ShiftOutBits( anAmount);
        Dec( anAmount, 8);
        Inc( i);
      end;
    end;

End.