jchuff.pas

用pascal寫的jpeg codec, 測試過的

    {emit_byte(state, c, return FALSE);}
    { Emit a byte, return FALSE if must suspend. }
    state.next_output_byte^ := JOCTET (c);
    Inc(state.next_output_byte);
    Dec(state.free_in_buffer);
    if (state.free_in_buffer = 0) then
      if not dump_buffer(state) then
      begin
        emit_bits := FALSE;
        exit;
      end;

    if (c = $FF) then          { need to stuff a zero byte? }
    begin
      {emit_byte(state, 0, return FALSE);}
      state.next_output_byte^ := JOCTET (0);
      Inc(state.next_output_byte);
      Dec(state.free_in_buffer);
      if (state.free_in_buffer = 0) then
	if not dump_buffer(state) then
	begin
          emit_bits := FALSE;
          exit;
        end;

    end;
    put_buffer := put_buffer shl 8;
    Dec(put_bits, 8);
  end;

  state.cur.put_buffer := put_buffer; { update state variables }
  state.cur.put_bits := put_bits;

  emit_bits := TRUE;
end;


{LOCAL}
function flush_bits (var state : working_state) : boolean;
begin
  if (not emit_bits(state, $7F, 7)) then { fill any partial byte with ones }
  begin
    flush_bits := FALSE;
    exit;
  end;
  state.cur.put_buffer := 0;	{ and reset bit-buffer to empty }
  state.cur.put_bits := 0;
  flush_bits := TRUE;
end;


