jchuff.pas

用pascal寫的jpeg codec, 測試過的

		           dc_counts : TLongTablePtr;
                           ac_counts : TLongTablePtr);

var
  {register} temp : int;
  {register} nbits : int;
  {register} k, r : int;
begin
  { Encode the DC coefficient difference per section F.1.2.1 }
  temp := block[0] - last_dc_val;
  if (temp < 0) then
    temp := -temp;

  { Find the number of bits needed for the magnitude of the coefficient }
  nbits := 0;
  while (temp <> 0) do
  begin
    Inc(nbits);
    temp := temp shr 1;
  end;

  { Count the Huffman symbol for the number of bits }
  Inc(dc_counts^[nbits]);

  { Encode the AC coefficients per section F.1.2.2 }

  r := 0;			{ r := run length of zeros }

  for k := 1 to pred(DCTSIZE2) do
  begin
    temp := block[jpeg_natural_order[k]];
    if (temp = 0) then
    begin
      Inc(r);
    end
    else
    begin
      { if run length > 15, must emit special run-length-16 codes ($F0) }
      while (r > 15) do
      begin
	Inc(ac_counts^[$F0]);
	Dec(r, 16);
      end;

      { Find the number of bits needed for the magnitude of the coefficient }
      if (temp < 0) then
	temp := -temp;

      { Find the number of bits needed for the magnitude of the coefficient }
      nbits := 0;		{ there must be at least one 1 bit }
      repeat
        Inc(nbits);
        temp := temp shr 1;
      until (temp = 0);


      { Count Huffman symbol for run length / number of bits }
      Inc(ac_counts^[(r shl 4) + nbits]);

      r := 0;
    end;
  end;

  { If the last coef(s) were zero, emit an end-of-block code }
  if (r > 0) then
    Inc(ac_counts^[0]);
end;


{ Trial-encode one MCU's worth of Huffman-compressed coefficients.
  No data is actually output, so no suspension return is possible. }

{METHODDEF}
function encode_mcu_gather (cinfo : j_compress_ptr;
                           const MCU_data: array of JBLOCKROW) : boolean;
var
  entropy : huff_entropy_ptr;
  blkn, ci : int;
  compptr : jpeg_component_info_ptr;
begin
  entropy := huff_entropy_ptr (cinfo^.entropy);
  { Take care of restart intervals if needed }
  if (cinfo^.restart_interval <> 0) then
  begin
    if (entropy^.restarts_to_go = 0) then
    begin
      { Re-initialize DC predictions to 0 }
      for ci := 0 to pred(cinfo^.comps_in_scan) do
	entropy^.saved.last_dc_val[ci] := 0;
      { Update restart state }
      entropy^.restarts_to_go := cinfo^.restart_interval;
    end;
    Dec(entropy^.restarts_to_go);
  end;

  for blkn := 0 to pred(cinfo^.blocks_in_MCU) do
  begin
    ci := cinfo^.MCU_membership[blkn];
    compptr := cinfo^.cur_comp_info[ci];
    htest_one_block(MCU_data[blkn]^[0],
                    entropy^.saved.last_dc_val[ci],
                    entropy^.dc_count_ptrs[compptr^.dc_tbl_no],
		    entropy^.ac_count_ptrs[compptr^.ac_tbl_no]);
    entropy^.saved.last_dc_val[ci] := MCU_data[blkn]^[0][0];
  end;

  encode_mcu_gather := TRUE;
end;


{ Generate the optimal coding for the given counts, fill htbl.
  Note this is also used by jcphuff.c. }

{GLOBAL}
procedure jpeg_gen_optimal_table (cinfo : j_compress_ptr;
                                  htbl : JHUFF_TBL_PTR;
                                  var freq : TLongTable);
const
  MAX_CLEN = 32;		{ assumed maximum initial code length }
