jcdctmgr.pas 16 KB

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