src/lib/vampimg/JpegLib/imjcdctmgr.pas

   1 unit imjcdctmgr;
   2
   3 { Original : jcdctmgr.c ;  Copyright (C) 1994-1996, Thomas G. Lane. }
   4
   5 { This file is part of the Independent JPEG Group's software.
   6   For conditions of distribution and use, see the accompanying README file.
   7
   8   This file contains the forward-DCT management logic.
   9   This code selects a particular DCT implementation to be used,
  10   and it performs related housekeeping chores including coefficient
  11   quantization. }
  12
  13 interface
  14
  15 {$N+}
  16 {$I imjconfig.inc}
  17
  18 uses
  19   imjmorecfg,
  20   imjinclude,
  21   imjdeferr,
  22   imjerror,
  23   imjpeglib,
  24   imjdct,                 { Private declarations for DCT subsystem }
  25   imjfdctint, imjfdctfst, imjfdctflt;
  26
  27 { Initialize FDCT manager. }
  28
  29 {GLOBAL}
  30 procedure jinit_forward_dct (cinfo : j_compress_ptr);
  31
  32 implementation
  33
  34
  35 { Private subobject for this module }
  36
  37 type
  38   my_fdct_ptr = ^my_fdct_controller;
  39   my_fdct_controller = record
  40     pub : jpeg_forward_dct; { public fields }
  41
  42     { Pointer to the DCT routine actually in use }
  43     do_dct : forward_DCT_method_ptr;
  44
  45     { The actual post-DCT divisors --- not identical to the quant table
  46       entries, because of scaling (especially for an unnormalized DCT).
  47       Each table is given in normal array order. }
  48
  49     divisors : array[0..NUM_QUANT_TBLS-1] of DCTELEM_FIELD_PTR;
  50
  51   {$ifdef DCT_FLOAT_SUPPORTED}
  52     { Same as above for the floating-point case. }
  53     do_float_dct : float_DCT_method_ptr;
  54     float_divisors : array[0..NUM_QUANT_TBLS-1] of FAST_FLOAT_FIELD_PTR;
  55   {$endif}
  56   end;
  57
  58
  59 { Initialize for a processing pass.
  60   Verify that all referenced Q-tables are present, and set up
  61   the divisor table for each one.
  62   In the current implementation, DCT of all components is done during
  63   the first pass, even if only some components will be output in the
  64   first scan.  Hence all components should be examined here. }
  65
  66 {METHODDEF}
  67 procedure start_pass_fdctmgr (cinfo : j_compress_ptr);
  68 var
  69   fdct : my_fdct_ptr;
  70   ci, qtblno, i : int;
  71   compptr : jpeg_component_info_ptr;
  72   qtbl : JQUANT_TBL_PTR;
  73   dtbl : DCTELEM_FIELD_PTR;
  74 {$ifdef DCT_IFAST_SUPPORTED}
  75 const
  76   CONST_BITS = 14;
  77   aanscales : array[0..DCTSIZE2-1] of INT16 =
  78          ({ precomputed values scaled up by 14 bits }
  79     16384, 22725, 21407, 19266, 16384, 12873,  8867,  4520,
  80     22725, 31521, 29692, 26722, 22725, 17855, 12299,  6270,
  81     21407, 29692, 27969, 25172, 21407, 16819, 11585,  5906,
  82     19266, 26722, 25172, 22654, 19266, 15137, 10426,  5315,
  83     16384, 22725, 21407, 19266, 16384, 12873,  8867,  4520,
  84     12873, 17855, 16819, 15137, 12873, 10114,  6967,  3552,
  85      8867, 12299, 11585, 10426,  8867,  6967,  4799,  2446,
  86      4520,  6270,  5906,  5315,  4520,  3552,  2446,  1247);
  87   {SHIFT_TEMPS}
  88
  89   { Descale and correctly round an INT32 value that's scaled by N bits.
  90     We assume RIGHT_SHIFT rounds towards minus infinity, so adding
  91     the fudge factor is correct for either sign of X. }
  92
  93   function DESCALE(x : INT32; n : int) : INT32;
  94   var
  95     shift_temp : INT32;
  96   begin
  97     shift_temp := x + (INT32(1) shl (n-1));
  98   {$ifdef RIGHT_SHIFT_IS_UNSIGNED}
  99     if shift_temp < 0 then
 100       Descale :=  (shift_temp shr n) or ((not INT32(0)) shl (32-n))
 101     else
 102   {$endif}
 103       Descale :=  (shift_temp shr n);
 104   end;
 105
 106 {$endif}
 107 {$ifdef DCT_FLOAT_SUPPORTED}
 108 var
 109   fdtbl : FAST_FLOAT_FIELD_PTR;
 110   row, col : int;
 111 const
 112   aanscalefactor : array[0..DCTSIZE-1] of double =
 113     (1.0, 1.387039845, 1.306562965, 1.175875602,
 114      1.0, 0.785694958, 0.541196100, 0.275899379);
 115 {$endif}
 116 begin
 117   fdct := my_fdct_ptr (cinfo^.fdct);
 118   compptr := jpeg_component_info_ptr(cinfo^.comp_info);
 119   for ci := 0 to pred(cinfo^.num_components) do
 120   begin
 121     qtblno := compptr^.quant_tbl_no;
 122     { Make sure specified quantization table is present }
 123     if (qtblno < 0) or (qtblno >= NUM_QUANT_TBLS) or
 124        (cinfo^.quant_tbl_ptrs[qtblno] = NIL) then
 125       ERREXIT1(j_common_ptr(cinfo), JERR_NO_QUANT_TABLE, qtblno);
 126     qtbl := cinfo^.quant_tbl_ptrs[qtblno];
 127     { Compute divisors for this quant table }
 128     { We may do this more than once for same table, but it's not a big deal }
 129     case (cinfo^.dct_method) of
 130 {$ifdef DCT_ISLOW_SUPPORTED}
 131     JDCT_ISLOW:
 132     begin
 133       { For LL&M IDCT method, divisors are equal to raw quantization
 134         coefficients multiplied by 8 (to counteract scaling). }
 135
 136       if (fdct^.divisors[qtblno] = NIL) then
 137       begin
 138   fdct^.divisors[qtblno] := DCTELEM_FIELD_PTR(
 139     cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
 140               DCTSIZE2 * SIZEOF(DCTELEM)) );
 141       end;
 142       dtbl := fdct^.divisors[qtblno];
 143       for i := 0 to pred(DCTSIZE2) do
 144       begin
 145   dtbl^[i] := (DCTELEM(qtbl^.quantval[i])) shl 3;
 146       end;
 147     end;
 148 {$endif}
 149 {$ifdef DCT_IFAST_SUPPORTED}
 150     JDCT_IFAST:
 151       begin
 152         { For AA&N IDCT method, divisors are equal to quantization
 153           coefficients scaled by scalefactor[row]*scalefactor[col], where
 154             scalefactor[0] := 1
 155             scalefactor[k] := cos(k*PI/16) * sqrt(2)    for k=1..7
 156           We apply a further scale factor of 8. }
 157
 158
 159   if (fdct^.divisors[qtblno] = NIL) then
 160         begin
 161     fdct^.divisors[qtblno] := DCTELEM_FIELD_PTR(
 162       cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
 163           DCTSIZE2 * SIZEOF(DCTELEM)) );
 164   end;
 165   dtbl := fdct^.divisors[qtblno];
 166   for i := 0 to pred(DCTSIZE2) do
 167         begin
 168     dtbl^[i] := DCTELEM(
 169                      {MULTIPLY16V16}
 170       DESCALE( INT32(qtbl^.quantval[i]) * INT32 (aanscales[i]),
 171          CONST_BITS-3) );
 172   end;
 173       end;
 174 {$endif}
 175 {$ifdef DCT_FLOAT_SUPPORTED}
 176
 177     JDCT_FLOAT:
 178       begin
 179   { For float AA&N IDCT method, divisors are equal to quantization
 180     coefficients scaled by scalefactor[row]*scalefactor[col], where
 181       scalefactor[0] := 1
 182       scalefactor[k] := cos(k*PI/16) * sqrt(2)    for k=1..7
 183     We apply a further scale factor of 8.
 184     What's actually stored is 1/divisor so that the inner loop can
 185     use a multiplication rather than a division. }
 186
 187   if (fdct^.float_divisors[qtblno] = NIL) then
 188         begin
 189     fdct^.float_divisors[qtblno] := FAST_FLOAT_FIELD_PTR(
 190       cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
 191           DCTSIZE2 * SIZEOF(FAST_FLOAT)) );
 192   end;
 193   fdtbl := fdct^.float_divisors[qtblno];
 194   i := 0;
 195   for row := 0 to pred(DCTSIZE) do
 196         begin
 197     for col := 0 to pred(DCTSIZE) do
 198           begin
 199       fdtbl^[i] := {FAST_FLOAT}
 200         (1.0 / (( {double}(qtbl^.quantval[i]) *
 201            aanscalefactor[row] * aanscalefactor[col] * 8.0)));
 202       Inc(i);
 203     end;
 204   end;
 205       end;
 206 {$endif}
 207     else
 208       ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
 209     end;
 210     Inc(compptr);
 211   end;
 212 end;
 213
 214
 215 { Perform forward DCT on one or more blocks of a component.
 216
 217   The input samples are taken from the sample_data[] array starting at
 218   position start_row/start_col, and moving to the right for any additional
 219   blocks. The quantized coefficients are returned in coef_blocks[]. }
 220
 221 {METHODDEF}
 222 procedure forward_DCT (cinfo : j_compress_ptr;
 223                        compptr : jpeg_component_info_ptr;
 224                  sample_data : JSAMPARRAY;
 225                        coef_blocks : JBLOCKROW;
 226                  start_row : JDIMENSION;
 227                        start_col : JDIMENSION;
 228                  num_blocks : JDIMENSION);
 229 { This version is used for integer DCT implementations. }
 230 var
 231   { This routine is heavily used, so it's worth coding it tightly. }
 232   fdct : my_fdct_ptr;
 233   do_dct : forward_DCT_method_ptr;
 234   divisors : DCTELEM_FIELD_PTR;
 235   workspace : array[0..DCTSIZE2-1] of DCTELEM;  { work area for FDCT subroutine }
 236   bi : JDIMENSION;
 237 var
 238   {register} workspaceptr : DCTELEMPTR;
 239   {register} elemptr : JSAMPLE_PTR;
 240   {register} elemr : int;
 241 {$ifndef DCTSIZE_IS_8}
 242 var
 243   {register} elemc : int;
 244 {$endif}
 245 var
 246   {register} temp, qval : DCTELEM;
 247   {register} i : int;
 248   {register} output_ptr : JCOEFPTR;
 249 begin
 250   fdct := my_fdct_ptr (cinfo^.fdct);
 251   do_dct := fdct^.do_dct;
 252   divisors := fdct^.divisors[compptr^.quant_tbl_no];
 253
 254   Inc(JSAMPROW_PTR(sample_data), start_row);  { fold in the vertical offset once }
 255
 256   for bi := 0 to pred(num_blocks) do
 257   begin
 258
 259     { Load data into workspace, applying unsigned->signed conversion }
 260
 261     workspaceptr := @workspace[0];
 262     for elemr := 0 to pred(DCTSIZE) do
 263     begin
 264       elemptr := @sample_data^[elemr]^[start_col];
 265 {$ifdef DCTSIZE_IS_8}   { unroll the inner loop }
 266       workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE;
 267       Inc(workspaceptr);
 268       Inc(elemptr);
 269       workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE;
 270       Inc(workspaceptr);
 271       Inc(elemptr);
 272       workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE;
 273       Inc(workspaceptr);
 274       Inc(elemptr);
 275       workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE;
 276       Inc(workspaceptr);
 277       Inc(elemptr);
 278       workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE;
 279       Inc(workspaceptr);
 280       Inc(elemptr);
 281       workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE;
 282       Inc(workspaceptr);
 283       Inc(elemptr);
 284       workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE;
 285       Inc(workspaceptr);
 286       Inc(elemptr);
 287       workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE;
 288       Inc(workspaceptr);
 289       {Inc(elemptr);       - Value never used }
 290 {$else}
 291       for elemc := pred(DCTSIZE) downto 0 do
 292       begin
 293         workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE;
 294         Inc(workspaceptr);
 295         Inc(elemptr);
 296       end;
 297 {$endif}
 298     end;
 299
 300     { Perform the DCT }
 301     do_dct (workspace);
 302
 303     { Quantize/descale the coefficients, and store into coef_blocks[] }
 304
 305     output_ptr := JCOEFPTR(@coef_blocks^[bi]);
 306     for i := 0 to pred(DCTSIZE2) do
 307     begin
 308       qval := divisors^[i];
 309       temp := workspace[i];
 310       { Divide the coefficient value by qval, ensuring proper rounding.
 311   Since C does not specify the direction of rounding for negative
 312   quotients, we have to force the dividend positive for portability.
 313
 314   In most files, at least half of the output values will be zero
 315   (at default quantization settings, more like three-quarters...)
 316   so we should ensure that this case is fast.  On many machines,
 317   a comparison is enough cheaper than a divide to make a special test
 318   a win.  Since both inputs will be nonnegative, we need only test
 319   for a < b to discover whether a/b is 0.
 320   If your machine's division is fast enough, define FAST_DIVIDE. }
 321
 322       if (temp < 0) then
 323       begin
 324   temp := -temp;
 325   Inc(temp, qval shr 1);  { for rounding }
 326         {DIVIDE_BY(temp, qval);}
 327         {$ifdef FAST_DIVIDE}
 328           temp := temp div qval;
 329         {$else}
 330           if (temp >= qval) then
 331             temp := temp div qval
 332           else
 333             temp := 0;
 334         {$endif}
 335   temp := -temp;
 336       end
 337       else
 338       begin
 339   Inc(temp, qval shr 1);  { for rounding }
 340         {DIVIDE_BY(temp, qval);}
 341         {$ifdef FAST_DIVIDE}
 342           temp := temp div qval;
 343         {$else}
 344           if (temp >= qval) then
 345             temp := temp div qval
 346           else
 347             temp := 0;
 348         {$endif}
 349       end;
 350       output_ptr^[i] := JCOEF (temp);
 351     end;
 352     Inc(start_col, DCTSIZE);
 353   end;
 354 end;
 355
 356
 357 {$ifdef DCT_FLOAT_SUPPORTED}
 358
 359 {METHODDEF}
 360 procedure forward_DCT_float (cinfo : j_compress_ptr;
 361                              compptr : jpeg_component_info_ptr;
 362                  sample_data : JSAMPARRAY;
 363                              coef_blocks : JBLOCKROW;
 364                  start_row : JDIMENSION;
 365                              start_col : JDIMENSION;
 366                  num_blocks : JDIMENSION);
 367 { This version is used for floating-point DCT implementations. }
 368 var
 369   { This routine is heavily used, so it's worth coding it tightly. }
 370   fdct : my_fdct_ptr;
 371   do_dct : float_DCT_method_ptr;
 372   divisors : FAST_FLOAT_FIELD_PTR;
 373   workspace : array[0..DCTSIZE2-1] of FAST_FLOAT; { work area for FDCT subroutine }
 374   bi : JDIMENSION;
 375 var
 376   {register} workspaceptr : FAST_FLOAT_PTR;
 377   {register} elemptr : JSAMPLE_PTR;
 378   {register} elemr : int;
 379 {$ifndef DCTSIZE_IS_8}
 380 var
 381   {register} elemc : int;
 382 {$endif}
 383 var
 384   {register} temp : FAST_FLOAT;
 385   {register} i : int;
 386   {register} output_ptr : JCOEFPTR;
 387 begin
 388   fdct := my_fdct_ptr (cinfo^.fdct);
 389   do_dct := fdct^.do_float_dct;
 390   divisors := fdct^.float_divisors[compptr^.quant_tbl_no];
 391
 392   Inc(JSAMPROW_PTR(sample_data), start_row);  { fold in the vertical offset once }
 393
 394   for bi := 0 to pred(num_blocks) do
 395   begin
 396     { Load data into workspace, applying unsigned->signed conversion }
 397
 398     workspaceptr := @workspace[0];
 399     for elemr := 0 to pred(DCTSIZE) do
 400     begin
 401       elemptr := @(sample_data^[elemr]^[start_col]);
 402 {$ifdef DCTSIZE_IS_8}   { unroll the inner loop }
 403       workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE);
 404       Inc(workspaceptr);
 405       Inc(elemptr);
 406       workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE);
 407       Inc(workspaceptr);
 408       Inc(elemptr);
 409       workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE);
 410       Inc(workspaceptr);
 411       Inc(elemptr);
 412       workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE);
 413       Inc(workspaceptr);
 414       Inc(elemptr);
 415       workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE);
 416       Inc(workspaceptr);
 417       Inc(elemptr);
 418       workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE);
 419       Inc(workspaceptr);
 420       Inc(elemptr);
 421       workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE);
 422       Inc(workspaceptr);
 423       Inc(elemptr);
 424       workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE);
 425       Inc(workspaceptr);
 426       {Inc(elemptr);         - value never used }
 427 {$else}
 428       for elemc := pred(DCTSIZE) downto 0 do
 429       begin
 430   workspaceptr^ := {FAST_FLOAT}(
 431     (GETJSAMPLE(elemptr^) - CENTERJSAMPLE) );
 432         Inc(workspaceptr);
 433         Inc(elemptr);
 434       end;
 435 {$endif}
 436     end;
 437
 438
 439     { Perform the DCT }
 440     do_dct (workspace);
 441
 442     { Quantize/descale the coefficients, and store into coef_blocks[] }
 443
 444     output_ptr := JCOEFPTR(@(coef_blocks^[bi]));
 445
 446     for i := 0 to pred(DCTSIZE2) do
 447     begin
 448       { Apply the quantization and scaling factor }
 449       temp := workspace[i] * divisors^[i];
 450       { Round to nearest integer.
 451   Since C does not specify the direction of rounding for negative
 452   quotients, we have to force the dividend positive for portability.
 453   The maximum coefficient size is +-16K (for 12-bit data), so this
 454   code should work for either 16-bit or 32-bit ints. }
 455       output_ptr^[i] := JCOEF ( int(Trunc (temp + {FAST_FLOAT}(16384.5))) - 16384);
 456     end;
 457     Inc(start_col, DCTSIZE);
 458   end;
 459 end;
 460
 461 {$endif} { DCT_FLOAT_SUPPORTED }
 462
 463
 464 { Initialize FDCT manager. }
 465
 466 {GLOBAL}
 467 procedure jinit_forward_dct (cinfo : j_compress_ptr);
 468 var
 469   fdct : my_fdct_ptr;
 470   i : int;
 471 begin
 472   fdct := my_fdct_ptr(
 473     cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
 474         SIZEOF(my_fdct_controller)) );
 475   cinfo^.fdct := jpeg_forward_dct_ptr (fdct);
 476   fdct^.pub.start_pass := start_pass_fdctmgr;
 477
 478   case (cinfo^.dct_method) of
 479 {$ifdef DCT_ISLOW_SUPPORTED}
 480   JDCT_ISLOW:
 481     begin
 482       fdct^.pub.forward_DCT := forward_DCT;
 483       fdct^.do_dct := jpeg_fdct_islow;
 484     end;
 485 {$endif}
 486 {$ifdef DCT_IFAST_SUPPORTED}
 487   JDCT_IFAST:
 488     begin
 489       fdct^.pub.forward_DCT := forward_DCT;
 490       fdct^.do_dct := jpeg_fdct_ifast;
 491     end;
 492 {$endif}
 493 {$ifdef DCT_FLOAT_SUPPORTED}
 494   JDCT_FLOAT:
 495     begin
 496       fdct^.pub.forward_DCT := forward_DCT_float;
 497       fdct^.do_float_dct := jpeg_fdct_float;
 498     end;
 499 {$endif}
 500   else
 501     ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
 502   end;
 503
 504   { Mark divisor tables unallocated }
 505   for i := 0 to pred(NUM_QUANT_TBLS) do
 506   begin
 507     fdct^.divisors[i] := NIL;
 508 {$ifdef DCT_FLOAT_SUPPORTED}
 509     fdct^.float_divisors[i] := NIL;
 510 {$endif}
 511   end;
 512 end;
 513
 514 end.