var
  bits : array[0..MAX_CLEN+1-1] of UINT8;  { bits[k] := # of symbols with code length k }
  codesize : array[0..257-1] of int;       { codesize[k] := code length of symbol k }
  others : array[0..257-1] of int;         { next symbol in current branch of tree }
  c1, c2 : int;
  p, i, j : int;
  v : long;
begin
  { This algorithm is explained in section K.2 of the JPEG standard }

  MEMZERO(@bits, SIZEOF(bits));
  MEMZERO(@codesize, SIZEOF(codesize));
  for i := 0 to 256 do
    others[i] := -1;		{ init links to empty }

  freq[256] := 1;		{ make sure there is a nonzero count }
  { Including the pseudo-symbol 256 in the Huffman procedure guarantees
    that no real symbol is given code-value of all ones, because 256
    will be placed in the largest codeword category. }

  { Huffman's basic algorithm to assign optimal code lengths to symbols }

  while TRUE do
  begin
    { Find the smallest nonzero frequency, set c1 := its symbol }
    { In case of ties, take the larger symbol number }
    c1 := -1;
    v := long(1000000000);
    for i := 0 to 256 do
    begin
      if (freq[i] <> 0) and (freq[i] <= v) then
      begin
        v := freq[i];
        c1 := i;
      end;
    end;

    { Find the next smallest nonzero frequency, set c2 := its symbol }
    { In case of ties, take the larger symbol number }
    c2 := -1;
    v := long(1000000000);
    for i := 0 to 256 do
    begin
      if (freq[i] <> 0) and (freq[i] <= v) and (i <> c1) then
      begin
        v := freq[i];
        c2 := i;
      end;
    end;

    { Done if we've merged everything into one frequency }
    if (c2 < 0) then
      break;

    { Else merge the two counts/trees }
    Inc(freq[c1], freq[c2]);
    freq[c2] := 0;

    { Increment the codesize of everything in c1's tree branch }
    Inc(codesize[c1]);
    while (others[c1] >= 0) do
    begin
      c1 := others[c1];
      Inc(codesize[c1]);
    end;

    others[c1] := c2;		{ chain c2 onto c1's tree branch }

    { Increment the codesize of everything in c2's tree branch }
    Inc(codesize[c2]);
    while (others[c2] >= 0) do
    begin
      c2 := others[c2];
      Inc(codesize[c2]);
    end;
  end;

  { Now count the number of symbols of each code length }
  for i := 0 to 256 do
  begin
    if (codesize[i]<>0) then
    begin
      { The JPEG standard seems to think that this can't happen, }
      { but I'm paranoid... }
      if (codesize[i] > MAX_CLEN) then
	ERREXIT(j_common_ptr(cinfo), JERR_HUFF_CLEN_OVERFLOW);

      Inc(bits[codesize[i]]);
    end;
  end;

  { JPEG doesn't allow symbols with code lengths over 16 bits, so if the pure
    Huffman procedure assigned any such lengths, we must adjust the coding.
    Here is what the JPEG spec says about how this next bit works:
    Since symbols are paired for the longest Huffman code, the symbols are
    removed from this length category two at a time.  The prefix for the pair
    (which is one bit shorter) is allocated to one of the pair; then,
    skipping the BITS entry for that prefix length, a code word from the next
    shortest nonzero BITS entry is converted into a prefix for two code words
    one bit longer.  }

  for i := MAX_CLEN downto 17 do
  begin
    while (bits[i] > 0) do
    begin
      j := i - 2;               { find length of new prefix to be used }
      while (bits[j] = 0) do
      	Dec(j);

      Dec(bits[i], 2);          { remove two symbols }
      Inc(bits[i-1]);           { one goes in this length }
      Inc(bits[j+1], 2);        { two new symbols in this length }
      Dec(bits[j]);		{ symbol of this length is now a prefix }
    end;
  end;

  { Delphi 2: FOR-loop variable 'i' may be undefined after loop }
  i := 16;                      { Nomssi: work around }
  
  { Remove the count for the pseudo-symbol 256 from the largest codelength }
  while (bits[i] = 0) do        { find largest codelength still in use }
    Dec(i);
  Dec(bits[i]);

  { Return final symbol counts (only for lengths 0..16) }
  MEMCOPY(@htbl^.bits, @bits, SIZEOF(htbl^.bits));

  { Return a list of the symbols sorted by code length }
  { It's not real clear to me why we don't need to consider the codelength
    changes made above, but the JPEG spec seems to think this works. }

  p := 0;
  for i := 1 to MAX_CLEN do
  begin
    for j := 0 to 255 do
    begin
      if (codesize[j] = i) then
      begin
	htbl^.huffval[p] := UINT8 (j);
	Inc(p);
      end;
    end;
  end;

  { Set sent_table FALSE so updated table will be written to JPEG file. }
  htbl^.sent_table := FALSE;
end;


{ Finish up a statistics-gathering pass and create the new Huffman tables. }

{METHODDEF}
procedure finish_pass_gather (cinfo : j_compress_ptr);
var
  entropy : huff_entropy_ptr;
  ci, dctbl, actbl : int;
  compptr : jpeg_component_info_ptr;
  htblptr : ^JHUFF_TBL_PTR;
  did_dc : array[0..NUM_HUFF_TBLS-1] of boolean;
  did_ac : array[0..NUM_HUFF_TBLS-1] of boolean;
begin
  entropy := huff_entropy_ptr (cinfo^.entropy);

  { It's important not to apply jpeg_gen_optimal_table more than once
    per table, because it clobbers the input frequency counts! }

  MEMZERO(@did_dc, SIZEOF(did_dc));
  MEMZERO(@did_ac, SIZEOF(did_ac));

  for ci := 0 to pred(cinfo^.comps_in_scan) do
  begin
    compptr := cinfo^.cur_comp_info[ci];
    dctbl := compptr^.dc_tbl_no;
    actbl := compptr^.ac_tbl_no;
    if (not did_dc[dctbl]) then
    begin
      htblptr := @(cinfo^.dc_huff_tbl_ptrs[dctbl]);
      if ( htblptr^ = NIL) then
	htblptr^ := jpeg_alloc_huff_table(j_common_ptr(cinfo));
      jpeg_gen_optimal_table(cinfo, htblptr^, entropy^.dc_count_ptrs[dctbl]^);
      did_dc[dctbl] := TRUE;
    end;
    if (not did_ac[actbl]) then
    begin
      htblptr := @(cinfo^.ac_huff_tbl_ptrs[actbl]);
      if ( htblptr^ = NIL) then
	htblptr^ := jpeg_alloc_huff_table(j_common_ptr(cinfo));
      jpeg_gen_optimal_table(cinfo, htblptr^, entropy^.ac_count_ptrs[actbl]^);
      did_ac[actbl] := TRUE;
    end;
  end;
end;

{$endif} { ENTROPY_OPT_SUPPORTED }


{ Module initialization routine for Huffman entropy encoding. }

{GLOBAL}
procedure jinit_huff_encoder (cinfo : j_compress_ptr);
var
  entropy : huff_entropy_ptr;
  i : int;
begin
  entropy := huff_entropy_ptr(
    cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
				SIZEOF(huff_entropy_encoder)) );
  cinfo^.entropy := jpeg_entropy_encoder_ptr (entropy);
  entropy^.pub.start_pass := start_pass_huff;

  { Mark tables unallocated }
  for i := 0 to pred(NUM_HUFF_TBLS) do
  begin
    entropy^.ac_derived_tbls[i] := NIL;
    entropy^.dc_derived_tbls[i] := NIL;
{$ifdef ENTROPY_OPT_SUPPORTED}
    entropy^.ac_count_ptrs[i] := NIL;
    entropy^.dc_count_ptrs[i] := NIL;
{$endif}
  end;
end;

end.