{ Использование метода Хаффмана для упаковки буфера:
  1) компрессия буфера с записью информации для декодировки;
  2) декомпрессия буфера с записанной информацией для декодировки.
}
{---------------------------------------------------------------------------
(c) Copyright	 Aleksandrov O.E., 1999

   Molecular Physics department, USTU, Ekaterinsburg, K-2, 620002, RUSSIA
   phone 75-47-15
   E-mail: aleks@dpt.ustu.ru

(c) Copyright Александров О.Е., 1999

   620002, Екатеринбург, К-2, УГТУ, Кафедра молекулярной физики
   тел. 75-47-15
   E-mail: aleks@dpt.ustu.ru
----------------------------------------------------------------------------}
Unit HuffmanE;

INTERFACE
  uses HufTypes, HuffSupp, Huffman0;

type

  { Размер буфера - двухбайтное целое, чтобы размер был одинаков для
  DOS и Windows программы, но некоторая несовместимость возможна.
  Например DOS-программа не сможет распаковать данные
  при длине буфера >64 кБ.}
  tBufferSize={$IfDef Delphi}cardinal {$Else} longint {$EndIf};
  tEncodedBufferData=tBuffer;

  { Для экономии размера программа использует заголовки буфера двух типов:
    1) 16-битный (для несжатого буфера с размером меньшим 64 кБ);
    2) 32-битный (для несжатого буфера с размером большим 64 кБ).
  }
  tBufferFlag=(fUnknownHeader, f16bitHeader, f32bitHeader);
  tBufferFlags=set of tBufferFlag;
  tBufferSize16=word;
  tBufferSize32={$IfDef Delphi}cardinal{$Else}longint{$EndIf};

  { заголовок 16-битного буфера (длина <= $FFFF байт)}
  tEncodedBufferHeader16=packed record
    Flags:tBufferFlags; { флаги типа буфера }
    Size:tBufferSize16; { полный размер данных (байт) в буфере, включая заголовок }
    UnpackedDataSize:tBufferSize16; { исходный размер данных (байт) }
  end;

  { заголовок 32-битного буфера ($FFFF < длина <= $FFFFFFFF байт)}
  tEncodedBufferHeader32=packed record
    Flags:tBufferFlags; { флаги типа буфера }
    Size:tBufferSize32; { полный размер данных (байт) в буфере, включая заголовок }
    UnpackedDataSize:tBufferSize32; { исходный размер данных (байт) }
  end;

  { 16-битный буфер }
  tEncodedBuffer16=packed record
    Header:tEncodedBufferHeader16;
    Data:tEncodedBufferData;
  end;

  { 32-битный буфер }
  tEncodedBuffer32=packed record
    Header:tEncodedBufferHeader32;
    Data:tEncodedBufferData;
  end;

  { просто буфер, либо 16-битный, либо 32-битный }
  tEncodedBufferX=packed record
    case tBufferFlag of
      f16bitHeader:(b16:tEncodedBuffer16);
      f32bitHeader:(b32:tEncodedBuffer32);
  end;

  { Кодированный буфер }
  tEncodedBuffer=object
  private
    Buffer:tEncodedBufferX;
    function DataPtr(Ofs:word):pointer;
  public
   { Возвращает для буфера, закодированного EncodeBufEx, размер }
    function  BType:tBufferFlag;
    procedure BTypeSet(BufType:tBufferFlag);
    function  HeaderSizeInBytes:tBufferSize;
    function  PackedTreePtr:tPPackedTree;
    function  PackedDataPtr:pointer;
    { полный размер буфера с заголовком данных }
    function  SizeInBytes:tBufferSize;
    procedure SizeInBytesSet(Size:tBufferSize);
    { декодированных данных }
    function  DecodedSize:tBufferSize;
    procedure DecodedSizeSet(Size:tBufferSize);
    { размер упакованных даных (без заголовка и дерева)}
    function  DataSizeInBytes:tBufferSize;
    { размер дерева }
    function  TreeSizeInBytes:byte;
    { полный размер данных (упакованное дерево + упакованные данные)}
    function  DataAndTreeSizeInBytes:tBufferSize;
  end;
  tPEncodedBuffer=^tEncodedBuffer;

