mzlib.pas

graphicex 增加对各种图形格式的支持

        (S.Depth[V] <= S.Depth[S.Heap[J]]))) then Break;

    // exchange V with the smallest son
    S.Heap[K] := S.Heap[J];
    K := J;

    // and xontinue down the tree, setting J to the left son of K
    J := J shl 1;
  end;
  S.Heap[K] := V;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure GenerateBitLengths(var S: TDeflateState; var Descriptor: TTreeDescriptor);

// Computes the optimal bit lengths for a tree and update the total bit length for the current block.
// The fields Frequency and dad are set, Heap[HeapMaximum] and above are the tree nodes sorted by increasing frequency.
//
// Result: The field Len is set to the optimal bit length, the array BitLengthCounts contains the frequencies for each
// bit length. The length OptimalLength is updated. StaticLength is also updated if STree is not nil.

var
  Tree: PTree;
  MaxCode: Integer;
  STree: PTree;
  Extra: PIntegerArray;
  Base: Integer;
  MaxLength: Integer;
  H: Integer;          // heap Index
  N, M: Integer;       // iterate over the tree elements
  Bits: Word;          // bit length
  ExtraBits: Integer;
  F: Word;             // frequency
  Overflow: Integer;   // number of elements with bit length too large 
  
begin
  Tree := Descriptor.DynamicTree;
  MaxCode := Descriptor.MaxCode;
  STree := Descriptor.StaticDescriptor.StaticTree;
  Extra := Descriptor.StaticDescriptor.ExtraBits;
  Base := Descriptor.StaticDescriptor.ExtraBase;
  MaxLength := Descriptor.StaticDescriptor.MaxLength;
  Overflow := 0;

  FillChar(S.BitLengthCounts, SizeOf(S.BitLengthCounts), 0);

  // in a first pass, compute the optimal bit lengths (which may overflow in the case of the bit length tree) 
  Tree[S.Heap[S.HeapMaximum]].dl.Len := 0; // root of the heap 

  for H := S.HeapMaximum + 1 to HEAP_SIZE - 1 do
  begin
    N := S.Heap[H];
    Bits := Tree[Tree[N].dl.Dad].dl.Len + 1;
    if Bits > MaxLength then
    begin
      Bits := MaxLength;
      Inc(Overflow);
    end;
    Tree[N].dl.Len := Bits;

    // overwrite Tree[N].dl.Dad which is no longer needed
    if N > MaxCode then Continue; // not a leaf node 

    Inc(S.BitLengthCounts[Bits]);
    ExtraBits := 0;
    if N >= Base then ExtraBits := Extra[N - Base];
    F := Tree[N].fc.Frequency;
    Inc(S.OptimalLength, Integer(F) * (Bits + ExtraBits));
    if Assigned(STree) then Inc(S.StaticLength, Integer(F) * (STree[N].dl.Len + ExtraBits));
  end;
  // This happens for example on obj2 and pic of the Calgary corpus 
  if Overflow = 0 then Exit;

  // find the first bit length which could increase 
  repeat
    Bits := MaxLength - 1;
    while (S.BitLengthCounts[Bits] = 0) do Dec(Bits);
    // move one leaf down the tree
    Dec(S.BitLengthCounts[Bits]);
    // move one overflow item as its brother
    Inc(S.BitLengthCounts[Bits + 1], 2);
    // The brother of the overflow item also moves one step up,
    // but this does not affect BitLengthCounts[MaxLength]
    Dec(S.BitLengthCounts[MaxLength]);
    Dec(Overflow, 2);
  until (Overflow <= 0);

  // Now recompute all bit lengths, scanning in increasing frequency.
  // H is still equal to HEAP_SIZE. (It is simpler to reconstruct all
  // lengths instead of fixing only the wrong ones. This idea is taken
  // from 'ar' written by Haruhiko Okumura.)
  H := HEAP_SIZE;
  for Bits := MaxLength downto 1 do
  begin
    N := S.BitLengthCounts[Bits];
    while (N <> 0) do
    begin
      Dec(H);
      M := S.Heap[H];
      if M > MaxCode then Continue;
      if Tree[M].dl.Len <> Bits then
      begin
        Inc(S.OptimalLength, (Bits - Tree[M].dl.Len) * Tree[M].fc.Frequency);
        Tree[M].dl.Len := Word(Bits);
      end;
      Dec(N);
    end;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure BuildTree(var S: TDeflateState; var Descriptor: TTreeDescriptor);

// Constructs a Huffman tree and assigns the code bit strings and lengths.
// Updates the total bit length for the current block. The field Frequency must be set for all tree elements on entry.
//
// Result: the fields Len and Code are set to the optimal bit length and corresponding Code. The length OptimalLength
// is updated; StaticLength is also updated if STree is not nil. The field MaxCode is set.

var
  Tree: PTree;
  STree: PTree;
  Elements: Integer;
  N, M: Integer;    // iterate over heap elements
  MaxCode: Integer; // largest code with non zero frequency
  Node: Integer;    // new node being created 

