jquant2.pas

用pascal寫的jpeg codec, 測試過的

  c0min := boxp.c0min;  c0max := boxp.c0max;
  c1min := boxp.c1min;  c1max := boxp.c1max;
  c2min := boxp.c2min;  c2max := boxp.c2max;

  if (c0max > c0min) then
    for c0 := c0min to c0max do
      for c1 := c1min to c1max do
      begin
	histp := @(histogram^[c0]^[c1][c2min]);
	for c2 := c2min to c2max do
        begin
	  if (histp^ <> 0) then
          begin
            c0min := c0;
	    boxp.c0min := c0min;
	    goto have_c0min;
	  end;
          Inc(histp);
        end;
      end;
 have_c0min:
  if (c0max > c0min) then
    for c0 := c0max downto c0min do
      for c1 := c1min to c1max do
      begin
	histp := @(histogram^[c0]^[c1][c2min]);
	for c2 := c2min to c2max do
        begin
	  if ( histp^ <> 0) then
          begin
            c0max := c0;
	    boxp.c0max := c0;
	    goto have_c0max;
	  end;
          Inc(histp);
        end;
      end;
 have_c0max:
  if (c1max > c1min) then
    for c1 := c1min to c1max do
      for c0 := c0min to c0max do
      begin
	histp := @(histogram^[c0]^[c1][c2min]);
	for c2 := c2min to c2max do
        begin
	  if (histp^ <> 0) then
          begin
            c1min := c1;
	    boxp.c1min := c1;
	    goto have_c1min;
	  end;
          Inc(histp);
        end;
      end;
 have_c1min:
  if (c1max > c1min) then
    for c1 := c1max downto c1min do
      for c0 := c0min to c0max do
      begin
	histp := @(histogram^[c0]^[c1][c2min]);
	for c2 := c2min to c2max do
        begin
	  if (histp^ <> 0) then
          begin
            c1max := c1;
	    boxp.c1max := c1;
	    goto have_c1max;
	  end;
          Inc(histp);
        end;
      end;
 have_c1max:
  if (c2max > c2min) then
    for c2 := c2min to c2max do
      for c0 := c0min to c0max do
      begin
	histp := @(histogram^[c0]^[c1min][c2]);
	for c1 := c1min to c1max do
        begin
	  if (histp^ <> 0) then
          begin
	    c2min := c2;
	    boxp.c2min := c2min;
	    goto have_c2min;
	  end;
          Inc(histp, HIST_C2_ELEMS);
        end;
      end;
 have_c2min:
  if (c2max > c2min) then
    for c2 := c2max downto c2min do
      for c0 := c0min to c0max do
      begin
	histp := @(histogram^[c0]^[c1min][c2]);
	for c1 := c1min to c1max do
        begin
	  if (histp^ <> 0) then
          begin
	    c2max := c2;
	    boxp.c2max := c2max;
	    goto have_c2max;
	  end;
          Inc(histp, HIST_C2_ELEMS);
        end;
      end;
 have_c2max:

  { Update box volume.
    We use 2-norm rather than real volume here; this biases the method
    against making long narrow boxes, and it has the side benefit that
    a box is splittable iff norm > 0.
    Since the differences are expressed in histogram-cell units,
    we have to shift back to JSAMPLE units to get consistent distances;
    after which, we scale according to the selected distance scale factors.}

  dist0 := ((c0max - c0min) shl C0_SHIFT) * C0_SCALE;
  dist1 := ((c1max - c1min) shl C1_SHIFT) * C1_SCALE;
  dist2 := ((c2max - c2min) shl C2_SHIFT) * C2_SCALE;
  boxp.volume := dist0*dist0 + dist1*dist1 + dist2*dist2;

  { Now scan remaining volume of box and compute population }
  ccount := 0;
  for c0 := c0min to c0max do
    for c1 := c1min to c1max do
    begin
      histp := @(histogram^[c0]^[c1][c2min]);
      for c2 := c2min to c2max do
      begin
	if (histp^ <> 0) then
	  Inc(ccount);
        Inc(histp);
      end;
    end;
  boxp.colorcount := ccount;
end;


{LOCAL}
function median_cut (cinfo : j_decompress_ptr; boxlist : boxlistptr;
                     numboxes : int; desired_colors : int) : int;
{ Repeatedly select and split the largest box until we have enough boxes }
var
  n,lb : int;
  c0,c1,c2,cmax : int;
  {register} b1,b2 : boxptr;
