hcodes.pas

HUFFMAN SUANFA SHI YONG JAVA BIAB DE

unit HCodes;

interface

   Uses Classes, SysUtils, ClassLib;

   Const MaxBits = 256;

   Type  BitInterval  = 0..MaxBits;
         ByteInterval = 0..((MaxBits-1) div 8);
         TCodeContainer = array[ ByteInterval ] of byte;
         VirtualArray   = array[0..maxint-1] of byte;

         TCode = class
                 N   : BitInterval;
                 Code: TCodeContainer;
                 Constructor Create(amnt: BitInterval);
                 Constructor Init(amnt: BitInterval; cd: TCodeContainer);
                 Procedure   Assign(Source: TCode);
                 function    CodeString: string;
                 Procedure   ShiftLeft (M: integer);
                 Procedure   ShiftRight(M: integer);
                 Procedure   SetBit(i: BitInterval; Value: boolean);
                 Procedure   Zero;
                 Procedure   Cut;
                 Procedure   SetAmountOfBits(NewAmount: BitInterval);
                 property    AmountOfBits: BitInterval read N write SetAmountOfBits;
         end;

         TBitStream = class(TFileStream)
         private
                 BitPos: Cardinal;
                 BitSz : Cardinal;
                 tmp   : TCode;
         protected
                 Recent: byte;
                 ReadedBits: 0..7;
                 procedure   SetBitPos(NewBitPos: Cardinal);
                 procedure   SetBitSize(NewBitSize: Cardinal);
         public
                 constructor Create(const FileName: string; Mode: Word);
                 destructor  Destroy; override;
                 function    ReadBits(var Target; Count: Cardinal): Longint;
                 function    WriteBits(const Target; Count: Cardinal): longint;
                 function    SeekBits(Offset: Longint; Origin: Word): Longint;
                 property    BitPosition: Cardinal read BitPos write SetBitPos;
                 property    BitSize: Cardinal read BitSz write SetBitSize;
         end;


implementation

{.................................  TCode  ....................................}

Constructor TCode.Create(amnt: BitInterval);
begin
     Zero;
     AmountOfBits := amnt;
end;

Constructor TCode.Init(amnt: BitInterval; cd: TCodeContainer);
begin
     AmountOfBits := amnt;
     Code := cd
end;

Procedure TCode.Assign(Source: TCode);
begin
     N := Source.N;
     Code := Source.Code
end;

Procedure TCode.Zero;
begin
     fillchar(Code,sizeof(TCodeContainer),0)
end;

Procedure TCode.Cut;
begin
     fillchar(Code[(N-1) div 8 +1],sizeof(TCodeContainer)-1-(N-1) div 8,0);
     if N mod 8 <> 0
     then Code[(N-1) div 8] := Code[(N-1) div 8] and (255 shl (8 - N mod 8))
end;

Procedure TCode.SetAmountOfBits(NewAmount: BitInterval);
Begin
     if (NewAmount>=0) and (NewAmount<=MaxBits)
     then begin
          if NewAmount<N
          then begin
               fillchar(Code[(NewAmount-1) div 8 +1],sizeof(TCodeContainer)-1-(NewAmount-1) div 8,0);
               Code[(NewAmount-1) div 8] := Code[(NewAmount-1) div 8] and ((1 shl (NewAmount mod 8)-1) shl (8 - NewAmount mod 8))
          end;
          N := NewAmount
     end
End;

function TCode.CodeString: string;
  var i: BitInterval;
begin
     Result := '';
     if N>0 then
        for i := 0 to N-1 do
        begin
            if (Code[i div 8] and (1 shl (7 - i mod 8)))<>0
            then Result := Result+'1'
            else Result := Result+'0'
        end
end;

procedure TCode.ShiftLeft;
  var k,i: integer;
      w  : word;
      p  : byte;
begin
     if (m<0) or (m>=N)
     then if m>=N
          then Zero
          else ShiftRight(abs(M))
     else begin
          k := m div 8;
          if k>0 then
          begin
               move(Code[k],Code,(N-1) div 8 - k + 1);
               fillchar(Code[(N-1) div 8 - k + 1],k,0)
          end;
          p := m mod 8;
          if p>0 then
          begin
               W := Code[0] shl 8;
               for i := 1 to (N-1) div 8 - k do
               begin
                    W := W or Code[i];
                    Code[i-1] := hi(W shl p);
                    W := W shl 8
               end;
               Code[(N-1) div 8 - k] := hi(W shl p) {for i=From to Till do ...}
          end                                       {after cycle i = Till+1!!!}
     end {of else}
end;

procedure TCode.ShiftRight;
  var k,i: integer;
      w  : word;
      p  : byte;
begin
     if (m<0) or (m>=N)
     then if m>=N
          then Zero
          else ShiftLeft(abs(M))
     else begin
          k := m div 8;
          if k>0 then
          begin
               move(Code,Code[k],(N-1) div 8 - k + 1);
               fillchar(Code,k,0)
          end;
          p := m mod 8;
          if p>0 then
          begin
               W := Code[(N-1) div 8];
               for i := (N-1) div 8 - 1 downto k do
               begin
                    W := W or (Code[i] shl 8);
                    Code[i+1] := lo(W shr p);
                    W := W shr 8
               end;
               Code[k] := lo(W shr p);
               Code[(N-1) div 8] := Code[(N-1) div 8] and
                                        ((1 shl (N mod 8)-1) shl (8 - N mod 8))
          end
     end {of else}
end;

Procedure TCode.SetBit(i: BitInterval; Value: boolean);
begin
     if Value
     then Code[i div 8] := Code[i div 8] or (1 shl (7 - i mod 8))
     else Code[i div 8] := Code[i div 8] and not(1 shl (7 - i mod 8))
end;

{...............................TBitStream.....................................}

constructor TBitStream.Create;
  var C: Longint;
begin
     inherited;
     tmp := TCode.Create(0);
     BitSz  := Size*8;
     BitPos := 0;
     BitSize := Size*8;
     read(Recent,1);
     ReadedBits := 0
end;

destructor TBitStream.Destroy;
begin
     tmp.Free;
end;

procedure TBitStream.SetBitPos;
begin
     seek(NewBitPos div 8,soFromBeginning);
     read(Recent,1);
     ReadedBits := NewBitPos mod 8;
     BitPos := NewBitPos;
end;

procedure TBitStream.SetBitSize(NewBitSize: Cardinal);
begin
     BitSz := NewBitSize
end;

function TBitStream.ReadBits(var Target; Count: Cardinal): Longint;
begin
     if Count+BitPos<=BitSize
     then begin
          Result := Count;
          inc(BitPos,Count)
     end
     else begin
          Result := BitSize-BitPos;
          BitPos := BitSize
     end;
     tmp.AmountOfBits := 8;
     tmp.Code[0] := Recent;
     tmp.AmountOfBits := Count+ReadedBits;
     if Count+ReadedBits>=8
     then begin
          read(tmp.Code[1],(Count+ReadedBits-8) div 8);
          read(Recent,1);
          tmp.Code[(Count+ReadedBits-8) div 8+1] := Recent
     end;
     tmp.ShiftLeft(ReadedBits);
     tmp.AmountOfBits := Result;
     tmp.Cut;
     move(tmp.Code,Target,(Result-1) div 8 +1);
     ReadedBits := (ReadedBits+Result) mod 8
end;

function TBitStream.WriteBits(const Target; Count: Cardinal): Longint;
begin

end;

function TBitStream.SeekBits(Offset: Longint; Origin: Word): Longint;
begin
     SetBitPos(Offset)
end;

end.