type
  {Объект, осуществляющий кодировку/декодировку БУФЕРА методом Хаффмана.}
  tHuffman=object(Huffman0.tHuffman)
    private
    public
      { Кодирует буфер InBuf и записывает в OutBuf
      ВМЕСТЕ С ДАННЫМИ ДЛЯ ДЕКОДИРОВКИ (заголовок и упакованное дерево),
      Size - размер данных (в tByte) в исходном буфере InBuf,
      OutSize - размер данных (в байтах!) в сжатом буфере OutBuf
      (включая данные для декодировки, см. tEncodedBuffer).
      Возвращает Encoded=TRUE, если данные и информация по дереву
      имеют размер <= Size и записаны в упакованном виде, иначе данные
      из InBuf просто копируются в OutBuf и OutSize=Size.}
      procedure EncodeBuf(const InBuf; Size:tBufferIndex;
			var OutBuf;  var OutSize:tBufferIndex;
			var Encoded:boolean);
      { То же, что и EncodeBuf,
      дополнительно обеспечивает ExtraSize свободного места в упакованном
      буфере, если Encoded=TRUE.}
      procedure EncodeBufEx(const InBuf; Size:tBufferIndex; ExtraSize:word;
			var OutBuf;  var OutSize:tBufferIndex;
			var Encoded:boolean);
      { То же, что и EncodeBuf,
      дополнительно
       1) обеспечивает передачу макс. размера OutBuf в MaxOutSize;
       2) не копирует буфер InBuf в OutBuf, если невозможно упаковать данные
	  (при Encoded=False).}
      procedure EncodeBufEx1(const InBuf; InSize:tBufferIndex;
			var OutBuf; MaxOutSize:tBufferIndex;
			var OutSize:tBufferIndex;
			var Encoded:boolean);

      procedure EncodeBufOptimal(var InBuf; Size:tBufferIndex;
			var RestSize:tBufferIndex;
			var OutBuf;  var OutSize:tBufferIndex;
			var Encoded:boolean);
      procedure EncodeBufOptimalEx(var InBuf; InSize:tBufferIndex;
			var RestSize:tBufferIndex;
			var OutBuf; MaxOutSize:tBufferIndex;
			var OutSize:tBufferIndex;
			var Encoded:boolean);
      { Декодирует буфер InBuf, ранее закодированный EncodeX
      и записывает в OutBuf}
      procedure DecodeBuf(const InBuf; var OutBuf; var Size:tBufferIndex);
     { размер данных в кодированном буфере,
     возвращает 0, если негодный буфер }
      function  DecodedSize(const InBuf):tBufferIndex;
  end;

IMPLEMENTATION

{ Кодирует буфер InBuf и записывает в OutBuf
      ВМЕСТЕ С ДАННЫМИ ДЛЯ ДЕКОДИРОВКИ (заголовок и упакованное дерево),
      Size - размер данных (в tByte) в исходном буфере InBuf,
      OutSize - размер данных (в байтах!) в сжатом буфере OutBuf
      (включая данные для декодировки, см. tEncodedBuffer).
      Возвращает Encoded=TRUE, если данные и информация по дереву
      имеют размер <= Size и записаны в упакованном виде, иначе данные
      из InBuf просто копируются в OutBuf и OutSize=Size.}
procedure tHuffman.EncodeBuf;
begin
  EncodeBufEx1(InBuf, Size, OutBuf, Size, OutSize, Encoded);
  if not Encoded then begin
  { НЕТ, нельзя конечный размер НЕ меньше начального. }
    { просто копируем исходный буфер в выходной буфер }
    OutSize:=Size*SizeOf(tByte);
    System.Move(InBuf, OutBuf, OutSize);
  end;
end;

{ То же, что и EncodeBuf,
      дополнительно обеспечивает ExtraSize свободного места в упакованном
      буфере, если Encoded=TRUE.}
procedure tHuffman.EncodeBufEx;
begin
  EncodeBufEx1(InBuf, Size, OutBuf, (Size-ExtraSize), OutSize, Encoded);
  if not Encoded then begin
  { НЕТ, нельзя конечный размер НЕ меньше начального. }
    { просто копируем исходный буфер в выходной буфер }
    OutSize:=Size*SizeOf(tByte);
    System.Move(InBuf, OutBuf, OutSize);
  end;
end;