begin
  while (numboxes < desired_colors) do
  begin
    { Select box to split.
      Current algorithm: by population for first half, then by volume. }

    if (numboxes*2 <= desired_colors) then
      b1 := find_biggest_color_pop(boxlist, numboxes)
    else
      b1 := find_biggest_volume(boxlist, numboxes);

    if (b1 = NIL) then          { no splittable boxes left! }
      break;
    b2 := @(boxlist^[numboxes]);	{ where new box will go }
    { Copy the color bounds to the new box. }
    b2^.c0max := b1^.c0max; b2^.c1max := b1^.c1max; b2^.c2max := b1^.c2max;
    b2^.c0min := b1^.c0min; b2^.c1min := b1^.c1min; b2^.c2min := b1^.c2min;
    { Choose which axis to split the box on.
      Current algorithm: longest scaled axis.
      See notes in update_box about scaling distances. }

    c0 := ((b1^.c0max - b1^.c0min) shl C0_SHIFT) * C0_SCALE;
    c1 := ((b1^.c1max - b1^.c1min) shl C1_SHIFT) * C1_SCALE;
    c2 := ((b1^.c2max - b1^.c2min) shl C2_SHIFT) * C2_SCALE;
    { We want to break any ties in favor of green, then red, blue last.
      This code does the right thing for R,G,B or B,G,R color orders only. }

{$ifdef RGB_RED_IS_0}
    cmax := c1; n := 1;
    if (c0 > cmax) then
    begin
      cmax := c0;
      n := 0;
    end;
    if (c2 > cmax) then
      n := 2;
{$else}
    cmax := c1;
    n := 1;
    if (c2 > cmax) then
    begin
      cmax := c2;
      n := 2;
    end;
    if (c0 > cmax) then
      n := 0;
{$endif}
    { Choose split point along selected axis, and update box bounds.
      Current algorithm: split at halfway point.
      (Since the box has been shrunk to minimum volume,
      any split will produce two nonempty subboxes.)
      Note that lb value is max for lower box, so must be < old max. }

    case n of
    0:begin
        lb := (b1^.c0max + b1^.c0min) div 2;
        b1^.c0max := lb;
        b2^.c0min := lb+1;
      end;
    1:begin
        lb := (b1^.c1max + b1^.c1min) div 2;
        b1^.c1max := lb;
        b2^.c1min := lb+1;
      end;
    2:begin
        lb := (b1^.c2max + b1^.c2min) div 2;
        b1^.c2max := lb;
        b2^.c2min := lb+1;
      end;
    end;
    { Update stats for boxes }
    update_box(cinfo, b1^);
    update_box(cinfo, b2^);
    Inc(numboxes);
  end;
  median_cut := numboxes;
end;


{LOCAL}
procedure compute_color (cinfo : j_decompress_ptr;
                         const boxp : box; icolor : int);
{ Compute representative color for a box, put it in colormap[icolor] }
var
  { Current algorithm: mean weighted by pixels (not colors) }
  { Note it is important to get the rounding correct! }
  cquantize : my_cquantize_ptr;
  histogram : hist3d;
  histp : histptr;
  c0,c1,c2 : int;
  c0min,c0max,c1min,c1max,c2min,c2max : int;
  count : long;
  total : long;
  c0total : long;
  c1total : long;
  c2total : long;
begin
  cquantize := my_cquantize_ptr(cinfo^.cquantize);
  histogram := cquantize^.histogram;
  total := 0;
  c0total := 0;
  c1total := 0;
  c2total := 0;

  c0min := boxp.c0min;  c0max := boxp.c0max;
  c1min := boxp.c1min;  c1max := boxp.c1max;
  c2min := boxp.c2min;  c2max := boxp.c2max;

  for c0 := c0min to c0max do
    for c1 := c1min to c1max do
    begin
      histp := @(histogram^[c0]^[c1][c2min]);
      for c2 := c2min to c2max do
      begin
	count := histp^;
        Inc(histp);
	if (count <> 0) then
        begin
	  Inc(total, count);
	  Inc(c0total, ((c0 shl C0_SHIFT) + ((1 shl C0_SHIFT) shr 1)) * count);
	  Inc(c1total, ((c1 shl C1_SHIFT) + ((1 shl C1_SHIFT) shr 1)) * count);
	  Inc(c2total, ((c2 shl C2_SHIFT) + ((1 shl C2_SHIFT) shr 1)) * count);
	end;
      end;
    end;

  cinfo^.colormap^[0]^[icolor] := JSAMPLE ((c0total + (total shr 1)) div total);
  cinfo^.colormap^[1]^[icolor] := JSAMPLE ((c1total + (total shr 1)) div total);
  cinfo^.colormap^[2]^[icolor] := JSAMPLE ((c2total + (total shr 1)) div total);
end;


{LOCAL}
procedure select_colors (cinfo : j_decompress_ptr; desired_colors : int);
{ Master routine for color selection }
var
  boxlist : boxlistptr;
  numboxes : int;
  i : int;
