DEADSOFTWARE

new code for blood particles (other particles are turned off temporarily): almost...
[d2df-sdl.git] / src / lib / vampimg / JpegLib / imjquant2.pas
1 unit imjquant2;
4 { This file contains 2-pass color quantization (color mapping) routines.
5 These routines provide selection of a custom color map for an image,
6 followed by mapping of the image to that color map, with optional
7 Floyd-Steinberg dithering.
8 It is also possible to use just the second pass to map to an arbitrary
9 externally-given color map.
11 Note: ordered dithering is not supported, since there isn't any fast
12 way to compute intercolor distances; it's unclear that ordered dither's
13 fundamental assumptions even hold with an irregularly spaced color map. }
15 { Original: jquant2.c; Copyright (C) 1991-1996, Thomas G. Lane. }
17 interface
19 {$I imjconfig.inc}
21 uses
22 imjmorecfg,
23 imjdeferr,
24 imjerror,
25 imjutils,
26 imjpeglib;
28 { Module initialization routine for 2-pass color quantization. }
31 {GLOBAL}
32 procedure jinit_2pass_quantizer (cinfo : j_decompress_ptr);
34 implementation
36 { This module implements the well-known Heckbert paradigm for color
37 quantization. Most of the ideas used here can be traced back to
38 Heckbert's seminal paper
39 Heckbert, Paul. "Color Image Quantization for Frame Buffer Display",
40 Proc. SIGGRAPH '82, Computer Graphics v.16 #3 (July 1982), pp 297-304.
42 In the first pass over the image, we accumulate a histogram showing the
43 usage count of each possible color. To keep the histogram to a reasonable
44 size, we reduce the precision of the input; typical practice is to retain
45 5 or 6 bits per color, so that 8 or 4 different input values are counted
46 in the same histogram cell.
48 Next, the color-selection step begins with a box representing the whole
49 color space, and repeatedly splits the "largest" remaining box until we
50 have as many boxes as desired colors. Then the mean color in each
51 remaining box becomes one of the possible output colors.
53 The second pass over the image maps each input pixel to the closest output
54 color (optionally after applying a Floyd-Steinberg dithering correction).
55 This mapping is logically trivial, but making it go fast enough requires
56 considerable care.
58 Heckbert-style quantizers vary a good deal in their policies for choosing
59 the "largest" box and deciding where to cut it. The particular policies
60 used here have proved out well in experimental comparisons, but better ones
61 may yet be found.
63 In earlier versions of the IJG code, this module quantized in YCbCr color
64 space, processing the raw upsampled data without a color conversion step.
65 This allowed the color conversion math to be done only once per colormap
66 entry, not once per pixel. However, that optimization precluded other
67 useful optimizations (such as merging color conversion with upsampling)
68 and it also interfered with desired capabilities such as quantizing to an
69 externally-supplied colormap. We have therefore abandoned that approach.
70 The present code works in the post-conversion color space, typically RGB.
72 To improve the visual quality of the results, we actually work in scaled
73 RGB space, giving G distances more weight than R, and R in turn more than
74 B. To do everything in integer math, we must use integer scale factors.
75 The 2/3/1 scale factors used here correspond loosely to the relative
76 weights of the colors in the NTSC grayscale equation.
77 If you want to use this code to quantize a non-RGB color space, you'll
78 probably need to change these scale factors. }
80 const
81 R_SCALE = 2; { scale R distances by this much }
82 G_SCALE = 3; { scale G distances by this much }
83 B_SCALE = 1; { and B by this much }
85 { Relabel R/G/B as components 0/1/2, respecting the RGB ordering defined
86 in jmorecfg.h. As the code stands, it will do the right thing for R,G,B
87 and B,G,R orders. If you define some other weird order in jmorecfg.h,
88 you'll get compile errors until you extend this logic. In that case
89 you'll probably want to tweak the histogram sizes too. }
91 {$ifdef RGB_RED_IS_0}
92 const
93 C0_SCALE = R_SCALE;
94 C1_SCALE = G_SCALE;
95 C2_SCALE = B_SCALE;
96 {$else}
97 const
98 C0_SCALE = B_SCALE;
99 C1_SCALE = G_SCALE;
100 C2_SCALE = R_SCALE;
101 {$endif}
104 { First we have the histogram data structure and routines for creating it.
106 The number of bits of precision can be adjusted by changing these symbols.
107 We recommend keeping 6 bits for G and 5 each for R and B.
108 If you have plenty of memory and cycles, 6 bits all around gives marginally
109 better results; if you are short of memory, 5 bits all around will save
110 some space but degrade the results.
111 To maintain a fully accurate histogram, we'd need to allocate a "long"
112 (preferably unsigned long) for each cell. In practice this is overkill;
113 we can get by with 16 bits per cell. Few of the cell counts will overflow,
114 and clamping those that do overflow to the maximum value will give close-
115 enough results. This reduces the recommended histogram size from 256Kb
116 to 128Kb, which is a useful savings on PC-class machines.
117 (In the second pass the histogram space is re-used for pixel mapping data;
118 in that capacity, each cell must be able to store zero to the number of
119 desired colors. 16 bits/cell is plenty for that too.)
120 Since the JPEG code is intended to run in small memory model on 80x86
121 machines, we can't just allocate the histogram in one chunk. Instead
122 of a true 3-D array, we use a row of pointers to 2-D arrays. Each
123 pointer corresponds to a C0 value (typically 2^5 = 32 pointers) and
124 each 2-D array has 2^6*2^5 = 2048 or 2^6*2^6 = 4096 entries. Note that
125 on 80x86 machines, the pointer row is in near memory but the actual
126 arrays are in far memory (same arrangement as we use for image arrays). }
129 const
130 MAXNUMCOLORS = (MAXJSAMPLE+1); { maximum size of colormap }
132 { These will do the right thing for either R,G,B or B,G,R color order,
133 but you may not like the results for other color orders. }
135 const
136 HIST_C0_BITS = 5; { bits of precision in R/B histogram }
137 HIST_C1_BITS = 6; { bits of precision in G histogram }
138 HIST_C2_BITS = 5; { bits of precision in B/R histogram }
140 { Number of elements along histogram axes. }
141 const
142 HIST_C0_ELEMS = (1 shl HIST_C0_BITS);
143 HIST_C1_ELEMS = (1 shl HIST_C1_BITS);
144 HIST_C2_ELEMS = (1 shl HIST_C2_BITS);
146 { These are the amounts to shift an input value to get a histogram index. }
147 const
148 C0_SHIFT = (BITS_IN_JSAMPLE-HIST_C0_BITS);
149 C1_SHIFT = (BITS_IN_JSAMPLE-HIST_C1_BITS);
150 C2_SHIFT = (BITS_IN_JSAMPLE-HIST_C2_BITS);
153 type { Nomssi }
154 RGBptr = ^RGBtype;
155 RGBtype = packed record
156 r,g,b : JSAMPLE;
157 end;
158 type
159 histcell = UINT16; { histogram cell; prefer an unsigned type }
161 type
162 histptr = ^histcell {FAR}; { for pointers to histogram cells }
164 type
165 hist1d = array[0..HIST_C2_ELEMS-1] of histcell; { typedefs for the array }
166 {hist1d_ptr = ^hist1d;}
167 hist1d_field = array[0..HIST_C1_ELEMS-1] of hist1d;
168 { type for the 2nd-level pointers }
169 hist2d = ^hist1d_field;
170 hist2d_field = array[0..HIST_C0_ELEMS-1] of hist2d;
171 hist3d = ^hist2d_field; { type for top-level pointer }
174 { Declarations for Floyd-Steinberg dithering.
176 Errors are accumulated into the array fserrors[], at a resolution of
177 1/16th of a pixel count. The error at a given pixel is propagated
178 to its not-yet-processed neighbors using the standard F-S fractions,
179 ... (here) 7/16
180 3/16 5/16 1/16
181 We work left-to-right on even rows, right-to-left on odd rows.
183 We can get away with a single array (holding one row's worth of errors)
184 by using it to store the current row's errors at pixel columns not yet
185 processed, but the next row's errors at columns already processed. We
186 need only a few extra variables to hold the errors immediately around the
187 current column. (If we are lucky, those variables are in registers, but
188 even if not, they're probably cheaper to access than array elements are.)
190 The fserrors[] array has (#columns + 2) entries; the extra entry at
191 each end saves us from special-casing the first and last pixels.
192 Each entry is three values long, one value for each color component.
194 Note: on a wide image, we might not have enough room in a PC's near data
195 segment to hold the error array; so it is allocated with alloc_large. }
198 {$ifdef BITS_IN_JSAMPLE_IS_8}
199 type
200 FSERROR = INT16; { 16 bits should be enough }
201 LOCFSERROR = int; { use 'int' for calculation temps }
202 {$else}
203 type
204 FSERROR = INT32; { may need more than 16 bits }
205 LOCFSERROR = INT32; { be sure calculation temps are big enough }
206 {$endif}
207 type { Nomssi }
208 RGB_FSERROR_PTR = ^RGB_FSERROR;
209 RGB_FSERROR = packed record
210 r,g,b : FSERROR;
211 end;
212 LOCRGB_FSERROR = packed record
213 r,g,b : LOCFSERROR;
214 end;
216 type
217 FSERROR_PTR = ^FSERROR;
218 jFSError = 0..(MaxInt div SIZEOF(RGB_FSERROR))-1;
219 FS_ERROR_FIELD = array[jFSError] of RGB_FSERROR;
220 FS_ERROR_FIELD_PTR = ^FS_ERROR_FIELD;{far}
221 { pointer to error array (in FAR storage!) }
223 type
224 error_limit_array = array[-MAXJSAMPLE..MAXJSAMPLE] of int;
225 { table for clamping the applied error }
226 error_limit_ptr = ^error_limit_array;
228 { Private subobject }
229 type
230 my_cquantize_ptr = ^my_cquantizer;
231 my_cquantizer = record
232 pub : jpeg_color_quantizer; { public fields }
234 { Space for the eventually created colormap is stashed here }
235 sv_colormap : JSAMPARRAY; { colormap allocated at init time }
236 desired : int; { desired # of colors = size of colormap }
238 { Variables for accumulating image statistics }
239 histogram : hist3d; { pointer to the histogram }
241 needs_zeroed : boolean; { TRUE if next pass must zero histogram }
243 { Variables for Floyd-Steinberg dithering }
244 fserrors : FS_ERROR_FIELD_PTR; { accumulated errors }
245 on_odd_row : boolean; { flag to remember which row we are on }
246 error_limiter : error_limit_ptr; { table for clamping the applied error }
247 end;
251 { Prescan some rows of pixels.
252 In this module the prescan simply updates the histogram, which has been
253 initialized to zeroes by start_pass.
254 An output_buf parameter is required by the method signature, but no data
255 is actually output (in fact the buffer controller is probably passing a
256 NIL pointer). }
258 {METHODDEF}
259 procedure prescan_quantize (cinfo : j_decompress_ptr;
260 input_buf : JSAMPARRAY;
261 output_buf : JSAMPARRAY;
262 num_rows : int);
263 var
264 cquantize : my_cquantize_ptr;
265 {register} ptr : RGBptr;
266 {register} histp : histptr;
267 {register} histogram : hist3d;
268 row : int;
269 col : JDIMENSION;
270 width : JDIMENSION;
271 begin
272 cquantize := my_cquantize_ptr(cinfo^.cquantize);
273 histogram := cquantize^.histogram;
274 width := cinfo^.output_width;
276 for row := 0 to pred(num_rows) do
277 begin
278 ptr := RGBptr(input_buf^[row]);
279 for col := pred(width) downto 0 do
280 begin
281 { get pixel value and index into the histogram }
282 histp := @(histogram^[GETJSAMPLE(ptr^.r) shr C0_SHIFT]^
283 [GETJSAMPLE(ptr^.g) shr C1_SHIFT]
284 [GETJSAMPLE(ptr^.b) shr C2_SHIFT]);
285 { increment, check for overflow and undo increment if so. }
286 Inc(histp^);
287 if (histp^ <= 0) then
288 Dec(histp^);
289 Inc(ptr);
290 end;
291 end;
292 end;
294 { Next we have the really interesting routines: selection of a colormap
295 given the completed histogram.
296 These routines work with a list of "boxes", each representing a rectangular
297 subset of the input color space (to histogram precision). }
299 type
300 box = record
301 { The bounds of the box (inclusive); expressed as histogram indexes }
302 c0min, c0max : int;
303 c1min, c1max : int;
304 c2min, c2max : int;
305 { The volume (actually 2-norm) of the box }
306 volume : INT32;
307 { The number of nonzero histogram cells within this box }
308 colorcount : long;
309 end;
311 type
312 jBoxList = 0..(MaxInt div SizeOf(box))-1;
313 box_field = array[jBoxlist] of box;
314 boxlistptr = ^box_field;
315 boxptr = ^box;
317 {LOCAL}
318 function find_biggest_color_pop (boxlist : boxlistptr; numboxes : int) : boxptr;
319 { Find the splittable box with the largest color population }
320 { Returns NIL if no splittable boxes remain }
321 var
322 boxp : boxptr ; {register}
323 i : int; {register}
324 maxc : long; {register}
325 which : boxptr;
326 begin
327 which := NIL;
328 boxp := @(boxlist^[0]);
329 maxc := 0;
330 for i := 0 to pred(numboxes) do
331 begin
332 if (boxp^.colorcount > maxc) and (boxp^.volume > 0) then
333 begin
334 which := boxp;
335 maxc := boxp^.colorcount;
336 end;
337 Inc(boxp);
338 end;
339 find_biggest_color_pop := which;
340 end;
343 {LOCAL}
344 function find_biggest_volume (boxlist : boxlistptr; numboxes : int) : boxptr;
345 { Find the splittable box with the largest (scaled) volume }
346 { Returns NULL if no splittable boxes remain }
347 var
348 {register} boxp : boxptr;
349 {register} i : int;
350 {register} maxv : INT32;
351 which : boxptr;
352 begin
353 maxv := 0;
354 which := NIL;
355 boxp := @(boxlist^[0]);
356 for i := 0 to pred(numboxes) do
357 begin
358 if (boxp^.volume > maxv) then
359 begin
360 which := boxp;
361 maxv := boxp^.volume;
362 end;
363 Inc(boxp);
364 end;
365 find_biggest_volume := which;
366 end;
369 {LOCAL}
370 procedure update_box (cinfo : j_decompress_ptr; var boxp : box);
371 label
372 have_c0min, have_c0max,
373 have_c1min, have_c1max,
374 have_c2min, have_c2max;
375 { Shrink the min/max bounds of a box to enclose only nonzero elements, }
376 { and recompute its volume and population }
377 var
378 cquantize : my_cquantize_ptr;
379 histogram : hist3d;
380 histp : histptr;
381 c0,c1,c2 : int;
382 c0min,c0max,c1min,c1max,c2min,c2max : int;
383 dist0,dist1,dist2 : INT32;
384 ccount : long;
385 begin
386 cquantize := my_cquantize_ptr(cinfo^.cquantize);
387 histogram := cquantize^.histogram;
389 c0min := boxp.c0min; c0max := boxp.c0max;
390 c1min := boxp.c1min; c1max := boxp.c1max;
391 c2min := boxp.c2min; c2max := boxp.c2max;
393 if (c0max > c0min) then
394 for c0 := c0min to c0max do
395 for c1 := c1min to c1max do
396 begin
397 histp := @(histogram^[c0]^[c1][c2min]);
398 for c2 := c2min to c2max do
399 begin
400 if (histp^ <> 0) then
401 begin
402 c0min := c0;
403 boxp.c0min := c0min;
404 goto have_c0min;
405 end;
406 Inc(histp);
407 end;
408 end;
409 have_c0min:
410 if (c0max > c0min) then
411 for c0 := c0max downto c0min do
412 for c1 := c1min to c1max do
413 begin
414 histp := @(histogram^[c0]^[c1][c2min]);
415 for c2 := c2min to c2max do
416 begin
417 if ( histp^ <> 0) then
418 begin
419 c0max := c0;
420 boxp.c0max := c0;
421 goto have_c0max;
422 end;
423 Inc(histp);
424 end;
425 end;
426 have_c0max:
427 if (c1max > c1min) then
428 for c1 := c1min to c1max do
429 for c0 := c0min to c0max do
430 begin
431 histp := @(histogram^[c0]^[c1][c2min]);
432 for c2 := c2min to c2max do
433 begin
434 if (histp^ <> 0) then
435 begin
436 c1min := c1;
437 boxp.c1min := c1;
438 goto have_c1min;
439 end;
440 Inc(histp);
441 end;
442 end;
443 have_c1min:
444 if (c1max > c1min) then
445 for c1 := c1max downto c1min do
446 for c0 := c0min to c0max do
447 begin
448 histp := @(histogram^[c0]^[c1][c2min]);
449 for c2 := c2min to c2max do
450 begin
451 if (histp^ <> 0) then
452 begin
453 c1max := c1;
454 boxp.c1max := c1;
455 goto have_c1max;
456 end;
457 Inc(histp);
458 end;
459 end;
460 have_c1max:
461 if (c2max > c2min) then
462 for c2 := c2min to c2max do
463 for c0 := c0min to c0max do
464 begin
465 histp := @(histogram^[c0]^[c1min][c2]);
466 for c1 := c1min to c1max do
467 begin
468 if (histp^ <> 0) then
469 begin
470 c2min := c2;
471 boxp.c2min := c2min;
472 goto have_c2min;
473 end;
474 Inc(histp, HIST_C2_ELEMS);
475 end;
476 end;
477 have_c2min:
478 if (c2max > c2min) then
479 for c2 := c2max downto c2min do
480 for c0 := c0min to c0max do
481 begin
482 histp := @(histogram^[c0]^[c1min][c2]);
483 for c1 := c1min to c1max do
484 begin
485 if (histp^ <> 0) then
486 begin
487 c2max := c2;
488 boxp.c2max := c2max;
489 goto have_c2max;
490 end;
491 Inc(histp, HIST_C2_ELEMS);
492 end;
493 end;
494 have_c2max:
496 { Update box volume.
497 We use 2-norm rather than real volume here; this biases the method
498 against making long narrow boxes, and it has the side benefit that
499 a box is splittable iff norm > 0.
500 Since the differences are expressed in histogram-cell units,
501 we have to shift back to JSAMPLE units to get consistent distances;
502 after which, we scale according to the selected distance scale factors.}
504 dist0 := ((c0max - c0min) shl C0_SHIFT) * C0_SCALE;
505 dist1 := ((c1max - c1min) shl C1_SHIFT) * C1_SCALE;
506 dist2 := ((c2max - c2min) shl C2_SHIFT) * C2_SCALE;
507 boxp.volume := dist0*dist0 + dist1*dist1 + dist2*dist2;
509 { Now scan remaining volume of box and compute population }
510 ccount := 0;
511 for c0 := c0min to c0max do
512 for c1 := c1min to c1max do
513 begin
514 histp := @(histogram^[c0]^[c1][c2min]);
515 for c2 := c2min to c2max do
516 begin
517 if (histp^ <> 0) then
518 Inc(ccount);
519 Inc(histp);
520 end;
521 end;
522 boxp.colorcount := ccount;
523 end;
526 {LOCAL}
527 function median_cut (cinfo : j_decompress_ptr; boxlist : boxlistptr;
528 numboxes : int; desired_colors : int) : int;
529 { Repeatedly select and split the largest box until we have enough boxes }
530 var
531 n,lb : int;
532 c0,c1,c2,cmax : int;
533 {register} b1,b2 : boxptr;
534 begin
535 while (numboxes < desired_colors) do
536 begin
537 { Select box to split.
538 Current algorithm: by population for first half, then by volume. }
540 if (numboxes*2 <= desired_colors) then
541 b1 := find_biggest_color_pop(boxlist, numboxes)
542 else
543 b1 := find_biggest_volume(boxlist, numboxes);
545 if (b1 = NIL) then { no splittable boxes left! }
546 break;
547 b2 := @(boxlist^[numboxes]); { where new box will go }
548 { Copy the color bounds to the new box. }
549 b2^.c0max := b1^.c0max; b2^.c1max := b1^.c1max; b2^.c2max := b1^.c2max;
550 b2^.c0min := b1^.c0min; b2^.c1min := b1^.c1min; b2^.c2min := b1^.c2min;
551 { Choose which axis to split the box on.
552 Current algorithm: longest scaled axis.
553 See notes in update_box about scaling distances. }
555 c0 := ((b1^.c0max - b1^.c0min) shl C0_SHIFT) * C0_SCALE;
556 c1 := ((b1^.c1max - b1^.c1min) shl C1_SHIFT) * C1_SCALE;
557 c2 := ((b1^.c2max - b1^.c2min) shl C2_SHIFT) * C2_SCALE;
558 { We want to break any ties in favor of green, then red, blue last.
559 This code does the right thing for R,G,B or B,G,R color orders only. }
561 {$ifdef RGB_RED_IS_0}
562 cmax := c1; n := 1;
563 if (c0 > cmax) then
564 begin
565 cmax := c0;
566 n := 0;
567 end;
568 if (c2 > cmax) then
569 n := 2;
570 {$else}
571 cmax := c1;
572 n := 1;
573 if (c2 > cmax) then
574 begin
575 cmax := c2;
576 n := 2;
577 end;
578 if (c0 > cmax) then
579 n := 0;
580 {$endif}
581 { Choose split point along selected axis, and update box bounds.
582 Current algorithm: split at halfway point.
583 (Since the box has been shrunk to minimum volume,
584 any split will produce two nonempty subboxes.)
585 Note that lb value is max for lower box, so must be < old max. }
587 case n of
588 0:begin
589 lb := (b1^.c0max + b1^.c0min) div 2;
590 b1^.c0max := lb;
591 b2^.c0min := lb+1;
592 end;
593 1:begin
594 lb := (b1^.c1max + b1^.c1min) div 2;
595 b1^.c1max := lb;
596 b2^.c1min := lb+1;
597 end;
598 2:begin
599 lb := (b1^.c2max + b1^.c2min) div 2;
600 b1^.c2max := lb;
601 b2^.c2min := lb+1;
602 end;
603 end;
604 { Update stats for boxes }
605 update_box(cinfo, b1^);
606 update_box(cinfo, b2^);
607 Inc(numboxes);
608 end;
609 median_cut := numboxes;
610 end;
613 {LOCAL}
614 procedure compute_color (cinfo : j_decompress_ptr;
615 const boxp : box; icolor : int);
616 { Compute representative color for a box, put it in colormap[icolor] }
617 var
618 { Current algorithm: mean weighted by pixels (not colors) }
619 { Note it is important to get the rounding correct! }
620 cquantize : my_cquantize_ptr;
621 histogram : hist3d;
622 histp : histptr;
623 c0,c1,c2 : int;
624 c0min,c0max,c1min,c1max,c2min,c2max : int;
625 count : long;
626 total : long;
627 c0total : long;
628 c1total : long;
629 c2total : long;
630 begin
631 cquantize := my_cquantize_ptr(cinfo^.cquantize);
632 histogram := cquantize^.histogram;
633 total := 0;
634 c0total := 0;
635 c1total := 0;
636 c2total := 0;
638 c0min := boxp.c0min; c0max := boxp.c0max;
639 c1min := boxp.c1min; c1max := boxp.c1max;
640 c2min := boxp.c2min; c2max := boxp.c2max;
642 for c0 := c0min to c0max do
643 for c1 := c1min to c1max do
644 begin
645 histp := @(histogram^[c0]^[c1][c2min]);
646 for c2 := c2min to c2max do
647 begin
648 count := histp^;
649 Inc(histp);
650 if (count <> 0) then
651 begin
652 Inc(total, count);
653 Inc(c0total, ((c0 shl C0_SHIFT) + ((1 shl C0_SHIFT) shr 1)) * count);
654 Inc(c1total, ((c1 shl C1_SHIFT) + ((1 shl C1_SHIFT) shr 1)) * count);
655 Inc(c2total, ((c2 shl C2_SHIFT) + ((1 shl C2_SHIFT) shr 1)) * count);
656 end;
657 end;
658 end;
660 cinfo^.colormap^[0]^[icolor] := JSAMPLE ((c0total + (total shr 1)) div total);
661 cinfo^.colormap^[1]^[icolor] := JSAMPLE ((c1total + (total shr 1)) div total);
662 cinfo^.colormap^[2]^[icolor] := JSAMPLE ((c2total + (total shr 1)) div total);
663 end;
666 {LOCAL}
667 procedure select_colors (cinfo : j_decompress_ptr; desired_colors : int);
668 { Master routine for color selection }
669 var
670 boxlist : boxlistptr;
671 numboxes : int;
672 i : int;
673 begin
674 { Allocate workspace for box list }
675 boxlist := boxlistptr(cinfo^.mem^.alloc_small(
676 j_common_ptr(cinfo), JPOOL_IMAGE, desired_colors * SIZEOF(box)));
677 { Initialize one box containing whole space }
678 numboxes := 1;
679 boxlist^[0].c0min := 0;
680 boxlist^[0].c0max := MAXJSAMPLE shr C0_SHIFT;
681 boxlist^[0].c1min := 0;
682 boxlist^[0].c1max := MAXJSAMPLE shr C1_SHIFT;
683 boxlist^[0].c2min := 0;
684 boxlist^[0].c2max := MAXJSAMPLE shr C2_SHIFT;
685 { Shrink it to actually-used volume and set its statistics }
686 update_box(cinfo, boxlist^[0]);
687 { Perform median-cut to produce final box list }
688 numboxes := median_cut(cinfo, boxlist, numboxes, desired_colors);
689 { Compute the representative color for each box, fill colormap }
690 for i := 0 to pred(numboxes) do
691 compute_color(cinfo, boxlist^[i], i);
692 cinfo^.actual_number_of_colors := numboxes;
693 {$IFDEF DEBUG}
694 TRACEMS1(j_common_ptr(cinfo), 1, JTRC_QUANT_SELECTED, numboxes);
695 {$ENDIF}
696 end;
699 { These routines are concerned with the time-critical task of mapping input
700 colors to the nearest color in the selected colormap.
702 We re-use the histogram space as an "inverse color map", essentially a
703 cache for the results of nearest-color searches. All colors within a
704 histogram cell will be mapped to the same colormap entry, namely the one
705 closest to the cell's center. This may not be quite the closest entry to
706 the actual input color, but it's almost as good. A zero in the cache
707 indicates we haven't found the nearest color for that cell yet; the array
708 is cleared to zeroes before starting the mapping pass. When we find the
709 nearest color for a cell, its colormap index plus one is recorded in the
710 cache for future use. The pass2 scanning routines call fill_inverse_cmap
711 when they need to use an unfilled entry in the cache.
713 Our method of efficiently finding nearest colors is based on the "locally
714 sorted search" idea described by Heckbert and on the incremental distance
715 calculation described by Spencer W. Thomas in chapter III.1 of Graphics
716 Gems II (James Arvo, ed. Academic Press, 1991). Thomas points out that
717 the distances from a given colormap entry to each cell of the histogram can
718 be computed quickly using an incremental method: the differences between
719 distances to adjacent cells themselves differ by a constant. This allows a
720 fairly fast implementation of the "brute force" approach of computing the
721 distance from every colormap entry to every histogram cell. Unfortunately,
722 it needs a work array to hold the best-distance-so-far for each histogram
723 cell (because the inner loop has to be over cells, not colormap entries).
724 The work array elements have to be INT32s, so the work array would need
725 256Kb at our recommended precision. This is not feasible in DOS machines.
727 To get around these problems, we apply Thomas' method to compute the
728 nearest colors for only the cells within a small subbox of the histogram.
729 The work array need be only as big as the subbox, so the memory usage
730 problem is solved. Furthermore, we need not fill subboxes that are never
731 referenced in pass2; many images use only part of the color gamut, so a
732 fair amount of work is saved. An additional advantage of this
733 approach is that we can apply Heckbert's locality criterion to quickly
734 eliminate colormap entries that are far away from the subbox; typically
735 three-fourths of the colormap entries are rejected by Heckbert's criterion,
736 and we need not compute their distances to individual cells in the subbox.
737 The speed of this approach is heavily influenced by the subbox size: too
738 small means too much overhead, too big loses because Heckbert's criterion
739 can't eliminate as many colormap entries. Empirically the best subbox
740 size seems to be about 1/512th of the histogram (1/8th in each direction).
742 Thomas' article also describes a refined method which is asymptotically
743 faster than the brute-force method, but it is also far more complex and
744 cannot efficiently be applied to small subboxes. It is therefore not
745 useful for programs intended to be portable to DOS machines. On machines
746 with plenty of memory, filling the whole histogram in one shot with Thomas'
747 refined method might be faster than the present code --- but then again,
748 it might not be any faster, and it's certainly more complicated. }
752 { log2(histogram cells in update box) for each axis; this can be adjusted }
753 const
754 BOX_C0_LOG = (HIST_C0_BITS-3);
755 BOX_C1_LOG = (HIST_C1_BITS-3);
756 BOX_C2_LOG = (HIST_C2_BITS-3);
758 BOX_C0_ELEMS = (1 shl BOX_C0_LOG); { # of hist cells in update box }
759 BOX_C1_ELEMS = (1 shl BOX_C1_LOG);
760 BOX_C2_ELEMS = (1 shl BOX_C2_LOG);
762 BOX_C0_SHIFT = (C0_SHIFT + BOX_C0_LOG);
763 BOX_C1_SHIFT = (C1_SHIFT + BOX_C1_LOG);
764 BOX_C2_SHIFT = (C2_SHIFT + BOX_C2_LOG);
767 { The next three routines implement inverse colormap filling. They could
768 all be folded into one big routine, but splitting them up this way saves
769 some stack space (the mindist[] and bestdist[] arrays need not coexist)
770 and may allow some compilers to produce better code by registerizing more
771 inner-loop variables. }
773 {LOCAL}
774 function find_nearby_colors (cinfo : j_decompress_ptr;
775 minc0 : int; minc1 : int; minc2 : int;
776 var colorlist : array of JSAMPLE) : int;
777 { Locate the colormap entries close enough to an update box to be candidates
778 for the nearest entry to some cell(s) in the update box. The update box
779 is specified by the center coordinates of its first cell. The number of
780 candidate colormap entries is returned, and their colormap indexes are
781 placed in colorlist[].
782 This routine uses Heckbert's "locally sorted search" criterion to select
783 the colors that need further consideration. }
785 var
786 numcolors : int;
787 maxc0, maxc1, maxc2 : int;
788 centerc0, centerc1, centerc2 : int;
789 i, x, ncolors : int;
790 minmaxdist, min_dist, max_dist, tdist : INT32;
791 mindist : array[0..MAXNUMCOLORS-1] of INT32;
792 { min distance to colormap entry i }
793 begin
794 numcolors := cinfo^.actual_number_of_colors;
796 { Compute true coordinates of update box's upper corner and center.
797 Actually we compute the coordinates of the center of the upper-corner
798 histogram cell, which are the upper bounds of the volume we care about.
799 Note that since ">>" rounds down, the "center" values may be closer to
800 min than to max; hence comparisons to them must be "<=", not "<". }
802 maxc0 := minc0 + ((1 shl BOX_C0_SHIFT) - (1 shl C0_SHIFT));
803 centerc0 := (minc0 + maxc0) shr 1;
804 maxc1 := minc1 + ((1 shl BOX_C1_SHIFT) - (1 shl C1_SHIFT));
805 centerc1 := (minc1 + maxc1) shr 1;
806 maxc2 := minc2 + ((1 shl BOX_C2_SHIFT) - (1 shl C2_SHIFT));
807 centerc2 := (minc2 + maxc2) shr 1;
809 { For each color in colormap, find:
810 1. its minimum squared-distance to any point in the update box
811 (zero if color is within update box);
812 2. its maximum squared-distance to any point in the update box.
813 Both of these can be found by considering only the corners of the box.
814 We save the minimum distance for each color in mindist[];
815 only the smallest maximum distance is of interest. }
817 minmaxdist := long($7FFFFFFF);
819 for i := 0 to pred(numcolors) do
820 begin
821 { We compute the squared-c0-distance term, then add in the other two. }
822 x := GETJSAMPLE(cinfo^.colormap^[0]^[i]);
823 if (x < minc0) then
824 begin
825 tdist := (x - minc0) * C0_SCALE;
826 min_dist := tdist*tdist;
827 tdist := (x - maxc0) * C0_SCALE;
828 max_dist := tdist*tdist;
829 end
830 else
831 if (x > maxc0) then
832 begin
833 tdist := (x - maxc0) * C0_SCALE;
834 min_dist := tdist*tdist;
835 tdist := (x - minc0) * C0_SCALE;
836 max_dist := tdist*tdist;
837 end
838 else
839 begin
840 { within cell range so no contribution to min_dist }
841 min_dist := 0;
842 if (x <= centerc0) then
843 begin
844 tdist := (x - maxc0) * C0_SCALE;
845 max_dist := tdist*tdist;
846 end
847 else
848 begin
849 tdist := (x - minc0) * C0_SCALE;
850 max_dist := tdist*tdist;
851 end;
852 end;
854 x := GETJSAMPLE(cinfo^.colormap^[1]^[i]);
855 if (x < minc1) then
856 begin
857 tdist := (x - minc1) * C1_SCALE;
858 Inc(min_dist, tdist*tdist);
859 tdist := (x - maxc1) * C1_SCALE;
860 Inc(max_dist, tdist*tdist);
861 end
862 else
863 if (x > maxc1) then
864 begin
865 tdist := (x - maxc1) * C1_SCALE;
866 Inc(min_dist, tdist*tdist);
867 tdist := (x - minc1) * C1_SCALE;
868 Inc(max_dist, tdist*tdist);
869 end
870 else
871 begin
872 { within cell range so no contribution to min_dist }
873 if (x <= centerc1) then
874 begin
875 tdist := (x - maxc1) * C1_SCALE;
876 Inc(max_dist, tdist*tdist);
877 end
878 else
879 begin
880 tdist := (x - minc1) * C1_SCALE;
881 Inc(max_dist, tdist*tdist);
882 end
883 end;
885 x := GETJSAMPLE(cinfo^.colormap^[2]^[i]);
886 if (x < minc2) then
887 begin
888 tdist := (x - minc2) * C2_SCALE;
889 Inc(min_dist, tdist*tdist);
890 tdist := (x - maxc2) * C2_SCALE;
891 Inc(max_dist, tdist*tdist);
892 end
893 else
894 if (x > maxc2) then
895 begin
896 tdist := (x - maxc2) * C2_SCALE;
897 Inc(min_dist, tdist*tdist);
898 tdist := (x - minc2) * C2_SCALE;
899 Inc(max_dist, tdist*tdist);
900 end
901 else
902 begin
903 { within cell range so no contribution to min_dist }
904 if (x <= centerc2) then
905 begin
906 tdist := (x - maxc2) * C2_SCALE;
907 Inc(max_dist, tdist*tdist);
908 end
909 else
910 begin
911 tdist := (x - minc2) * C2_SCALE;
912 Inc(max_dist, tdist*tdist);
913 end;
914 end;
916 mindist[i] := min_dist; { save away the results }
917 if (max_dist < minmaxdist) then
918 minmaxdist := max_dist;
919 end;
921 { Now we know that no cell in the update box is more than minmaxdist
922 away from some colormap entry. Therefore, only colors that are
923 within minmaxdist of some part of the box need be considered. }
925 ncolors := 0;
926 for i := 0 to pred(numcolors) do
927 begin
928 if (mindist[i] <= minmaxdist) then
929 begin
930 colorlist[ncolors] := JSAMPLE(i);
931 Inc(ncolors);
932 end;
933 end;
934 find_nearby_colors := ncolors;
935 end;
938 {LOCAL}
939 procedure find_best_colors (cinfo : j_decompress_ptr;
940 minc0 : int; minc1 : int; minc2 : int;
941 numcolors : int;
942 var colorlist : array of JSAMPLE;
943 var bestcolor : array of JSAMPLE);
944 { Find the closest colormap entry for each cell in the update box,
945 given the list of candidate colors prepared by find_nearby_colors.
946 Return the indexes of the closest entries in the bestcolor[] array.
947 This routine uses Thomas' incremental distance calculation method to
948 find the distance from a colormap entry to successive cells in the box. }
949 const
950 { Nominal steps between cell centers ("x" in Thomas article) }
951 STEP_C0 = ((1 shl C0_SHIFT) * C0_SCALE);
952 STEP_C1 = ((1 shl C1_SHIFT) * C1_SCALE);
953 STEP_C2 = ((1 shl C2_SHIFT) * C2_SCALE);
954 var
955 ic0, ic1, ic2 : int;
956 i, icolor : int;
957 {register} bptr : INT32PTR; { pointer into bestdist[] array }
958 cptr : JSAMPLE_PTR; { pointer into bestcolor[] array }
959 dist0, dist1 : INT32; { initial distance values }
960 {register} dist2 : INT32; { current distance in inner loop }
961 xx0, xx1 : INT32; { distance increments }
962 {register} xx2 : INT32;
963 inc0, inc1, inc2 : INT32; { initial values for increments }
964 { This array holds the distance to the nearest-so-far color for each cell }
965 bestdist : array[0..BOX_C0_ELEMS * BOX_C1_ELEMS * BOX_C2_ELEMS-1] of INT32;
966 begin
967 { Initialize best-distance for each cell of the update box }
968 for i := BOX_C0_ELEMS*BOX_C1_ELEMS*BOX_C2_ELEMS-1 downto 0 do
969 bestdist[i] := $7FFFFFFF;
971 { For each color selected by find_nearby_colors,
972 compute its distance to the center of each cell in the box.
973 If that's less than best-so-far, update best distance and color number. }
977 for i := 0 to pred(numcolors) do
978 begin
979 icolor := GETJSAMPLE(colorlist[i]);
980 { Compute (square of) distance from minc0/c1/c2 to this color }
981 inc0 := (minc0 - GETJSAMPLE(cinfo^.colormap^[0]^[icolor])) * C0_SCALE;
982 dist0 := inc0*inc0;
983 inc1 := (minc1 - GETJSAMPLE(cinfo^.colormap^[1]^[icolor])) * C1_SCALE;
984 Inc(dist0, inc1*inc1);
985 inc2 := (minc2 - GETJSAMPLE(cinfo^.colormap^[2]^[icolor])) * C2_SCALE;
986 Inc(dist0, inc2*inc2);
987 { Form the initial difference increments }
988 inc0 := inc0 * (2 * STEP_C0) + STEP_C0 * STEP_C0;
989 inc1 := inc1 * (2 * STEP_C1) + STEP_C1 * STEP_C1;
990 inc2 := inc2 * (2 * STEP_C2) + STEP_C2 * STEP_C2;
991 { Now loop over all cells in box, updating distance per Thomas method }
992 bptr := @bestdist[0];
993 cptr := @bestcolor[0];
994 xx0 := inc0;
995 for ic0 := BOX_C0_ELEMS-1 downto 0 do
996 begin
997 dist1 := dist0;
998 xx1 := inc1;
999 for ic1 := BOX_C1_ELEMS-1 downto 0 do
1000 begin
1001 dist2 := dist1;
1002 xx2 := inc2;
1003 for ic2 := BOX_C2_ELEMS-1 downto 0 do
1004 begin
1005 if (dist2 < bptr^) then
1006 begin
1007 bptr^ := dist2;
1008 cptr^ := JSAMPLE (icolor);
1009 end;
1010 Inc(dist2, xx2);
1011 Inc(xx2, 2 * STEP_C2 * STEP_C2);
1012 Inc(bptr);
1013 Inc(cptr);
1014 end;
1015 Inc(dist1, xx1);
1016 Inc(xx1, 2 * STEP_C1 * STEP_C1);
1017 end;
1018 Inc(dist0, xx0);
1019 Inc(xx0, 2 * STEP_C0 * STEP_C0);
1020 end;
1021 end;
1022 end;
1025 {LOCAL}
1026 procedure fill_inverse_cmap (cinfo : j_decompress_ptr;
1027 c0 : int; c1 : int; c2 : int);
1028 { Fill the inverse-colormap entries in the update box that contains }
1029 { histogram cell c0/c1/c2. (Only that one cell MUST be filled, but }
1030 { we can fill as many others as we wish.) }
1031 var
1032 cquantize : my_cquantize_ptr;
1033 histogram : hist3d;
1034 minc0, minc1, minc2 : int; { lower left corner of update box }
1035 ic0, ic1, ic2 : int;
1036 {register} cptr : JSAMPLE_PTR; { pointer into bestcolor[] array }
1037 {register} cachep : histptr; { pointer into main cache array }
1038 { This array lists the candidate colormap indexes. }
1039 colorlist : array[0..MAXNUMCOLORS-1] of JSAMPLE;
1040 numcolors : int; { number of candidate colors }
1041 { This array holds the actually closest colormap index for each cell. }
1042 bestcolor : array[0..BOX_C0_ELEMS * BOX_C1_ELEMS * BOX_C2_ELEMS-1] of JSAMPLE;
1043 begin
1044 cquantize := my_cquantize_ptr (cinfo^.cquantize);
1045 histogram := cquantize^.histogram;
1047 { Convert cell coordinates to update box ID }
1048 c0 := c0 shr BOX_C0_LOG;
1049 c1 := c1 shr BOX_C1_LOG;
1050 c2 := c2 shr BOX_C2_LOG;
1052 { Compute true coordinates of update box's origin corner.
1053 Actually we compute the coordinates of the center of the corner
1054 histogram cell, which are the lower bounds of the volume we care about.}
1056 minc0 := (c0 shl BOX_C0_SHIFT) + ((1 shl C0_SHIFT) shr 1);
1057 minc1 := (c1 shl BOX_C1_SHIFT) + ((1 shl C1_SHIFT) shr 1);
1058 minc2 := (c2 shl BOX_C2_SHIFT) + ((1 shl C2_SHIFT) shr 1);
1060 { Determine which colormap entries are close enough to be candidates
1061 for the nearest entry to some cell in the update box. }
1063 numcolors := find_nearby_colors(cinfo, minc0, minc1, minc2, colorlist);
1065 { Determine the actually nearest colors. }
1066 find_best_colors(cinfo, minc0, minc1, minc2, numcolors, colorlist,
1067 bestcolor);
1069 { Save the best color numbers (plus 1) in the main cache array }
1070 c0 := c0 shl BOX_C0_LOG; { convert ID back to base cell indexes }
1071 c1 := c1 shl BOX_C1_LOG;
1072 c2 := c2 shl BOX_C2_LOG;
1073 cptr := @(bestcolor[0]);
1074 for ic0 := 0 to pred(BOX_C0_ELEMS) do
1075 for ic1 := 0 to pred(BOX_C1_ELEMS) do
1076 begin
1077 cachep := @(histogram^[c0+ic0]^[c1+ic1][c2]);
1078 for ic2 := 0 to pred(BOX_C2_ELEMS) do
1079 begin
1080 cachep^ := histcell (GETJSAMPLE(cptr^) + 1);
1081 Inc(cachep);
1082 Inc(cptr);
1083 end;
1084 end;
1085 end;
1088 { Map some rows of pixels to the output colormapped representation. }
1090 {METHODDEF}
1091 procedure pass2_no_dither (cinfo : j_decompress_ptr;
1092 input_buf : JSAMPARRAY;
1093 output_buf : JSAMPARRAY;
1094 num_rows : int);
1095 { This version performs no dithering }
1096 var
1097 cquantize : my_cquantize_ptr;
1098 histogram : hist3d;
1099 {register} inptr : RGBptr;
1100 outptr : JSAMPLE_PTR;
1101 {register} cachep : histptr;
1102 {register} c0, c1, c2 : int;
1103 row : int;
1104 col : JDIMENSION;
1105 width : JDIMENSION;
1106 begin
1107 cquantize := my_cquantize_ptr (cinfo^.cquantize);
1108 histogram := cquantize^.histogram;
1109 width := cinfo^.output_width;
1111 for row := 0 to pred(num_rows) do
1112 begin
1113 inptr := RGBptr(input_buf^[row]);
1114 outptr := JSAMPLE_PTR(output_buf^[row]);
1115 for col := pred(width) downto 0 do
1116 begin
1117 { get pixel value and index into the cache }
1118 c0 := GETJSAMPLE(inptr^.r) shr C0_SHIFT;
1119 c1 := GETJSAMPLE(inptr^.g) shr C1_SHIFT;
1120 c2 := GETJSAMPLE(inptr^.b) shr C2_SHIFT;
1121 Inc(inptr);
1122 cachep := @(histogram^[c0]^[c1][c2]);
1123 { If we have not seen this color before, find nearest colormap entry }
1124 { and update the cache }
1125 if (cachep^ = 0) then
1126 fill_inverse_cmap(cinfo, c0,c1,c2);
1127 { Now emit the colormap index for this cell }
1128 outptr^ := JSAMPLE (cachep^ - 1);
1129 Inc(outptr);
1130 end;
1131 end;
1132 end;
1135 {METHODDEF}
1136 procedure pass2_fs_dither (cinfo : j_decompress_ptr;
1137 input_buf : JSAMPARRAY;
1138 output_buf : JSAMPARRAY;
1139 num_rows : int);
1140 { This version performs Floyd-Steinberg dithering }
1141 var
1142 cquantize : my_cquantize_ptr;
1143 histogram : hist3d;
1144 {register} cur : LOCRGB_FSERROR; { current error or pixel value }
1145 belowerr : LOCRGB_FSERROR; { error for pixel below cur }
1146 bpreverr : LOCRGB_FSERROR; { error for below/prev col }
1147 prev_errorptr,
1148 {register} errorptr : RGB_FSERROR_PTR; { => fserrors[] at column before current }
1149 inptr : RGBptr; { => current input pixel }
1150 outptr : JSAMPLE_PTR; { => current output pixel }
1151 cachep : histptr;
1152 dir : int; { +1 or -1 depending on direction }
1153 row : int;
1154 col : JDIMENSION;
1155 width : JDIMENSION;
1156 range_limit : range_limit_table_ptr;
1157 error_limit : error_limit_ptr;
1158 colormap0 : JSAMPROW;
1159 colormap1 : JSAMPROW;
1160 colormap2 : JSAMPROW;
1161 {register} pixcode : int;
1162 {register} bnexterr, delta : LOCFSERROR;
1163 begin
1164 cquantize := my_cquantize_ptr (cinfo^.cquantize);
1165 histogram := cquantize^.histogram;
1166 width := cinfo^.output_width;
1167 range_limit := cinfo^.sample_range_limit;
1168 error_limit := cquantize^.error_limiter;
1169 colormap0 := cinfo^.colormap^[0];
1170 colormap1 := cinfo^.colormap^[1];
1171 colormap2 := cinfo^.colormap^[2];
1173 for row := 0 to pred(num_rows) do
1174 begin
1175 inptr := RGBptr(input_buf^[row]);
1176 outptr := JSAMPLE_PTR(output_buf^[row]);
1177 errorptr := RGB_FSERROR_PTR(cquantize^.fserrors); { => entry before first real column }
1178 if (cquantize^.on_odd_row) then
1179 begin
1180 { work right to left in this row }
1181 Inc(inptr, (width-1)); { so point to rightmost pixel }
1182 Inc(outptr, width-1);
1183 dir := -1;
1184 Inc(errorptr, (width+1)); { => entry after last column }
1185 cquantize^.on_odd_row := FALSE; { flip for next time }
1186 end
1187 else
1188 begin
1189 { work left to right in this row }
1190 dir := 1;
1191 cquantize^.on_odd_row := TRUE; { flip for next time }
1192 end;
1194 { Preset error values: no error propagated to first pixel from left }
1195 cur.r := 0;
1196 cur.g := 0;
1197 cur.b := 0;
1198 { and no error propagated to row below yet }
1199 belowerr.r := 0;
1200 belowerr.g := 0;
1201 belowerr.b := 0;
1202 bpreverr.r := 0;
1203 bpreverr.g := 0;
1204 bpreverr.b := 0;
1206 for col := pred(width) downto 0 do
1207 begin
1208 prev_errorptr := errorptr;
1209 Inc(errorptr, dir); { advance errorptr to current column }
1211 { curN holds the error propagated from the previous pixel on the
1212 current line. Add the error propagated from the previous line
1213 to form the complete error correction term for this pixel, and
1214 round the error term (which is expressed * 16) to an integer.
1215 RIGHT_SHIFT rounds towards minus infinity, so adding 8 is correct
1216 for either sign of the error value.
1217 Note: prev_errorptr points to *previous* column's array entry. }
1219 { Nomssi Note: Borland Pascal SHR is unsigned }
1220 cur.r := (cur.r + errorptr^.r + 8) div 16;
1221 cur.g := (cur.g + errorptr^.g + 8) div 16;
1222 cur.b := (cur.b + errorptr^.b + 8) div 16;
1223 { Limit the error using transfer function set by init_error_limit.
1224 See comments with init_error_limit for rationale. }
1226 cur.r := error_limit^[cur.r];
1227 cur.g := error_limit^[cur.g];
1228 cur.b := error_limit^[cur.b];
1229 { Form pixel value + error, and range-limit to 0..MAXJSAMPLE.
1230 The maximum error is +- MAXJSAMPLE (or less with error limiting);
1231 this sets the required size of the range_limit array. }
1233 Inc(cur.r, GETJSAMPLE(inptr^.r));
1234 Inc(cur.g, GETJSAMPLE(inptr^.g));
1235 Inc(cur.b, GETJSAMPLE(inptr^.b));
1237 cur.r := GETJSAMPLE(range_limit^[cur.r]);
1238 cur.g := GETJSAMPLE(range_limit^[cur.g]);
1239 cur.b := GETJSAMPLE(range_limit^[cur.b]);
1240 { Index into the cache with adjusted pixel value }
1241 cachep := @(histogram^[cur.r shr C0_SHIFT]^
1242 [cur.g shr C1_SHIFT][cur.b shr C2_SHIFT]);
1243 { If we have not seen this color before, find nearest colormap }
1244 { entry and update the cache }
1245 if (cachep^ = 0) then
1246 fill_inverse_cmap(cinfo, cur.r shr C0_SHIFT,
1247 cur.g shr C1_SHIFT,
1248 cur.b shr C2_SHIFT);
1249 { Now emit the colormap index for this cell }
1251 pixcode := cachep^ - 1;
1252 outptr^ := JSAMPLE (pixcode);
1254 { Compute representation error for this pixel }
1255 Dec(cur.r, GETJSAMPLE(colormap0^[pixcode]));
1256 Dec(cur.g, GETJSAMPLE(colormap1^[pixcode]));
1257 Dec(cur.b, GETJSAMPLE(colormap2^[pixcode]));
1259 { Compute error fractions to be propagated to adjacent pixels.
1260 Add these into the running sums, and simultaneously shift the
1261 next-line error sums left by 1 column. }
1263 bnexterr := cur.r; { Process component 0 }
1264 delta := cur.r * 2;
1265 Inc(cur.r, delta); { form error * 3 }
1266 prev_errorptr^.r := FSERROR (bpreverr.r + cur.r);
1267 Inc(cur.r, delta); { form error * 5 }
1268 bpreverr.r := belowerr.r + cur.r;
1269 belowerr.r := bnexterr;
1270 Inc(cur.r, delta); { form error * 7 }
1271 bnexterr := cur.g; { Process component 1 }
1272 delta := cur.g * 2;
1273 Inc(cur.g, delta); { form error * 3 }
1274 prev_errorptr^.g := FSERROR (bpreverr.g + cur.g);
1275 Inc(cur.g, delta); { form error * 5 }
1276 bpreverr.g := belowerr.g + cur.g;
1277 belowerr.g := bnexterr;
1278 Inc(cur.g, delta); { form error * 7 }
1279 bnexterr := cur.b; { Process component 2 }
1280 delta := cur.b * 2;
1281 Inc(cur.b, delta); { form error * 3 }
1282 prev_errorptr^.b := FSERROR (bpreverr.b + cur.b);
1283 Inc(cur.b, delta); { form error * 5 }
1284 bpreverr.b := belowerr.b + cur.b;
1285 belowerr.b := bnexterr;
1286 Inc(cur.b, delta); { form error * 7 }
1288 { At this point curN contains the 7/16 error value to be propagated
1289 to the next pixel on the current line, and all the errors for the
1290 next line have been shifted over. We are therefore ready to move on.}
1292 Inc(inptr, dir); { Advance pixel pointers to next column }
1293 Inc(outptr, dir);
1294 end;
1295 { Post-loop cleanup: we must unload the final error values into the
1296 final fserrors[] entry. Note we need not unload belowerrN because
1297 it is for the dummy column before or after the actual array. }
1299 errorptr^.r := FSERROR (bpreverr.r); { unload prev errs into array }
1300 errorptr^.g := FSERROR (bpreverr.g);
1301 errorptr^.b := FSERROR (bpreverr.b);
1302 end;
1303 end;
1306 { Initialize the error-limiting transfer function (lookup table).
1307 The raw F-S error computation can potentially compute error values of up to
1308 +- MAXJSAMPLE. But we want the maximum correction applied to a pixel to be
1309 much less, otherwise obviously wrong pixels will be created. (Typical
1310 effects include weird fringes at color-area boundaries, isolated bright
1311 pixels in a dark area, etc.) The standard advice for avoiding this problem
1312 is to ensure that the "corners" of the color cube are allocated as output
1313 colors; then repeated errors in the same direction cannot cause cascading
1314 error buildup. However, that only prevents the error from getting
1315 completely out of hand; Aaron Giles reports that error limiting improves
1316 the results even with corner colors allocated.
1317 A simple clamping of the error values to about +- MAXJSAMPLE/8 works pretty
1318 well, but the smoother transfer function used below is even better. Thanks
1319 to Aaron Giles for this idea. }
1321 {LOCAL}
1322 procedure init_error_limit (cinfo : j_decompress_ptr);
1323 const
1324 STEPSIZE = ((MAXJSAMPLE+1) div 16);
1325 { Allocate and fill in the error_limiter table }
1326 var
1327 cquantize : my_cquantize_ptr;
1328 table : error_limit_ptr;
1329 inp, out : int;
1330 begin
1331 cquantize := my_cquantize_ptr (cinfo^.cquantize);
1332 table := error_limit_ptr (cinfo^.mem^.alloc_small
1333 (j_common_ptr (cinfo), JPOOL_IMAGE, (MAXJSAMPLE*2+1) * SIZEOF(int)));
1334 { not needed: Inc(table, MAXJSAMPLE);
1335 so can index -MAXJSAMPLE .. +MAXJSAMPLE }
1336 cquantize^.error_limiter := table;
1337 { Map errors 1:1 up to +- MAXJSAMPLE/16 }
1338 out := 0;
1339 for inp := 0 to pred(STEPSIZE) do
1340 begin
1341 table^[inp] := out;
1342 table^[-inp] := -out;
1343 Inc(out);
1344 end;
1345 { Map errors 1:2 up to +- 3*MAXJSAMPLE/16 }
1346 inp := STEPSIZE; { Nomssi: avoid problems with Delphi2 optimizer }
1347 while (inp < STEPSIZE*3) do
1348 begin
1349 table^[inp] := out;
1350 table^[-inp] := -out;
1351 Inc(inp);
1352 if Odd(inp) then
1353 Inc(out);
1354 end;
1355 { Clamp the rest to final out value (which is (MAXJSAMPLE+1)/8) }
1356 inp := STEPSIZE*3; { Nomssi: avoid problems with Delphi 2 optimizer }
1357 while inp <= MAXJSAMPLE do
1358 begin
1359 table^[inp] := out;
1360 table^[-inp] := -out;
1361 Inc(inp);
1362 end;
1363 end;
1365 { Finish up at the end of each pass. }
1367 {METHODDEF}
1368 procedure finish_pass1 (cinfo : j_decompress_ptr);
1369 var
1370 cquantize : my_cquantize_ptr;
1371 begin
1372 cquantize := my_cquantize_ptr (cinfo^.cquantize);
1374 { Select the representative colors and fill in cinfo^.colormap }
1375 cinfo^.colormap := cquantize^.sv_colormap;
1376 select_colors(cinfo, cquantize^.desired);
1377 { Force next pass to zero the color index table }
1378 cquantize^.needs_zeroed := TRUE;
1379 end;
1382 {METHODDEF}
1383 procedure finish_pass2 (cinfo : j_decompress_ptr);
1384 begin
1385 { no work }
1386 end;
1389 { Initialize for each processing pass. }
1391 {METHODDEF}
1392 procedure start_pass_2_quant (cinfo : j_decompress_ptr;
1393 is_pre_scan : boolean);
1394 var
1395 cquantize : my_cquantize_ptr;
1396 histogram : hist3d;
1397 i : int;
1398 var
1399 arraysize : size_t;
1400 begin
1401 cquantize := my_cquantize_ptr (cinfo^.cquantize);
1402 histogram := cquantize^.histogram;
1403 { Only F-S dithering or no dithering is supported. }
1404 { If user asks for ordered dither, give him F-S. }
1405 if (cinfo^.dither_mode <> JDITHER_NONE) then
1406 cinfo^.dither_mode := JDITHER_FS;
1408 if (is_pre_scan) then
1409 begin
1410 { Set up method pointers }
1411 cquantize^.pub.color_quantize := prescan_quantize;
1412 cquantize^.pub.finish_pass := finish_pass1;
1413 cquantize^.needs_zeroed := TRUE; { Always zero histogram }
1414 end
1415 else
1416 begin
1417 { Set up method pointers }
1418 if (cinfo^.dither_mode = JDITHER_FS) then
1419 cquantize^.pub.color_quantize := pass2_fs_dither
1420 else
1421 cquantize^.pub.color_quantize := pass2_no_dither;
1422 cquantize^.pub.finish_pass := finish_pass2;
1424 { Make sure color count is acceptable }
1425 i := cinfo^.actual_number_of_colors;
1426 if (i < 1) then
1427 ERREXIT1(j_common_ptr(cinfo), JERR_QUANT_FEW_COLORS, 1);
1428 if (i > MAXNUMCOLORS) then
1429 ERREXIT1(j_common_ptr(cinfo), JERR_QUANT_MANY_COLORS, MAXNUMCOLORS);
1431 if (cinfo^.dither_mode = JDITHER_FS) then
1432 begin
1433 arraysize := size_t ((cinfo^.output_width + 2) *
1434 (3 * SIZEOF(FSERROR)));
1435 { Allocate Floyd-Steinberg workspace if we didn't already. }
1436 if (cquantize^.fserrors = NIL) then
1437 cquantize^.fserrors := FS_ERROR_FIELD_PTR (cinfo^.mem^.alloc_large
1438 (j_common_ptr(cinfo), JPOOL_IMAGE, arraysize));
1439 { Initialize the propagated errors to zero. }
1440 jzero_far(cquantize^.fserrors, arraysize);
1441 { Make the error-limit table if we didn't already. }
1442 if (cquantize^.error_limiter = NIL) then
1443 init_error_limit(cinfo);
1444 cquantize^.on_odd_row := FALSE;
1445 end;
1447 end;
1448 { Zero the histogram or inverse color map, if necessary }
1449 if (cquantize^.needs_zeroed) then
1450 begin
1451 for i := 0 to pred(HIST_C0_ELEMS) do
1452 begin
1453 jzero_far( histogram^[i],
1454 HIST_C1_ELEMS*HIST_C2_ELEMS * SIZEOF(histcell));
1455 end;
1456 cquantize^.needs_zeroed := FALSE;
1457 end;
1458 end;
1461 { Switch to a new external colormap between output passes. }
1463 {METHODDEF}
1464 procedure new_color_map_2_quant (cinfo : j_decompress_ptr);
1465 var
1466 cquantize : my_cquantize_ptr;
1467 begin
1468 cquantize := my_cquantize_ptr (cinfo^.cquantize);
1470 { Reset the inverse color map }
1471 cquantize^.needs_zeroed := TRUE;
1472 end;
1475 { Module initialization routine for 2-pass color quantization. }
1478 {GLOBAL}
1479 procedure jinit_2pass_quantizer (cinfo : j_decompress_ptr);
1480 var
1481 cquantize : my_cquantize_ptr;
1482 i : int;
1483 var
1484 desired : int;
1485 begin
1486 cquantize := my_cquantize_ptr(
1487 cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
1488 SIZEOF(my_cquantizer)));
1489 cinfo^.cquantize := jpeg_color_quantizer_ptr(cquantize);
1490 cquantize^.pub.start_pass := start_pass_2_quant;
1491 cquantize^.pub.new_color_map := new_color_map_2_quant;
1492 cquantize^.fserrors := NIL; { flag optional arrays not allocated }
1493 cquantize^.error_limiter := NIL;
1495 { Make sure jdmaster didn't give me a case I can't handle }
1496 if (cinfo^.out_color_components <> 3) then
1497 ERREXIT(j_common_ptr(cinfo), JERR_NOTIMPL);
1499 { Allocate the histogram/inverse colormap storage }
1500 cquantize^.histogram := hist3d (cinfo^.mem^.alloc_small
1501 (j_common_ptr (cinfo), JPOOL_IMAGE, HIST_C0_ELEMS * SIZEOF(hist2d)));
1502 for i := 0 to pred(HIST_C0_ELEMS) do
1503 begin
1504 cquantize^.histogram^[i] := hist2d (cinfo^.mem^.alloc_large
1505 (j_common_ptr (cinfo), JPOOL_IMAGE,
1506 HIST_C1_ELEMS*HIST_C2_ELEMS * SIZEOF(histcell)));
1507 end;
1508 cquantize^.needs_zeroed := TRUE; { histogram is garbage now }
1510 { Allocate storage for the completed colormap, if required.
1511 We do this now since it is FAR storage and may affect
1512 the memory manager's space calculations. }
1514 if (cinfo^.enable_2pass_quant) then
1515 begin
1516 { Make sure color count is acceptable }
1517 desired := cinfo^.desired_number_of_colors;
1518 { Lower bound on # of colors ... somewhat arbitrary as long as > 0 }
1519 if (desired < 8) then
1520 ERREXIT1(j_common_ptr (cinfo), JERR_QUANT_FEW_COLORS, 8);
1521 { Make sure colormap indexes can be represented by JSAMPLEs }
1522 if (desired > MAXNUMCOLORS) then
1523 ERREXIT1(j_common_ptr (cinfo), JERR_QUANT_MANY_COLORS, MAXNUMCOLORS);
1524 cquantize^.sv_colormap := cinfo^.mem^.alloc_sarray
1525 (j_common_ptr (cinfo),JPOOL_IMAGE, JDIMENSION(desired), JDIMENSION(3));
1526 cquantize^.desired := desired;
1527 end
1528 else
1529 cquantize^.sv_colormap := NIL;
1531 { Only F-S dithering or no dithering is supported. }
1532 { If user asks for ordered dither, give him F-S. }
1533 if (cinfo^.dither_mode <> JDITHER_NONE) then
1534 cinfo^.dither_mode := JDITHER_FS;
1536 { Allocate Floyd-Steinberg workspace if necessary.
1537 This isn't really needed until pass 2, but again it is FAR storage.
1538 Although we will cope with a later change in dither_mode,
1539 we do not promise to honor max_memory_to_use if dither_mode changes. }
1541 if (cinfo^.dither_mode = JDITHER_FS) then
1542 begin
1543 cquantize^.fserrors := FS_ERROR_FIELD_PTR (cinfo^.mem^.alloc_large
1544 (j_common_ptr(cinfo), JPOOL_IMAGE,
1545 size_t ((cinfo^.output_width + 2) * (3 * SIZEOF(FSERROR))) ) );
1546 { Might as well create the error-limiting table too. }
1547 init_error_limit(cinfo);
1548 end;
1549 end;
1550 { QUANT_2PASS_SUPPORTED }
1551 end.