{ То же, что и EncodeBuf,
      дополнительно
       1) обеспечивает передачу макс. размера OutBuf в MaxOutSize;
       2) не копирует буфер InBuf в OutBuf, если невозможно упаковать данные
	  (при Encoded=False).}
procedure tHuffman.EncodeBufEx1(
			const InBuf; InSize:tBufferIndex;
			var OutBuf; MaxOutSize:tBufferIndex;
			var OutSize:tBufferIndex;
			var Encoded:boolean);
  var TreeSize:word;
      FullSize:tBufferSize;
begin
  {$IfOpt R+}
  if MaxOutSize*SizeOf(tByte)<SizeOf(tEncodedBufferHeader32) then
    RunError(201);
  {$EndIf Opt R+}

  { строим дерево Хаффмана }
  Build(InBuf,InSize);
  { размер дерева Хаффмана }
  TreeSize:=SizeOfPackedTreeInBytes;

  if InSize>High(word) then
    tEncodedBuffer(OutBuf).BTypeSet(f32bitHeader)
  else
    tEncodedBuffer(OutBuf).BTypeSet(f16bitHeader);

  { полный размер упакованного буфера }
  FullSize:=tEncodedBuffer(OutBuf).HeaderSizeInBytes+  { заголовок }
	    +CompressedSize*SizeOf(tByte)+             { упакованные данные }
	    +TreeSize;                                 { дерево }
  { Можно ли упаковать? }
  if (FullSize<InSize*SizeOf(tByte))
     and (FullSize<=MaxOutSize*SizeOf(tByte)) then begin
  { ДА, можно конечный размер меньше начального. }
    { 1) запись заголовка буфера; }
    tEncodedBuffer(OutBuf).SizeInBytesSet(FullSize);
    tEncodedBuffer(OutBuf).DecodedSizeSet(InSize);
    { 2) запись дерева; }
    SaveTree(tEncodedBuffer(OutBuf).PackedTreePtr^);
    { 3) кодировка буфера. }
    Encode(InBuf, InSize,
	   tEncodedBuffer(OutBuf).PackedDataPtr^,
	   CompressedSize,
	   OutSize);
    OutSize:=FullSize;
    Encoded:=TRUE;
  end else begin
    OutSize:=0;
    Encoded:=FALSE;
  end;
end;

procedure tHuffman.EncodeBufOptimal;
begin
  EncodeBufOptimalEx(InBuf,Size,RestSize, OutBuf,Size,OutSize, Encoded);
  if not Encoded then begin
  { НЕТ, нельзя конечный размер НЕ меньше начального. }
    { просто копируем исходный буфер в выходной буфер }
    OutSize:=Size*SizeOf(tByte);
    System.Move(InBuf, OutBuf, OutSize);
    RestSize:=0;
  end;
end;

procedure tHuffman.EncodeBufOptimalEx(
			var InBuf; InSize:tBufferIndex;
			var RestSize:tBufferIndex;
			var OutBuf; MaxOutSize:tBufferIndex;
			var OutSize:tBufferIndex;
			var Encoded:boolean);
  var
    osz,rs:tBufferIndex;
begin
  osz:=FindOptimalSize(InBuf,InSize);
  EncodeBufEx1(InBuf, osz, OutBuf, MaxOutSize, OutSize, Encoded);
  if Encoded then begin
    if osz<InSize then begin
      rs:=InSize-osz;
      System.Move(tBuffer(InBuf)[osz],InBuf,rs);
      RestSize:=rs;
    end else begin
      RestSize:=0;
    end;
  end else if (osz<InSize) then begin
    EncodeBufEx1(InBuf, InSize, OutBuf, MaxOutSize, OutSize, Encoded);
    RestSize:=0;
  end;
end;