{ Encode a single block's worth of coefficients }

{LOCAL}
function encode_one_block (var state : working_state;
                           const block : JBLOCK;
                           last_dc_val : int;
                           dctbl : c_derived_tbl_ptr;
                           actbl : c_derived_tbl_ptr) : boolean;
var
  {register} temp, temp2 : int;
  {register} nbits : int;
  {register} k, r, i : int;
begin
  { Encode the DC coefficient difference per section F.1.2.1 }

  temp2 := block[0] - last_dc_val;
  temp := temp2;

  if (temp < 0) then
  begin
    temp := -temp;		{ temp is abs value of input }
    { For a negative input, want temp2 := bitwise complement of abs(input) }
    { This code assumes we are on a two's complement machine }
    Dec(temp2);
  end;
  
  { 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;
  
  { Emit the Huffman-coded symbol for the number of bits }
  if not emit_bits(state, dctbl^.ehufco[nbits], dctbl^.ehufsi[nbits]) then
  begin
    encode_one_block := FALSE;
    exit;
  end;

  { Emit that number of bits of the value, if positive, }
  { or the complement of its magnitude, if negative. }
  if (nbits <> 0) then              { emit_bits rejects calls with size 0 }
    if not emit_bits(state, uInt(temp2), nbits) then
    begin
      encode_one_block := FALSE;
      exit;
    end;

  { 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
	if not emit_bits(state, actbl^.ehufco[$F0], actbl^.ehufsi[$F0]) then
        begin
          encode_one_block := FALSE;
          exit;
        end;
	Dec(r, 16);
      end;

      temp2 := temp;
      if (temp < 0) then
      begin
	temp := -temp;		{ temp is abs value of input }
	{ This code assumes we are on a two's complement machine }
	Dec(temp2);
      end;

      { 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);

      { Emit Huffman symbol for run length / number of bits }
      i := (r shl 4) + nbits;
      if not emit_bits(state, actbl^.ehufco[i], actbl^.ehufsi[i]) then
      begin
        encode_one_block := FALSE;
        exit;
      end;

      { Emit that number of bits of the value, if positive, }
      { or the complement of its magnitude, if negative. }
      if not emit_bits(state, uInt(temp2), nbits) then
      begin
        encode_one_block := FALSE;
        exit;
      end;

      r := 0;
    end;
  end;

  { If the last coef(s) were zero, emit an end-of-block code }
  if (r > 0) then
    if not emit_bits(state, actbl^.ehufco[0], actbl^.ehufsi[0]) then
    begin
      encode_one_block := FALSE;
      exit;
    end;

  encode_one_block := TRUE;
end;


{ Emit a restart marker & resynchronize predictions. }

{LOCAL}
function emit_restart (var state : working_state;
                       restart_num : int) : boolean;
var
  ci : int;
begin
  if (not flush_bits(state)) then
  begin
    emit_restart  := FALSE;
    exit;
  end;

  {emit_byte(state, $FF, return FALSE);}
  { Emit a byte, return FALSE if must suspend. }
  state.next_output_byte^ := JOCTET ($FF);
  Inc(state.next_output_byte);
  Dec(state.free_in_buffer);
  if (state.free_in_buffer = 0) then
    if not dump_buffer(state) then
    begin
      emit_restart := FALSE;
      exit;
    end;

  {emit_byte(state, JPEG_RST0 + restart_num, return FALSE);}
  { Emit a byte, return FALSE if must suspend. }
  state.next_output_byte^ := JOCTET (JPEG_RST0 + restart_num);
  Inc(state.next_output_byte);
  Dec(state.free_in_buffer);
  if (state.free_in_buffer = 0) then
    if not dump_buffer(state) then
    begin
      emit_restart := FALSE;
      exit;
    end;

  { Re-initialize DC predictions to 0 }
  for ci := 0 to pred(state.cinfo^.comps_in_scan) do
    state.cur.last_dc_val[ci] := 0;

  { The restart counter is not updated until we successfully write the MCU. }

  emit_restart := TRUE;
end;


{ Encode and output one MCU's worth of Huffman-compressed coefficients. }

{METHODDEF}
function encode_mcu_huff (cinfo : j_compress_ptr;
                          const MCU_data: array of JBLOCKROW) : boolean;
var
  entropy : huff_entropy_ptr;
  state : working_state;
  blkn, ci : int;
  compptr : jpeg_component_info_ptr;
begin
  entropy := huff_entropy_ptr (cinfo^.entropy);
  { Load up working state }
  state.next_output_byte := cinfo^.dest^.next_output_byte;
  state.free_in_buffer := cinfo^.dest^.free_in_buffer;
  {ASSIGN_STATE(state.cur, entropy^.saved);}
  state.cur := entropy^.saved;
  state.cinfo := cinfo;

  { Emit restart marker if needed }
  if (cinfo^.restart_interval <> 0) then
  begin
    if (entropy^.restarts_to_go = 0) then
      if not emit_restart(state, entropy^.next_restart_num) then
      begin
	encode_mcu_huff := FALSE;
        exit;
      end;
  end;

  { Encode the MCU data blocks }
  for blkn := 0  to pred(cinfo^.blocks_in_MCU) do
  begin
    ci := cinfo^.MCU_membership[blkn];
    compptr := cinfo^.cur_comp_info[ci];
    if not encode_one_block(state,
                            MCU_data[blkn]^[0],
                            state.cur.last_dc_val[ci],
                            entropy^.dc_derived_tbls[compptr^.dc_tbl_no],
                            entropy^.ac_derived_tbls[compptr^.ac_tbl_no]) then
    begin
      encode_mcu_huff := FALSE;
      exit;
    end;
    { Update last_dc_val }
    state.cur.last_dc_val[ci] := MCU_data[blkn]^[0][0];
  end;

  { Completed MCU, so update state }
  cinfo^.dest^.next_output_byte := state.next_output_byte;
  cinfo^.dest^.free_in_buffer := state.free_in_buffer;
  {ASSIGN_STATE(entropy^.saved, state.cur);}
  entropy^.saved := state.cur;

  { Update restart-interval state too }
  if (cinfo^.restart_interval <> 0) then
  begin
    if (entropy^.restarts_to_go = 0) then
    begin
      entropy^.restarts_to_go := cinfo^.restart_interval;
      Inc(entropy^.next_restart_num);
      with entropy^ do
        next_restart_num := next_restart_num and 7;
    end;
    Dec(entropy^.restarts_to_go);
  end;

  encode_mcu_huff := TRUE;
end;


{ Finish up at the end of a Huffman-compressed scan. }

{METHODDEF}
procedure finish_pass_huff (cinfo : j_compress_ptr);
var
  entropy : huff_entropy_ptr;
  state : working_state;
begin
  entropy := huff_entropy_ptr (cinfo^.entropy);

  { Load up working state ... flush_bits needs it }
  state.next_output_byte := cinfo^.dest^.next_output_byte;
  state.free_in_buffer := cinfo^.dest^.free_in_buffer;
  {ASSIGN_STATE(state.cur, entropy^.saved);}
  state.cur := entropy^.saved;
  state.cinfo := cinfo;

  { Flush out the last data }
  if not flush_bits(state) then
    ERREXIT(j_common_ptr(cinfo), JERR_CANT_SUSPEND);

  { Update state }
  cinfo^.dest^.next_output_byte := state.next_output_byte;
  cinfo^.dest^.free_in_buffer := state.free_in_buffer;
  {ASSIGN_STATE(entropy^.saved, state.cur);}
  entropy^.saved := state.cur;
end;


{ Huffman coding optimization.

  This actually is optimization, in the sense that we find the best possible
  Huffman table(s) for the given data.  We first scan the supplied data and
  count the number of uses of each symbol that is to be Huffman-coded.
  (This process must agree with the code above.)  Then we build an
  optimal Huffman coding tree for the observed counts.

  The JPEG standard requires Huffman codes to be no more than 16 bits long.
  If some symbols have a very small but nonzero probability, the Huffman tree
  must be adjusted to meet the code length restriction.  We currently use
  the adjustment method suggested in the JPEG spec.  This method is *not*
  optimal; it may not choose the best possible limited-length code.  But
  since the symbols involved are infrequently used, it's not clear that
  going to extra trouble is worthwhile. }

{$ifdef ENTROPY_OPT_SUPPORTED}


{ Process a single block's worth of coefficients }

{LOCAL}
procedure htest_one_block (const block : JBLOCK;
                           last_dc_val : int;