jcdctmgr.pas

用pascal寫的jpeg codec, 測試過的

Unit JcDCTmgr;

{ Original : jcdctmgr.c ;  Copyright (C) 1994-1996, Thomas G. Lane. }

{ This file is part of the Independent JPEG Group's software.
  For conditions of distribution and use, see the accompanying README file.

  This file contains the forward-DCT management logic.
  This code selects a particular DCT implementation to be used,
  and it performs related housekeeping chores including coefficient
  quantization. }

interface

{$N+}
{$I jconfig.inc}

uses
  jmorecfg,
  jinclude,
  jdeferr,
  jerror,
  jpeglib,
  jdct,                 { Private declarations for DCT subsystem }
  jfdctint, jfdctfst, jfdctflt;

{ Initialize FDCT manager. }

{GLOBAL}
procedure jinit_forward_dct (cinfo : j_compress_ptr);

implementation


{ Private subobject for this module }

type
  my_fdct_ptr = ^my_fdct_controller;
  my_fdct_controller = record
    pub : jpeg_forward_dct;	{ public fields }

    { Pointer to the DCT routine actually in use }
    do_dct : forward_DCT_method_ptr;

    { The actual post-DCT divisors --- not identical to the quant table
      entries, because of scaling (especially for an unnormalized DCT).
      Each table is given in normal array order. }

    divisors : array[0..NUM_QUANT_TBLS-1] of DCTELEM_FIELD_PTR;

  {$ifdef DCT_FLOAT_SUPPORTED}
    { Same as above for the floating-point case. }
    do_float_dct : float_DCT_method_ptr;
    float_divisors : array[0..NUM_QUANT_TBLS-1] of FAST_FLOAT_FIELD_PTR;
  {$endif}
  end;


{ Initialize for a processing pass.
  Verify that all referenced Q-tables are present, and set up
  the divisor table for each one.
  In the current implementation, DCT of all components is done during
  the first pass, even if only some components will be output in the
  first scan.  Hence all components should be examined here. }

{METHODDEF}
procedure start_pass_fdctmgr (cinfo : j_compress_ptr); far;
var
  fdct : my_fdct_ptr;
  ci, qtblno, i : int;
  compptr : jpeg_component_info_ptr;
  qtbl : JQUANT_TBL_PTR;
  dtbl : DCTELEM_FIELD_PTR;
{$ifdef DCT_IFAST_SUPPORTED}
const
  CONST_BITS = 14;
  aanscales : array[0..DCTSIZE2-1] of INT16 =
         ({ precomputed values scaled up by 14 bits }
	  16384, 22725, 21407, 19266, 16384, 12873,  8867,  4520,
	  22725, 31521, 29692, 26722, 22725, 17855, 12299,  6270,
	  21407, 29692, 27969, 25172, 21407, 16819, 11585,  5906,
	  19266, 26722, 25172, 22654, 19266, 15137, 10426,  5315,
	  16384, 22725, 21407, 19266, 16384, 12873,  8867,  4520,
	  12873, 17855, 16819, 15137, 12873, 10114,  6967,  3552,
	   8867, 12299, 11585, 10426,  8867,  6967,  4799,  2446,
	   4520,  6270,  5906,  5315,  4520,  3552,  2446,  1247);
  {SHIFT_TEMPS}

  { Descale and correctly round an INT32 value that's scaled by N bits.
    We assume RIGHT_SHIFT rounds towards minus infinity, so adding
    the fudge factor is correct for either sign of X. }

  function DESCALE(x : INT32; n : int) : INT32;
  var
    shift_temp : INT32;
  begin
    shift_temp := x + (INT32(1) shl (n-1));
  {$ifdef RIGHT_SHIFT_IS_UNSIGNED}
    if shift_temp < 0 then
      Descale :=  (shift_temp shr n) or ((not INT32(0)) shl (32-n))
    else
  {$endif}
      Descale :=  (shift_temp shr n);
  end;

{$endif}
{$ifdef DCT_FLOAT_SUPPORTED}
var
  fdtbl : FAST_FLOAT_FIELD_PTR;
  row, col : int;