begin
  Tree := Descriptor.DynamicTree;
  STree := Descriptor.StaticDescriptor.StaticTree;
  Elements := Descriptor.StaticDescriptor.Elements;
  MaxCode := -1;

  // Construct the initial Heap, with least frequent element in Heap[SMALLEST].
  // The sons of Heap[N] are Heap[2 * N] and Heap[2 * N + 1]. Heap[0] is not used. 
  S.HeapLength := 0;
  S.HeapMaximum := HEAP_SIZE;

  for N := 0 to Elements - 1 do
  begin
    if Tree[N].fc.Frequency = 0 then Tree[N].dl.Len := 0
                                else
    begin
      MaxCode := N;
      Inc(S.HeapLength);
      S.Heap[S.HeapLength] := N;
      S.Depth[N] := 0;
    end;
  end;

  // The pkzip format requires that at least one distance code exists and that at least one bit
  // should be sent even if there is only one possible code. So to avoid special checks later on we force at least
  // two codes of non zero frequency.
  while S.HeapLength < 2 do
  begin
    Inc(S.HeapLength);
    if MaxCode < 2 then
    begin
      Inc(MaxCode);
      S.Heap[S.HeapLength] := MaxCode;
      Node := MaxCode;
    end
    else
    begin
      S.Heap[S.HeapLength] := 0;
      Node := 0;
    end;
    Tree[Node].fc.Frequency := 1;
    S.Depth[Node] := 0;
    Dec(S.OptimalLength);
    if (STree <> nil) then Dec(S.StaticLength, STree[Node].dl.Len);
    // Node is 0 or 1 so it does not have extra bits 
  end;
  Descriptor.MaxCode := MaxCode;

  // The elements Heap[HeapLength / 2 + 1 .. HeapLength] are leaves of the Tree,
  // establish sub-heaps of increasing lengths.
  for N := S.HeapLength div 2 downto 1 do RestoreHeap(S, Tree^, N);

  // construct the Huffman tree by repeatedly combining the least two frequent nodes
  Node := Elements; // next internal node of the tree
  repeat
    N := S.Heap[SMALLEST];
    S.Heap[SMALLEST] := S.Heap[S.HeapLength];
    Dec(S.HeapLength);
    RestoreHeap(S, Tree^, SMALLEST);

    // M := node of next least frequency
    M := S.Heap[SMALLEST];
    Dec(S.HeapMaximum);
    // keep the nodes sorted by frequency
    S.Heap[S.HeapMaximum] := N;
    Dec(S.HeapMaximum);
    S.Heap[S.HeapMaximum] := M;

    // create a new node father of N and M
    Tree[Node].fc.Frequency := Tree[N].fc.Frequency + Tree[M].fc.Frequency;
    // maximum
    if (S.Depth[N] >= S.Depth[M]) then S.Depth[Node] := Byte (S.Depth[N] + 1)
                                  else S.Depth[Node] := Byte (S.Depth[M] + 1);

    Tree[M].dl.Dad := Word(Node);
    Tree[N].dl.Dad := Word(Node);
    // and insert the new node in the heap
    S.Heap[SMALLEST] := Node;
    Inc(Node);
    RestoreHeap(S, Tree^, SMALLEST);
  until S.HeapLength < 2;

  Dec(S.HeapMaximum);
  S.Heap[S.HeapMaximum] := S.Heap[SMALLEST];

  // At this point the fields Frequency and dad are set. We can now generate the bit lengths.
  GenerateBitLengths(S, Descriptor);

  // The field Len is now set, we can generate the bit codes 
  GenerateCodes(Tree, MaxCode, S.BitLengthCounts);
end;

//----------------------------------------------------------------------------------------------------------------------

procedure ScanTree(var S: TDeflateState; var Tree: array of TTreeEntry; MaxCode: Integer);

// Scans a given tree to determine the frequencies of the codes in the bit length tree.
// MaxCode is the tree's largest code of non zero frequency.

var
  N: Integer;           // iterates over all tree elements
  PreviousLen: Integer; // last emitted length
  CurrentLen: Integer;  // Length of current code
  NextLen: Integer;     // length of next code
  Count: Integer;       // repeat count of the current xode
  MaxCount: Integer;    // max repeat count
  MinCount: Integer;    // min repeat count
   
begin
  PreviousLen := -1;
  NextLen := Tree[0].dl.Len;
  Count := 0;
  MaxCount := 7;
  MinCount := 4;

  if NextLen = 0 then
  begin
    MaxCount := 138;
    MinCount := 3;
  end;
  Tree[MaxCode + 1].dl.Len := Word($FFFF); // guard

  for N := 0 to MaxCode do
  begin
    CurrentLen := NextLen;
    NextLen := Tree[N + 1].dl.Len;
    Inc(Count);
    if (Count < MaxCount) and (CurrentLen = NextLen) then Continue
                                                     else
      if (Count < MinCount) then Inc(S.BitLengthTree[CurrentLen].fc.Frequency, Count)
                            else
        if CurrentLen <> 0 then
        begin
          if (CurrentLen <> PreviousLen) then Inc(S.BitLengthTree[CurrentLen].fc.Frequency);
          Inc(S.BitLengthTree[REP_3_6].fc.Frequency);
        end
        else
          if (Count <= 10) then Inc(S.BitLengthTree[REPZ_3_10].fc.Frequency)
                           else Inc(S.BitLengthTree[REPZ_11_138].fc.Frequency);
    Count := 0;
    PreviousLen := CurrentLen;
    if NextLen = 0 then
    begin
      MaxCount := 138;
      MinCount := 3;
    end
    else
      if CurrentLen = NextLen then
      begin