jquant2.pas

用pascal寫的jpeg codec, 測試過的

  range_limit := cinfo^.sample_range_limit;
  error_limit := cquantize^.error_limiter;
  colormap0 := cinfo^.colormap^[0];
  colormap1 := cinfo^.colormap^[1];
  colormap2 := cinfo^.colormap^[2];

  for row := 0 to pred(num_rows) do
  begin
    inptr := RGBptr(input_buf^[row]);
    outptr := JSAMPLE_PTR(output_buf^[row]);
    errorptr := RGB_FSERROR_PTR(cquantize^.fserrors); { => entry before first real column }
    if (cquantize^.on_odd_row) then
    begin
      { work right to left in this row }
      Inc(inptr, (width-1));     { so point to rightmost pixel }
      Inc(outptr, width-1);
      dir := -1;
      Inc(errorptr, (width+1)); { => entry after last column }
      cquantize^.on_odd_row := FALSE; { flip for next time }
    end
    else
    begin
      { work left to right in this row }
      dir := 1;
      cquantize^.on_odd_row := TRUE; { flip for next time }
    end;

    { Preset error values: no error propagated to first pixel from left }
    cur.r := 0;
    cur.g := 0;
    cur.b := 0;
    { and no error propagated to row below yet }
    belowerr.r := 0;
    belowerr.g := 0;
    belowerr.b := 0;
    bpreverr.r := 0;
    bpreverr.g := 0;
    bpreverr.b := 0;

    for col := pred(width) downto 0 do
    begin
      prev_errorptr := errorptr;
      Inc(errorptr, dir);	{ advance errorptr to current column }

      { curN holds the error propagated from the previous pixel on the
        current line.  Add the error propagated from the previous line
        to form the complete error correction term for this pixel, and
        round the error term (which is expressed * 16) to an integer.
        RIGHT_SHIFT rounds towards minus infinity, so adding 8 is correct
        for either sign of the error value.
        Note: prev_errorptr points to *previous* column's array entry. }

      { Nomssi Note: Borland Pascal SHR is unsigned }
      cur.r := (cur.r + errorptr^.r + 8) div 16;
      cur.g := (cur.g + errorptr^.g + 8) div 16;
      cur.b := (cur.b + errorptr^.b + 8) div 16;
      { Limit the error using transfer function set by init_error_limit.
        See comments with init_error_limit for rationale. }

      cur.r := error_limit^[cur.r];
      cur.g := error_limit^[cur.g];
      cur.b := error_limit^[cur.b];
      { Form pixel value + error, and range-limit to 0..MAXJSAMPLE.
        The maximum error is +- MAXJSAMPLE (or less with error limiting);
        this sets the required size of the range_limit array. }

      Inc(cur.r, GETJSAMPLE(inptr^.r));
      Inc(cur.g, GETJSAMPLE(inptr^.g));
      Inc(cur.b, GETJSAMPLE(inptr^.b));

      cur.r := GETJSAMPLE(range_limit^[cur.r]);
      cur.g := GETJSAMPLE(range_limit^[cur.g]);
      cur.b := GETJSAMPLE(range_limit^[cur.b]);
      { Index into the cache with adjusted pixel value }
      cachep := @(histogram^[cur.r shr C0_SHIFT]^
                            [cur.g shr C1_SHIFT][cur.b shr C2_SHIFT]);
      { If we have not seen this color before, find nearest colormap }
      { entry and update the cache }
      if (cachep^ = 0) then
	fill_inverse_cmap(cinfo, cur.r shr C0_SHIFT,
                                 cur.g shr C1_SHIFT,
                                 cur.b shr C2_SHIFT);
      { Now emit the colormap index for this cell }

      pixcode := cachep^ - 1;
      outptr^ := JSAMPLE (pixcode);

      { Compute representation error for this pixel }
      Dec(cur.r, GETJSAMPLE(colormap0^[pixcode]));
      Dec(cur.g, GETJSAMPLE(colormap1^[pixcode]));
      Dec(cur.b, GETJSAMPLE(colormap2^[pixcode]));

      { Compute error fractions to be propagated to adjacent pixels.
        Add these into the running sums, and simultaneously shift the
        next-line error sums left by 1 column. }

      bnexterr := cur.r;	{ Process component 0 }
      delta := cur.r * 2;
      Inc(cur.r, delta);		{ form error * 3 }
      prev_errorptr^.r := FSERROR (bpreverr.r + cur.r);
      Inc(cur.r, delta);		{ form error * 5 }
      bpreverr.r := belowerr.r + cur.r;
      belowerr.r := bnexterr;
      Inc(cur.r, delta);		{ form error * 7 }
      bnexterr := cur.g;	{ Process component 1 }
      delta := cur.g * 2;
      Inc(cur.g, delta);		{ form error * 3 }
      prev_errorptr^.g := FSERROR (bpreverr.g + cur.g);
      Inc(cur.g, delta);		{ form error * 5 }
      bpreverr.g := belowerr.g + cur.g;
      belowerr.g := bnexterr;
      Inc(cur.g, delta);		{ form error * 7 }
      bnexterr := cur.b;	{ Process component 2 }
      delta := cur.b * 2;
      Inc(cur.b, delta);		{ form error * 3 }
      prev_errorptr^.b := FSERROR (bpreverr.b + cur.b);
      Inc(cur.b, delta);		{ form error * 5 }
      bpreverr.b := belowerr.b + cur.b;
      belowerr.b := bnexterr;
      Inc(cur.b, delta);		{ form error * 7 }

      { At this point curN contains the 7/16 error value to be propagated
        to the next pixel on the current line, and all the errors for the
        next line have been shifted over.  We are therefore ready to move on.}

      Inc(inptr, dir);		{ Advance pixel pointers to next column }
      Inc(outptr, dir);
    end;
    { Post-loop cleanup: we must unload the final error values into the
      final fserrors[] entry.  Note we need not unload belowerrN because
      it is for the dummy column before or after the actual array. }

    errorptr^.r := FSERROR (bpreverr.r); { unload prev errs into array }
    errorptr^.g := FSERROR (bpreverr.g);
    errorptr^.b := FSERROR (bpreverr.b);
  end;
end;


{ Initialize the error-limiting transfer function (lookup table).
  The raw F-S error computation can potentially compute error values of up to
  +- MAXJSAMPLE.  But we want the maximum correction applied to a pixel to be
  much less, otherwise obviously wrong pixels will be created.  (Typical
  effects include weird fringes at color-area boundaries, isolated bright
  pixels in a dark area, etc.)  The standard advice for avoiding this problem
  is to ensure that the "corners" of the color cube are allocated as output
  colors; then repeated errors in the same direction cannot cause cascading
  error buildup.  However, that only prevents the error from getting
  completely out of hand; Aaron Giles reports that error limiting improves
  the results even with corner colors allocated.
  A simple clamping of the error values to about +- MAXJSAMPLE/8 works pretty
  well, but the smoother transfer function used below is even better.  Thanks
  to Aaron Giles for this idea. }

{LOCAL}
procedure init_error_limit (cinfo : j_decompress_ptr);
const
  STEPSIZE = ((MAXJSAMPLE+1) div 16);
{ Allocate and fill in the error_limiter table }
var
  cquantize : my_cquantize_ptr;
  table : error_limit_ptr;
  inp, out : int;
begin
  cquantize := my_cquantize_ptr (cinfo^.cquantize);
  table := error_limit_ptr (cinfo^.mem^.alloc_small
    (j_common_ptr (cinfo), JPOOL_IMAGE, (MAXJSAMPLE*2+1) * SIZEOF(int)));
  { not needed: Inc(table, MAXJSAMPLE);
                so can index -MAXJSAMPLE .. +MAXJSAMPLE }
  cquantize^.error_limiter := table;
  { Map errors 1:1 up to +- MAXJSAMPLE/16 }
  out := 0;
  for inp := 0 to pred(STEPSIZE) do
  begin
    table^[inp] := out;
    table^[-inp] := -out;
    Inc(out);
  end;
  { Map errors 1:2 up to +- 3*MAXJSAMPLE/16 }
  inp := STEPSIZE;       { Nomssi: avoid problems with Delphi2 optimizer }
  while (inp < STEPSIZE*3) do
  begin
    table^[inp] := out;
    table^[-inp] := -out;
    Inc(inp);
    if Odd(inp) then
      Inc(out);
  end;
  { Clamp the rest to final out value (which is (MAXJSAMPLE+1)/8) }
  inp := STEPSIZE*3;     { Nomssi: avoid problems with Delphi 2 optimizer }
  while inp <= MAXJSAMPLE do
  begin
    table^[inp] := out;
    table^[-inp] := -out;
    Inc(inp);
  end;
end;

{ Finish up at the end of each pass. }

{METHODDEF}
procedure finish_pass1 (cinfo : j_decompress_ptr); far;
var
  cquantize : my_cquantize_ptr;
begin
  cquantize := my_cquantize_ptr (cinfo^.cquantize);

  { Select the representative colors and fill in cinfo^.colormap }
  cinfo^.colormap := cquantize^.sv_colormap;
  select_colors(cinfo, cquantize^.desired);
  { Force next pass to zero the color index table }
  cquantize^.needs_zeroed := TRUE;
end;


{METHODDEF}
procedure finish_pass2 (cinfo : j_decompress_ptr); far;
begin
  { no work }
end;


{ Initialize for each processing pass. }

{METHODDEF}
procedure start_pass_2_quant (cinfo : j_decompress_ptr;
                              is_pre_scan : boolean); far;
var
  cquantize : my_cquantize_ptr;
  histogram : hist3d;
  i : int;
var
  arraysize : size_t;
begin
  cquantize := my_cquantize_ptr (cinfo^.cquantize);
  histogram := cquantize^.histogram;
  { Only F-S dithering or no dithering is supported. }
  { If user asks for ordered dither, give him F-S. }
  if (cinfo^.dither_mode <> JDITHER_NONE) then
    cinfo^.dither_mode := JDITHER_FS;

  if (is_pre_scan) then
  begin
    { Set up method pointers }
    cquantize^.pub.color_quantize := prescan_quantize;
    cquantize^.pub.finish_pass := finish_pass1;
    cquantize^.needs_zeroed := TRUE; { Always zero histogram }
  end
  else
  begin
    { Set up method pointers }
    if (cinfo^.dither_mode = JDITHER_FS) then
      cquantize^.pub.color_quantize := pass2_fs_dither
    else
      cquantize^.pub.color_quantize := pass2_no_dither;
    cquantize^.pub.finish_pass := finish_pass2;

    { Make sure color count is acceptable }
    i := cinfo^.actual_number_of_colors;
    if (i < 1) then
      ERREXIT1(j_common_ptr(cinfo), JERR_QUANT_FEW_COLORS, 1);
    if (i > MAXNUMCOLORS) then
      ERREXIT1(j_common_ptr(cinfo), JERR_QUANT_MANY_COLORS, MAXNUMCOLORS);

    if (cinfo^.dither_mode = JDITHER_FS) then
    begin
      arraysize := size_t ((cinfo^.output_width + 2) *
				   (3 * SIZEOF(FSERROR)));
      { Allocate Floyd-Steinberg workspace if we didn't already. }
      if (cquantize^.fserrors = NIL) then
	cquantize^.fserrors := FS_ERROR_FIELD_PTR (cinfo^.mem^.alloc_large
	  (j_common_ptr(cinfo), JPOOL_IMAGE, arraysize));
      { Initialize the propagated errors to zero. }
      jzero_far(cquantize^.fserrors, arraysize);
      { Make the error-limit table if we didn't already. }
      if (cquantize^.error_limiter = NIL) then
	init_error_limit(cinfo);
      cquantize^.on_odd_row := FALSE;
    end;

  end;
  { Zero the histogram or inverse color map, if necessary }
  if (cquantize^.needs_zeroed) then
  begin
    for i := 0 to pred(HIST_C0_ELEMS) do
    begin
      jzero_far( histogram^[i],
		HIST_C1_ELEMS*HIST_C2_ELEMS * SIZEOF(histcell));
    end;
    cquantize^.needs_zeroed := FALSE;
  end;
end;


{ Switch to a new external colormap between output passes. }

{METHODDEF}
procedure new_color_map_2_quant (cinfo : j_decompress_ptr); far;
var
  cquantize : my_cquantize_ptr;
begin
  cquantize := my_cquantize_ptr (cinfo^.cquantize);

  { Reset the inverse color map }
  cquantize^.needs_zeroed := TRUE;
end;


{ Module initialization routine for 2-pass color quantization. }


{GLOBAL}
procedure jinit_2pass_quantizer (cinfo : j_decompress_ptr);
var
  cquantize : my_cquantize_ptr;
  i : int;
var
  desired : int;
begin
  cquantize := my_cquantize_ptr(
    cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
				SIZEOF(my_cquantizer)));
  cinfo^.cquantize := jpeg_color_quantizer_ptr(cquantize);
  cquantize^.pub.start_pass := start_pass_2_quant;
  cquantize^.pub.new_color_map := new_color_map_2_quant;
  cquantize^.fserrors := NIL;	{ flag optional arrays not allocated }
  cquantize^.error_limiter := NIL;

  { Make sure jdmaster didn't give me a case I can't handle }
  if (cinfo^.out_color_components <> 3) then
    ERREXIT(j_common_ptr(cinfo), JERR_NOTIMPL);

  { Allocate the histogram/inverse colormap storage }
  cquantize^.histogram := hist3d (cinfo^.mem^.alloc_small
    (j_common_ptr (cinfo), JPOOL_IMAGE, HIST_C0_ELEMS * SIZEOF(hist2d)));
  for i := 0 to pred(HIST_C0_ELEMS) do
  begin
    cquantize^.histogram^[i] := hist2d (cinfo^.mem^.alloc_large
      (j_common_ptr (cinfo), JPOOL_IMAGE,
       HIST_C1_ELEMS*HIST_C2_ELEMS * SIZEOF(histcell)));
  end;
  cquantize^.needs_zeroed := TRUE; { histogram is garbage now }

  { Allocate storage for the completed colormap, if required.
    We do this now since it is FAR storage and may affect
    the memory manager's space calculations. }

  if (cinfo^.enable_2pass_quant) then
  begin
    { Make sure color count is acceptable }
    desired := cinfo^.desired_number_of_colors;
    { Lower bound on # of colors ... somewhat arbitrary as long as > 0 }
    if (desired < 8) then
      ERREXIT1(j_common_ptr (cinfo), JERR_QUANT_FEW_COLORS, 8);
    { Make sure colormap indexes can be represented by JSAMPLEs }
    if (desired > MAXNUMCOLORS) then
      ERREXIT1(j_common_ptr (cinfo), JERR_QUANT_MANY_COLORS, MAXNUMCOLORS);
    cquantize^.sv_colormap := cinfo^.mem^.alloc_sarray
      (j_common_ptr (cinfo),JPOOL_IMAGE, JDIMENSION(desired), JDIMENSION(3));
    cquantize^.desired := desired;
  end
  else
    cquantize^.sv_colormap := NIL;

  { Only F-S dithering or no dithering is supported. }
  { If user asks for ordered dither, give him F-S. }
  if (cinfo^.dither_mode <> JDITHER_NONE) then
    cinfo^.dither_mode := JDITHER_FS;

  { Allocate Floyd-Steinberg workspace if necessary.
    This isn't really needed until pass 2, but again it is FAR storage.
    Although we will cope with a later change in dither_mode,
    we do not promise to honor max_memory_to_use if dither_mode changes. }

  if (cinfo^.dither_mode = JDITHER_FS) then
  begin
    cquantize^.fserrors := FS_ERROR_FIELD_PTR (cinfo^.mem^.alloc_large
      (j_common_ptr(cinfo), JPOOL_IMAGE,
       size_t ((cinfo^.output_width + 2) * (3 * SIZEOF(FSERROR))) ) );
    { Might as well create the error-limiting table too. }
    init_error_limit(cinfo);
  end;
end;

end. { QUANT_2PASS_SUPPORTED }