begin
  { Allocate workspace for box list }
  boxlist := boxlistptr(cinfo^.mem^.alloc_small(
    j_common_ptr(cinfo), JPOOL_IMAGE, desired_colors * SIZEOF(box)));
  { Initialize one box containing whole space }
  numboxes := 1;
  boxlist^[0].c0min := 0;
  boxlist^[0].c0max := MAXJSAMPLE shr C0_SHIFT;
  boxlist^[0].c1min := 0;
  boxlist^[0].c1max := MAXJSAMPLE shr C1_SHIFT;
  boxlist^[0].c2min := 0;
  boxlist^[0].c2max := MAXJSAMPLE shr C2_SHIFT;
  { Shrink it to actually-used volume and set its statistics }
  update_box(cinfo, boxlist^[0]);
  { Perform median-cut to produce final box list }
  numboxes := median_cut(cinfo, boxlist, numboxes, desired_colors);
  { Compute the representative color for each box, fill colormap }
  for i := 0 to pred(numboxes) do
    compute_color(cinfo, boxlist^[i], i);
  cinfo^.actual_number_of_colors := numboxes;
  TRACEMS1(j_common_ptr(cinfo), 1, JTRC_QUANT_SELECTED, numboxes);
end;


{ These routines are concerned with the time-critical task of mapping input
  colors to the nearest color in the selected colormap.

  We re-use the histogram space as an "inverse color map", essentially a
  cache for the results of nearest-color searches.  All colors within a
  histogram cell will be mapped to the same colormap entry, namely the one
  closest to the cell's center.  This may not be quite the closest entry to
  the actual input color, but it's almost as good.  A zero in the cache
  indicates we haven't found the nearest color for that cell yet; the array
  is cleared to zeroes before starting the mapping pass.  When we find the
  nearest color for a cell, its colormap index plus one is recorded in the
  cache for future use.  The pass2 scanning routines call fill_inverse_cmap
  when they need to use an unfilled entry in the cache.

  Our method of efficiently finding nearest colors is based on the "locally
  sorted search" idea described by Heckbert and on the incremental distance
  calculation described by Spencer W. Thomas in chapter III.1 of Graphics
  Gems II (James Arvo, ed.  Academic Press, 1991).  Thomas points out that
  the distances from a given colormap entry to each cell of the histogram can
  be computed quickly using an incremental method: the differences between
  distances to adjacent cells themselves differ by a constant.  This allows a
  fairly fast implementation of the "brute force" approach of computing the
  distance from every colormap entry to every histogram cell.  Unfortunately,
  it needs a work array to hold the best-distance-so-far for each histogram
  cell (because the inner loop has to be over cells, not colormap entries).
  The work array elements have to be INT32s, so the work array would need
  256Kb at our recommended precision.  This is not feasible in DOS machines.

  To get around these problems, we apply Thomas' method to compute the
  nearest colors for only the cells within a small subbox of the histogram.
  The work array need be only as big as the subbox, so the memory usage
  problem is solved.  Furthermore, we need not fill subboxes that are never
  referenced in pass2; many images use only part of the color gamut, so a
  fair amount of work is saved.  An additional advantage of this
  approach is that we can apply Heckbert's locality criterion to quickly
  eliminate colormap entries that are far away from the subbox; typically
  three-fourths of the colormap entries are rejected by Heckbert's criterion,
  and we need not compute their distances to individual cells in the subbox.
  The speed of this approach is heavily influenced by the subbox size: too
  small means too much overhead, too big loses because Heckbert's criterion
  can't eliminate as many colormap entries.  Empirically the best subbox
  size seems to be about 1/512th of the histogram (1/8th in each direction).

  Thomas' article also describes a refined method which is asymptotically
  faster than the brute-force method, but it is also far more complex and
  cannot efficiently be applied to small subboxes.  It is therefore not
  useful for programs intended to be portable to DOS machines.  On machines
  with plenty of memory, filling the whole histogram in one shot with Thomas'
  refined method might be faster than the present code --- but then again,
  it might not be any faster, and it's certainly more complicated. }



{ log2(histogram cells in update box) for each axis; this can be adjusted }
const
  BOX_C0_LOG = (HIST_C0_BITS-3);
  BOX_C1_LOG = (HIST_C1_BITS-3);
  BOX_C2_LOG = (HIST_C2_BITS-3);

  BOX_C0_ELEMS = (1 shl BOX_C0_LOG); { # of hist cells in update box }
  BOX_C1_ELEMS = (1 shl BOX_C1_LOG);
  BOX_C2_ELEMS = (1 shl BOX_C2_LOG);

  BOX_C0_SHIFT = (C0_SHIFT + BOX_C0_LOG);
  BOX_C1_SHIFT = (C1_SHIFT + BOX_C1_LOG);
  BOX_C2_SHIFT = (C2_SHIFT + BOX_C2_LOG);


{ The next three routines implement inverse colormap filling.  They could
  all be folded into one big routine, but splitting them up this way saves
  some stack space (the mindist[] and bestdist[] arrays need not coexist)
  and may allow some compilers to produce better code by registerizing more
  inner-loop variables. }

{LOCAL}
function find_nearby_colors (cinfo : j_decompress_ptr;
                             minc0 : int; minc1 : int; minc2 : int;
		             var colorlist : array of JSAMPLE) : int;
{ Locate the colormap entries close enough to an update box to be candidates
  for the nearest entry to some cell(s) in the update box.  The update box