const
  aanscalefactor : array[0..DCTSIZE-1] of double =
    (1.0, 1.387039845, 1.306562965, 1.175875602,
     1.0, 0.785694958, 0.541196100, 0.275899379);
{$endif}
begin
  fdct := my_fdct_ptr (cinfo^.fdct);
  compptr := cinfo^.comp_info;
  for ci := 0 to pred(cinfo^.num_components) do
  begin
    qtblno := compptr^.quant_tbl_no;
    { Make sure specified quantization table is present }
    if (qtblno < 0) or (qtblno >= NUM_QUANT_TBLS) or
       (cinfo^.quant_tbl_ptrs[qtblno] = NIL) then
      ERREXIT1(j_common_ptr(cinfo), JERR_NO_QUANT_TABLE, qtblno);
    qtbl := cinfo^.quant_tbl_ptrs[qtblno];
    { Compute divisors for this quant table }
    { We may do this more than once for same table, but it's not a big deal }
    case (cinfo^.dct_method) of
{$ifdef DCT_ISLOW_SUPPORTED}
    JDCT_ISLOW:
    begin
      { For LL&M IDCT method, divisors are equal to raw quantization
        coefficients multiplied by 8 (to counteract scaling). }

      if (fdct^.divisors[qtblno] = NIL) then
      begin
	fdct^.divisors[qtblno] := DCTELEM_FIELD_PTR(
	  cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
				      DCTSIZE2 * SIZEOF(DCTELEM)) );
      end;
      dtbl := fdct^.divisors[qtblno];
      for i := 0 to pred(DCTSIZE2) do
      begin
	dtbl^[i] := (DCTELEM(qtbl^.quantval[i])) shl 3;
      end;
    end;
{$endif}
{$ifdef DCT_IFAST_SUPPORTED}
    JDCT_IFAST:
      begin
        { For AA&N IDCT method, divisors are equal to quantization
          coefficients scaled by scalefactor[row]*scalefactor[col], where
            scalefactor[0] := 1
            scalefactor[k] := cos(k*PI/16) * sqrt(2)    for k=1..7
          We apply a further scale factor of 8. }


	if (fdct^.divisors[qtblno] = NIL) then
        begin
	  fdct^.divisors[qtblno] := DCTELEM_FIELD_PTR(
	    cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
					DCTSIZE2 * SIZEOF(DCTELEM)) );
	end;
	dtbl := fdct^.divisors[qtblno];
	for i := 0 to pred(DCTSIZE2) do
        begin
	  dtbl^[i] := DCTELEM(
                     {MULTIPLY16V16}
	    DESCALE( INT32(qtbl^.quantval[i]) * INT32 (aanscales[i]),
		     CONST_BITS-3) );
	end;
      end;
{$endif}
{$ifdef DCT_FLOAT_SUPPORTED}

    JDCT_FLOAT:
      begin
	{ For float AA&N IDCT method, divisors are equal to quantization
	  coefficients scaled by scalefactor[row]*scalefactor[col], where
	    scalefactor[0] := 1
	    scalefactor[k] := cos(k*PI/16) * sqrt(2)    for k=1..7
	  We apply a further scale factor of 8.
	  What's actually stored is 1/divisor so that the inner loop can
	  use a multiplication rather than a division. }

	if (fdct^.float_divisors[qtblno] = NIL) then
        begin
	  fdct^.float_divisors[qtblno] := FAST_FLOAT_FIELD_PTR(
	    cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
					DCTSIZE2 * SIZEOF(FAST_FLOAT)) );
	end;
	fdtbl := fdct^.float_divisors[qtblno];
	i := 0;
	for row := 0 to pred(DCTSIZE) do
        begin
	  for col := 0 to pred(DCTSIZE) do
          begin
	    fdtbl^[i] := {FAST_FLOAT}
	      (1.0 / (( {double}(qtbl^.quantval[i]) *
		       aanscalefactor[row] * aanscalefactor[col] * 8.0)));
	    Inc(i);
	  end;
	end;
      end;
{$endif}
    else
      ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
    end;
    Inc(compptr);
  end;
end;


{ Perform forward DCT on one or more blocks of a component.

  The input samples are taken from the sample_data[] array starting at
  position start_row/start_col, and moving to the right for any additional
  blocks. The quantized coefficients are returned in coef_blocks[]. }

{METHODDEF}
procedure forward_DCT (cinfo : j_compress_ptr;
                       compptr : jpeg_component_info_ptr;
	               sample_data : JSAMPARRAY;
                       coef_blocks : JBLOCKROW;
	               start_row : JDIMENSION;
                       start_col : JDIMENSION;
	               num_blocks : JDIMENSION); far;
{ This version is used for integer DCT implementations. }
var
  { This routine is heavily used, so it's worth coding it tightly. }
  fdct : my_fdct_ptr;
  do_dct : forward_DCT_method_ptr;
  divisors : DCTELEM_FIELD_PTR;
  workspace : array[0..DCTSIZE2-1] of DCTELEM;	{ work area for FDCT subroutine }
  bi : JDIMENSION;
var
  {register} workspaceptr : DCTELEMPTR;
  {register} elemptr : JSAMPLE_PTR;
  {register} elemr : int;
{$ifndef DCTSIZE_IS_8}
var
  {register} elemc : int;
{$endif}
var
  {register} temp, qval : DCTELEM;
  {register} i : int;
  {register} output_ptr : JCOEFPTR;
begin
  fdct := my_fdct_ptr (cinfo^.fdct);
  do_dct := fdct^.do_dct;
  divisors := fdct^.divisors[compptr^.quant_tbl_no];

  Inc(JSAMPROW_PTR(sample_data), start_row);	{ fold in the vertical offset once }

  for bi := 0 to pred(num_blocks) do
  begin