{   Декодирует буфер InBuf (предварительно закодированный EncodeExX,
(!!! при условии Encoded=TRUE после вызова EncodeExX, см. tEncodedBuffer)
и записывает в OutBuf}
procedure tHuffman.DecodeBuf;
  var UnpackedSize:tBufferSize;
begin
  { размер данных в буфере }
  UnpackedSize:=tEncodedBuffer(InBuf).DecodedSize;
  {$IfOpt R+}
  if (UnpackedSize>High(tBufferIndex))
     {$IfNDef Delphi}or (UnpackedSize<0){$EndIf} then
    RunError(201);
  if UnpackedSize=0 then
    RunError(201);
  {$EndIf Opt R+}
  { загружаем дерево Хаффмана }
  LoadTree(tEncodedBuffer(InBuf).PackedTreePtr^);
  { декодируем данные из буфера }
  Decode(tEncodedBuffer(InBuf).PackedDataPtr^, OutBuf, UnpackedSize);
  Size:=UnpackedSize;
end;

function tHuffman.DecodedSize(const InBuf):tBufferIndex;
begin
  { размер данных в буфере }
  DecodedSize:=tEncodedBuffer(InBuf).DecodedSize;
end;

function tEncodedBuffer.BType:tBufferFlag;
  var
    BFlags:tBufferFlags;
  const
    cMask=[fUnknownHeader, f16bitHeader, f32bitHeader];
begin
  BFlags:=Buffer.b16.Header.Flags*cMask;
  if BFlags=[f16bitHeader] then
    BType:=f16bitHeader
  else if BFlags=[f32bitHeader] then
    BType:=f32bitHeader
  else
    BType:=fUnknownHeader;
end;

procedure tEncodedBuffer.BTypeSet(BufType:tBufferFlag);
begin
  Buffer.b16.Header.Flags:=[BufType];
end;

function tEncodedBuffer.SizeInBytes:tBufferSize;
begin
  case BType of
    f16bitHeader:
      SizeInBytes:=Buffer.b16.Header.Size;
    f32bitHeader:
      SizeInBytes:=Buffer.b32.Header.Size;
    else begin
      SizeInBytes:=0;
      RunError(201);
    end;
  end;
end;

procedure tEncodedBuffer.SizeInBytesSet(Size:tBufferSize);
begin
  case BType of
    f16bitHeader: begin
      if Size>High(word) then
	RunError(201);
      Buffer.b16.Header.Size:=Size;
    end;
    f32bitHeader:
      Buffer.b32.Header.Size:=Size;
    else
      RunError(201);
  end;
end;

function tEncodedBuffer.HeaderSizeInBytes:tBufferSize;
begin
  case BType of
    f16bitHeader:
      HeaderSizeInBytes:=SizeOf(tEncodedBufferHeader16);
    f32bitHeader:
      HeaderSizeInBytes:=SizeOf(tEncodedBufferHeader32);
    else begin
      HeaderSizeInBytes:=0;
      RunError(201);
    end;
  end;
end;

function tEncodedBuffer.DecodedSize:tBufferSize;
begin
  case BType of
    f16bitHeader:
      DecodedSize:=Buffer.b16.Header.UnpackedDataSize;
    f32bitHeader:
      DecodedSize:=Buffer.b32.Header.UnpackedDataSize;
    else
      DecodedSize:=0;
  end;
end;

function tEncodedBuffer.DataPtr(Ofs:word):pointer;
begin
  case BType of
    f16bitHeader:
      DataPtr:=@Buffer.b16.Data[Ofs];
    f32bitHeader:
      DataPtr:=@Buffer.b32.Data[Ofs];
    else begin
      DataPtr:=nil;
      RunError(201);
    end;
  end;
end;

function tEncodedBuffer.PackedTreePtr:tPPackedTree;
begin
  PackedTreePtr:=tPPackedTree(DataPtr(0));
end;

function tEncodedBuffer.PackedDataPtr:pointer;
begin
  PackedDataPtr:=DataPtr(PackedTreePtr^.SizeInBytes);
end;

procedure tEncodedBuffer.DecodedSizeSet(Size:tBufferSize);
begin
  case BType of
    f16bitHeader: begin
      if Size>High(word) then
	RunError(201);
      Buffer.b16.Header.UnpackedDataSize:=Size;
    end;
    f32bitHeader:
      Buffer.b32.Header.UnpackedDataSize:=Size;
    else
      RunError(201);
  end;
end;

function tEncodedBuffer.TreeSizeInBytes:byte;
begin
  TreeSizeInBytes:=PackedTreePtr^.SizeInBytes;
end;

function tEncodedBuffer.DataSizeInBytes:tBufferSize;
begin
  DataSizeInBytes:=SizeInBytes-HeaderSizeInBytes-TreeSizeInBytes;
end;

function tEncodedBuffer.DataAndTreeSizeInBytes:tBufferSize;
begin
  DataAndTreeSizeInBytes:=DataSizeInBytes+TreeSizeInBytes;
end;

END.