aksdb
/
CentrED
1
0
Fork 0
Code Issues 2 Pull Requests Releases Wiki Activity

⬆️ Update Vampyre Imaging lib

This commit is contained in:
Andreas Schneider 2022-05-08 10:47:53 +02:00
parent 5e47564252
commit d30f01ac64
87 changed files with 65044 additions and 63406 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
Client/UfrmRadar.lfm
View File

@ -1,28 +1,30 @@
object frmRadarMap: TfrmRadarMap object frmRadarMap: TfrmRadarMap
Left = 290 Left = 290
Height = 450 Height = 562
Top = 171 Top = 171
Width = 599 Width = 749
HorzScrollBar.Page = 478 HorzScrollBar.Page = 478
VertScrollBar.Page = 359 VertScrollBar.Page = 359
ActiveControl = sbMain ActiveControl = sbMain
Caption = 'Radar Map (1:8)' Caption = 'Radar Map (1:8)'
ClientHeight = 450 ClientHeight = 562
ClientWidth = 599 ClientWidth = 749
DesignTimePPI = 120
OnClose = FormClose OnClose = FormClose
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy OnDestroy = FormDestroy
OnResize = FormResize OnResize = FormResize
Position = poOwnerFormCenter Position = poOwnerFormCenter
ShowInTaskBar = stAlways ShowInTaskBar = stAlways
LCLVersion = '2.3.0.0'
object pnlBottom: TPanel object pnlBottom: TPanel
Left = 0 Left = 0
Height = 26 Height = 32
Top = 424 Top = 418
Width = 599 Width = 599
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 26 ClientHeight = 32
ClientWidth = 599 ClientWidth = 599
TabOrder = 0 TabOrder = 0
object lblPosition: TLabel object lblPosition: TLabel
@ -31,7 +33,7 @@ object frmRadarMap: TfrmRadarMap
Top = 0 Top = 0
Width = 1 Width = 1
Align = alLeft Align = alLeft
BorderSpacing.Left = 10 BorderSpacing.Left = 12
Color = clDefault Color = clDefault
Layout = tlCenter Layout = tlCenter
ParentColor = False ParentColor = False
@ -50,9 +52,9 @@ object frmRadarMap: TfrmRadarMap
TabOrder = 1 TabOrder = 1
object pbRadar: TPaintBox object pbRadar: TPaintBox
Left = 0 Left = 0
Height = 252 Height = 315
Top = 0 Top = 0
Width = 365 Width = 456
OnMouseDown = pbRadarMouseDown OnMouseDown = pbRadarMouseDown
OnMouseLeave = pbRadarMouseLeave OnMouseLeave = pbRadarMouseLeave
OnMouseMove = pbRadarMouseMove OnMouseMove = pbRadarMouseMove

6
Client/UfrmRadar.pas
View File

@ -113,7 +113,7 @@ begin
SetLength(radarMap, FRadar.Width * FRadar.Height); SetLength(radarMap, FRadar.Width * FRadar.Height);
for x := 0 to FRadar.Width - 1 do for x := 0 to FRadar.Width - 1 do
for y := 0 to FRadar.Height - 1 do for y := 0 to FRadar.Height - 1 do
radarMap[x * FRadar.Height + y] := EncodeUOColor(PInteger(FRadar.PixelPointers[x, y])^); radarMap[x * FRadar.Height + y] := EncodeUOColor(PInteger(FRadar.PixelPointer[x, y])^);
radarMapFile := TFileStream.Create(GetAppConfigDir(False) + 'RadarMap.cache', radarMapFile := TFileStream.Create(GetAppConfigDir(False) + 'RadarMap.cache',
fmCreate); fmCreate);
@ -213,7 +213,7 @@ begin
begin begin
x := ABuffer.ReadWord; x := ABuffer.ReadWord;
y := ABuffer.ReadWord; y := ABuffer.ReadWord;
PInteger(FRadar.PixelPointers[x, y])^ := DecodeUOColor(ABuffer.ReadWord); PInteger(FRadar.PixelPointer[x, y])^ := DecodeUOColor(ABuffer.ReadWord);
RepaintRadar; RepaintRadar;
end; end;
end; end;
@ -225,7 +225,7 @@ var
begin begin
for x := 0 to FRadar.Width - 1 do for x := 0 to FRadar.Width - 1 do
for y := 0 to FRadar.Height - 1 do for y := 0 to FRadar.Height - 1 do
PInteger(FRadar.PixelPointers[x, y])^ := DecodeUOColor(ARadarMap[x * FRadar.Height + y]); PInteger(FRadar.PixelPointer[x, y])^ := DecodeUOColor(ARadarMap[x * FRadar.Height + y]);
RepaintRadar; RepaintRadar;
end; end;

7750
Imaging/Imaging.pas
View File

File diff suppressed because it is too large Load Diff

1697
Imaging/ImagingBitmap.pas
View File

File diff suppressed because it is too large Load Diff

4291
Imaging/ImagingCanvases.pas
View File

File diff suppressed because it is too large Load Diff

2092
Imaging/ImagingClasses.pas
View File

File diff suppressed because it is too large Load Diff

475
Imaging/ImagingColors.pas
View File

@ -1,245 +1,230 @@
{ {
$Id: ImagingColors.pas 173 2009-09-04 17:05:52Z galfar $ Vampyre Imaging Library
Vampyre Imaging Library by Marek Mauder
by Marek Mauder https://github.com/galfar/imaginglib
http://imaginglib.sourceforge.net https://imaginglib.sourceforge.io
- - - - -
The contents of this file are used with permission, subject to the Mozilla This Source Code Form is subject to the terms of the Mozilla Public
Public License Version 1.1 (the "License"); you may not use this file except License, v. 2.0. If a copy of the MPL was not distributed with this
in compliance with the License. You may obtain a copy of the License at file, You can obtain one at https://mozilla.org/MPL/2.0.
http://www.mozilla.org/MPL/MPL-1.1.html }
Software distributed under the License is distributed on an "AS IS" basis, { This unit contains functions for manipulating and converting color values.}
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for unit ImagingColors;
the specific language governing rights and limitations under the License.
interface
Alternatively, the contents of this file may be used under the terms of the
GNU Lesser General Public License (the "LGPL License"), in which case the {$I ImagingOptions.inc}
provisions of the LGPL License are applicable instead of those above.
If you wish to allow use of your version of this file only under the terms uses
of the LGPL License and not to allow others to use your version of this file SysUtils, ImagingTypes, ImagingUtility;
under the MPL, indicate your decision by deleting the provisions above and
replace them with the notice and other provisions required by the LGPL { Converts RGB color to YUV.}
License. If you do not delete the provisions above, a recipient may use procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte);
your version of this file under either the MPL or the LGPL License. { Converts YIV to RGB color.}
procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte);
For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
} { Converts RGB color to YCbCr as used in JPEG.}
procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte);
{ This unit contains functions for manipulating and converting color values.} { Converts YCbCr as used in JPEG to RGB color.}
unit ImagingColors; procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte);
{ Converts RGB color to YCbCr as used in JPEG.}
interface procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word);
{ Converts YCbCr as used in JPEG to RGB color.}
{$I ImagingOptions.inc} procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word);
uses { Converts RGB color to CMY.}
SysUtils, ImagingTypes, ImagingUtility; procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte);
{ Converts CMY to RGB color.}
{ Converts RGB color to YUV.} procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte);
procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte); { Converts RGB color to CMY.}
{ Converts YIV to RGB color.} procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word);
procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte); { Converts CMY to RGB color.}
procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word);
{ Converts RGB color to YCbCr as used in JPEG.}
procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte); { Converts RGB color to CMYK.}
{ Converts YCbCr as used in JPEG to RGB color.} procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte);
procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte); { Converts CMYK to RGB color.}
{ Converts RGB color to YCbCr as used in JPEG.} procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte);
procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word); { Converts RGB color to CMYK.}
{ Converts YCbCr as used in JPEG to RGB color.} procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word);
procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word); { Converts CMYK to RGB color.}
procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word);
{ Converts RGB color to CMY.}
procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte); { Converts RGB color to YCoCg.}
{ Converts CMY to RGB color.} procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte);
procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte); { Converts YCoCg to RGB color.}
{ Converts RGB color to CMY.} procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte);
procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word);
{ Converts CMY to RGB color.} //procedure RGBToHSL(R, G, B: Byte; var H, S, L: Byte);
procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word); //procedure HSLToRGB(H, S, L: Byte; var R, G, B: Byte);
{ Converts RGB color to CMYK.} implementation
procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte);
{ Converts CMYK to RGB color.} procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte);
procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte); begin
{ Converts RGB color to CMYK.} Y := ClampToByte(Round( 0.257 * R + 0.504 * G + 0.098 * B) + 16);
procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word); V := ClampToByte(Round( 0.439 * R - 0.368 * G - 0.071 * B) + 128);
{ Converts CMYK to RGB color.} U := ClampToByte(Round(-0.148 * R - 0.291 * G + 0.439 * B) + 128);
procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word); end;
{ Converts RGB color to YCoCg.} procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte);
procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte); var
{ Converts YCoCg to RGB color.} CY, CU, CV: LongInt;
procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte); begin
CY := Y - 16;
CU := U - 128;
implementation CV := V - 128;
R := ClampToByte(Round(1.164 * CY - 0.002 * CU + 1.596 * CV));
procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte); G := ClampToByte(Round(1.164 * CY - 0.391 * CU - 0.813 * CV));
begin B := ClampToByte(Round(1.164 * CY + 2.018 * CU - 0.001 * CV));
Y := ClampToByte(Round( 0.257 * R + 0.504 * G + 0.098 * B) + 16); end;
V := ClampToByte(Round( 0.439 * R - 0.368 * G - 0.071 * B) + 128);
U := ClampToByte(Round(-0.148 * R - 0.291 * G + 0.439 * B) + 128); procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte);
end; begin
Y := ClampToByte(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B));
procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte); Cb := ClampToByte(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B + 128));
var Cr := ClampToByte(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B + 128));
CY, CU, CV: LongInt; end;
begin
CY := Y - 16; procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte);
CU := U - 128; begin
CV := V - 128; R := ClampToByte(Round(Y + 1.40200 * (Cr - 128)));
R := ClampToByte(Round(1.164 * CY - 0.002 * CU + 1.596 * CV)); G := ClampToByte(Round(Y - 0.34414 * (Cb - 128) - 0.71414 * (Cr - 128)));
G := ClampToByte(Round(1.164 * CY - 0.391 * CU - 0.813 * CV)); B := ClampToByte(Round(Y + 1.77200 * (Cb - 128)));
B := ClampToByte(Round(1.164 * CY + 2.018 * CU - 0.001 * CV)); end;
end;
procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word);
procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte); begin
begin Y := ClampToWord(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B));
Y := ClampToByte(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B)); Cb := ClampToWord(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B + 32768));
Cb := ClampToByte(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B + 128)); Cr := ClampToWord(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B + 32768));
Cr := ClampToByte(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B + 128)); end;
end;
procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word);
procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte); begin
begin R := ClampToWord(Round(Y + 1.40200 * (Cr - 32768)));
R := ClampToByte(Round(Y + 1.40200 * (Cr - 128))); G := ClampToWord(Round(Y - 0.34414 * (Cb - 32768) - 0.71414 * (Cr - 32768)));
G := ClampToByte(Round(Y - 0.34414 * (Cb - 128) - 0.71414 * (Cr - 128))); B := ClampToWord(Round(Y + 1.77200 * (Cb - 32768)));
B := ClampToByte(Round(Y + 1.77200 * (Cb - 128))); end;
end;
procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte);
procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word); begin
begin C := 255 - R;
Y := ClampToWord(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B)); M := 255 - G;
Cb := ClampToWord(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B + 32768)); Y := 255 - B;
Cr := ClampToWord(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B + 32768)); end;
end;
procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte);
procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word); begin
begin R := 255 - C;
R := ClampToWord(Round(Y + 1.40200 * (Cr - 32768))); G := 255 - M;
G := ClampToWord(Round(Y - 0.34414 * (Cb - 32768) - 0.71414 * (Cr - 32768))); B := 255 - Y;
B := ClampToWord(Round(Y + 1.77200 * (Cb - 32768))); end;
end;
procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word);
procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte); begin
begin C := 65535 - R;
C := 255 - R; M := 65535 - G;
M := 255 - G; Y := 65535 - B;
Y := 255 - B; end;
end;
procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word);
procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte); begin
begin R := 65535 - C;
R := 255 - C; G := 65535 - M;
G := 255 - M; B := 65535 - Y;
B := 255 - Y; end;
end;
procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte);
procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word); begin
begin RGBToCMY(R, G, B, C, M, Y);
C := 65535 - R; K := Min(C, Min(M, Y));
M := 65535 - G; if K = 255 then
Y := 65535 - B; begin
end; C := 0;
M := 0;
procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word); Y := 0;
begin end
R := 65535 - C; else
G := 65535 - M; begin
B := 65535 - Y; C := ClampToByte(Round((C - K) / (255 - K) * 255));
end; M := ClampToByte(Round((M - K) / (255 - K) * 255));
Y := ClampToByte(Round((Y - K) / (255 - K) * 255));
procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte); end;
begin end;
RGBToCMY(R, G, B, C, M, Y);
K := Min(C, Min(M, Y)); procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte);
if K = 255 then begin
begin R := (255 - (C - MulDiv(C, K, 255) + K));
C := 0; G := (255 - (M - MulDiv(M, K, 255) + K));
M := 0; B := (255 - (Y - MulDiv(Y, K, 255) + K));
Y := 0; end;
end
else procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word);
begin begin
C := ClampToByte(Round((C - K) / (255 - K) * 255)); RGBToCMY16(R, G, B, C, M, Y);
M := ClampToByte(Round((M - K) / (255 - K) * 255)); K := Min(C, Min(M, Y));
Y := ClampToByte(Round((Y - K) / (255 - K) * 255)); if K = 65535 then
end; begin
end; C := 0;
M := 0;
procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte); Y := 0;
begin end
R := (255 - (C - MulDiv(C, K, 255) + K)); else
G := (255 - (M - MulDiv(M, K, 255) + K)); begin
B := (255 - (Y - MulDiv(Y, K, 255) + K)); C := ClampToWord(Round((C - K) / (65535 - K) * 65535));
end; M := ClampToWord(Round((M - K) / (65535 - K) * 65535));
Y := ClampToWord(Round((Y - K) / (65535 - K) * 65535));
procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word); end;
begin end;
RGBToCMY16(R, G, B, C, M, Y);
K := Min(C, Min(M, Y)); procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word);
if K = 65535 then begin
begin R := 65535 - (C - MulDiv(C, K, 65535) + K);
C := 0; G := 65535 - (M - MulDiv(M, K, 65535) + K);
M := 0; B := 65535 - (Y - MulDiv(Y, K, 65535) + K);
Y := 0; end;
end
else procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte);
begin begin
C := ClampToWord(Round((C - K) / (65535 - K) * 65535)); // C and Delphi's SHR behaviour differs for negative numbers, use div instead.
M := ClampToWord(Round((M - K) / (65535 - K) * 65535)); Y := ClampToByte(( R + G shl 1 + B + 2) div 4);
Y := ClampToWord(Round((Y - K) / (65535 - K) * 65535)); Co := ClampToByte(( R shl 1 - B shl 1 + 2) div 4 + 128);
end; Cg := ClampToByte((-R + G shl 1 - B + 2) div 4 + 128);
end; end;
procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word); procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte);
begin var
R := 65535 - (C - MulDiv(C, K, 65535) + K); CoInt, CgInt: Integer;
G := 65535 - (M - MulDiv(M, K, 65535) + K); begin
B := 65535 - (Y - MulDiv(Y, K, 65535) + K); CoInt := Co - 128;
end; CgInt := Cg - 128;
R := ClampToByte(Y + CoInt - CgInt);
procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte); G := ClampToByte(Y + CgInt);
begin B := ClampToByte(Y - CoInt - CgInt);
// C and Delphi's SHR behaviour differs for negative numbers, use div instead. end;
Y := ClampToByte(( R + G shl 1 + B + 2) div 4);
Co := ClampToByte(( R shl 1 - B shl 1 + 2) div 4 + 128); {
Cg := ClampToByte((-R + G shl 1 - B + 2) div 4 + 128); File Notes:
end;
-- TODOS ----------------------------------------------------
procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte); - nothing now
var
CoInt, CgInt: Integer; -- 0.26.3 Changes/Bug Fixes ---------------------------------
begin - Added RGB<>YCoCg conversion functions.
CoInt := Co - 128; - Fixed RGB>>CMYK conversions.
CgInt := Cg - 128;
R := ClampToByte(Y + CoInt - CgInt); -- 0.23 Changes/Bug Fixes -----------------------------------
G := ClampToByte(Y + CgInt); - Added RGB<>CMY(K) conversion functions for 16 bit channels
B := ClampToByte(Y - CoInt - CgInt); (needed by PSD loading code).
end;
-- 0.21 Changes/Bug Fixes -----------------------------------
{ - Added some color space conversion functions and LUTs
File Notes: (RGB/YUV/YCrCb/CMY/CMYK).
-- TODOS ---------------------------------------------------- -- 0.17 Changes/Bug Fixes -----------------------------------
- nothing now - unit created (empty!)
}
-- 0.26.3 Changes/Bug Fixes ---------------------------------
- Added RGB<>YCoCg conversion functions. end.
- Fixed RGB>>CMYK conversions.
-- 0.23 Changes/Bug Fixes -----------------------------------
- Added RGB<>CMY(K) converion functions for 16 bit channels
(needed by PSD loading code).
-- 0.21 Changes/Bug Fixes -----------------------------------
- Added some color space conversion functions and LUTs
(RGB/YUV/YCrCb/CMY/CMYK).
-- 0.17 Changes/Bug Fixes -----------------------------------
- unit created (empty!)
}
end.

2672
Imaging/ImagingComponents.pas
View File

File diff suppressed because it is too large Load Diff

1993
Imaging/ImagingDds.pas
View File

File diff suppressed because it is too large Load Diff

891
Imaging/ImagingExport.pas
View File

@ -1,891 +0,0 @@
{
$Id: ImagingExport.pas 173 2009-09-04 17:05:52Z galfar $
Vampyre Imaging Library
by Marek Mauder
http://imaginglib.sourceforge.net
The contents of this file are used with permission, subject to the Mozilla
Public License Version 1.1 (the "License"); you may not use this file except
in compliance with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.
Alternatively, the contents of this file may be used under the terms of the
GNU Lesser General Public License (the "LGPL License"), in which case the
provisions of the LGPL License are applicable instead of those above.
If you wish to allow use of your version of this file only under the terms
of the LGPL License and not to allow others to use your version of this file
under the MPL, indicate your decision by deleting the provisions above and
replace them with the notice and other provisions required by the LGPL
License. If you do not delete the provisions above, a recipient may use
your version of this file under either the MPL or the LGPL License.
For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
}
{ This function contains functions exported from Imaging dynamic link library.
All string are exported as PChars and all var parameters are exported
as pointers. All posible exceptions getting out of dll are catched.}
unit ImagingExport;
{$I ImagingOptions.inc}
interface
uses
ImagingTypes,
Imaging;
{ Returns version of Imaging library. }
procedure ImGetVersion(var Major, Minor, Patch: LongInt); cdecl;
{ Look at InitImage for details.}
procedure ImInitImage(var Image: TImageData); cdecl;
{ Look at NewImage for details.}
function ImNewImage(Width, Height: LongInt; Format: TImageFormat;
var Image: TImageData): Boolean; cdecl;
{ Look at TestImage for details.}
function ImTestImage(var Image: TImageData): Boolean; cdecl;
{ Look at FreeImage for details.}
function ImFreeImage(var Image: TImageData): Boolean; cdecl;
{ Look at DetermineFileFormat for details. Ext should have enough space for
result file extension.}
function ImDetermineFileFormat(FileName, Ext: PAnsiChar): Boolean; cdecl;
{ Look at DetermineMemoryFormat for details. Ext should have enough space for
result file extension.}
function ImDetermineMemoryFormat(Data: Pointer; Size: LongInt; Ext: PAnsiChar): Boolean; cdecl;
{ Look at IsFileFormatSupported for details.}
function ImIsFileFormatSupported(FileName: PAnsiChar): Boolean; cdecl;
{ Look at EnumFileFormats for details.}
function ImEnumFileFormats(var Index: LongInt; Name, DefaultExt, Masks: PAnsiChar;
var CanSave, IsMultiImageFormat: Boolean): Boolean; cdecl;
{ Inits image list.}
function ImInitImageList(Size: LongInt; var ImageList: TImageDataList): Boolean; cdecl;
{ Returns size of image list.}
function ImGetImageListSize(ImageList: TImageDataList): LongInt; cdecl;
{ Returns image list's element at given index. Output image is not cloned it's
Bits point to Bits in list => do not free OutImage.}
function ImGetImageListElement(ImageList: TImageDataList; Index: LongInt;
var OutImage: TImageData): Boolean; cdecl;
{ Sets size of image list.}
function ImSetImageListSize(ImageList: TImageDataList; NewSize: LongInt): Boolean; cdecl;
{ Sets image list element at given index. Input image is not cloned - image in
list will point to InImage's Bits.}
function ImSetImageListElement(ImageList: TImageDataList; Index: LongInt;
const InImage: TImageData): Boolean; cdecl;
{ Returns True if all images in list pass ImTestImage test. }
function ImTestImagesInList(ImageList: TImageDataList): Boolean; cdecl;
{ Frees image list and all images in it.}
function ImFreeImageList(var ImageList: TImageDataList): Boolean; cdecl;
{ Look at LoadImageFromFile for details.}
function ImLoadImageFromFile(FileName: PAnsiChar; var Image: TImageData): Boolean; cdecl;
{ Look at LoadImageFromMemory for details.}
function ImLoadImageFromMemory(Data: Pointer; Size: LongInt; var Image: TImageData): Boolean; cdecl;
{ Look at LoadMultiImageFromFile for details.}
function ImLoadMultiImageFromFile(FileName: PAnsiChar; var ImageList: TImageDataList): Boolean; cdecl;
{ Look at LoadMultiImageFromMemory for details.}
function ImLoadMultiImageFromMemory(Data: Pointer; Size: LongInt;
var ImageList: TImageDataList): Boolean; cdecl;
{ Look at SaveImageToFile for details.}
function ImSaveImageToFile(FileName: PAnsiChar; const Image: TImageData): Boolean; cdecl;
{ Look at SaveImageToMemory for details.}
function ImSaveImageToMemory(Ext: PAnsiChar; Data: Pointer; var Size: LongInt;
const Image: TImageData): Boolean; cdecl;
{ Look at SaveMultiImageToFile for details.}
function ImSaveMultiImageToFile(FileName: PAnsiChar; ImageList: TImageDataList): Boolean; cdecl;
{ Look at SaveMultiImageToMemory for details.}
function ImSaveMultiImageToMemory(Ext: PAnsiChar; Data: Pointer; Size: PLongInt;
ImageList: TImageDataList): Boolean; cdecl;
{ Look at CloneImage for details.}
function ImCloneImage(const Image: TImageData; var Clone: TImageData): Boolean; cdecl;
{ Look at ConvertImage for details.}
function ImConvertImage(var Image: TImageData; DestFormat: TImageFormat): Boolean; cdecl;
{ Look at FlipImage for details.}
function ImFlipImage(var Image: TImageData): Boolean; cdecl;
{ Look at MirrorImage for details.}
function ImMirrorImage(var Image: TImageData): Boolean; cdecl;
{ Look at ResizeImage for details.}
function ImResizeImage(var Image: TImageData; NewWidth, NewHeight: LongInt;
Filter: TResizeFilter): Boolean; cdecl;
{ Look at SwapChannels for details.}
function ImSwapChannels(var Image: TImageData; SrcChannel, DstChannel: LongInt): Boolean; cdecl;
{ Look at ReduceColors for details.}
function ImReduceColors(var Image: TImageData; MaxColors: LongInt): Boolean; cdecl;
{ Look at GenerateMipMaps for details.}
function ImGenerateMipMaps(const Image: TImageData; Levels: LongInt;
var MipMaps: TImageDataList): Boolean; cdecl;
{ Look at MapImageToPalette for details.}
function ImMapImageToPalette(var Image: TImageData; Pal: PPalette32;
Entries: LongInt): Boolean; cdecl;
{ Look at SplitImage for details.}
function ImSplitImage(var Image: TImageData; var Chunks: TImageDataList;
ChunkWidth, ChunkHeight: LongInt; var XChunks, YChunks: LongInt;
PreserveSize: Boolean; Fill: Pointer): Boolean; cdecl;
{ Look at MakePaletteForImages for details.}
function ImMakePaletteForImages(Images: TImageDataList; Pal: PPalette32;
MaxColors: LongInt; ConvertImages: Boolean): Boolean; cdecl;
{ Look at RotateImage for details.}
function ImRotateImage(var Image: TImageData; Angle: Single): Boolean; cdecl;
{ Look at CopyRect for details.}
function ImCopyRect(const SrcImage: TImageData; SrcX, SrcY, Width, Height: LongInt;
var DstImage: TImageData; DstX, DstY: LongInt): Boolean; cdecl;
{ Look at FillRect for details.}
function ImFillRect(var Image: TImageData; X, Y, Width, Height: LongInt;
Fill: Pointer): Boolean; cdecl;
{ Look at ReplaceColor for details.}
function ImReplaceColor(var Image: TImageData; X, Y, Width, Height: LongInt;
OldPixel, NewPixel: Pointer): Boolean; cdecl;
{ Look at StretchRect for details.}
function ImStretchRect(const SrcImage: TImageData; SrcX, SrcY, SrcWidth,
SrcHeight: LongInt; var DstImage: TImageData; DstX, DstY, DstWidth,
DstHeight: LongInt; Filter: TResizeFilter): Boolean; cdecl;
{ Look at GetPixelDirect for details.}
procedure ImGetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer); cdecl;
{ Look at SetPixelDirect for details.}
procedure ImSetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer); cdecl;
{ Look at GetPixel32 for details.}
function ImGetPixel32(const Image: TImageData; X, Y: LongInt): TColor32Rec; cdecl;
{ Look at SetPixel32 for details.}
procedure ImSetPixel32(const Image: TImageData; X, Y: LongInt; const Color: TColor32Rec); cdecl;
{ Look at GetPixelFP for details.}
function ImGetPixelFP(const Image: TImageData; X, Y: LongInt): TColorFPRec; cdecl;
{ Look at SetPixelFP for details.}
procedure ImSetPixelFP(const Image: TImageData; X, Y: LongInt; const Color: TColorFPRec); cdecl;
{ Look at NewPalette for details.}
function ImNewPalette(Entries: LongInt; var Pal: PPalette32): Boolean; cdecl;
{ Look at FreePalette for details.}
function ImFreePalette(var Pal: PPalette32): Boolean; cdecl;
{ Look at CopyPalette for details.}
function ImCopyPalette(SrcPal, DstPal: PPalette32; SrcIdx, DstIdx, Count: LongInt): Boolean; cdecl;
{ Look at FindColor for details.}
function ImFindColor(Pal: PPalette32; Entries: LongInt; Color: TColor32): LongInt; cdecl;
{ Look at FillGrayscalePalette for details.}
function ImFillGrayscalePalette(Pal: PPalette32; Entries: LongInt): Boolean; cdecl;
{ Look at FillCustomPalette for details.}
function ImFillCustomPalette(Pal: PPalette32; Entries: LongInt; RBits, GBits,
BBits: Byte; Alpha: Byte): Boolean; cdecl;
{ Look at SwapChannelsOfPalette for details.}
function ImSwapChannelsOfPalette(Pal: PPalette32; Entries, SrcChannel,
DstChannel: LongInt): Boolean; cdecl;
{ Look at SetOption for details.}
function ImSetOption(OptionId, Value: LongInt): Boolean; cdecl;
{ Look at GetOption for details.}
function ImGetOption(OptionId: LongInt): LongInt; cdecl;
{ Look at PushOptions for details.}
function ImPushOptions: Boolean; cdecl;
{ Look at PopOptions for details.}
function ImPopOptions: Boolean; cdecl;
{ Look at GetImageFormatInfo for details.}
function ImGetImageFormatInfo(Format: TImageFormat; var Info: TImageFormatInfo): Boolean; cdecl;
{ Look at GetPixelsSize for details.}
function ImGetPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; cdecl;
{ Look at SetUserFileIO for details.}
procedure ImSetUserFileIO(OpenReadProc: TOpenReadProc; OpenWriteProc:
TOpenWriteProc; CloseProc: TCloseProc; EofProc: TEofProc; SeekProc: TSeekProc;
TellProc: TTellProc; ReadProc: TReadProc; WriteProc: TWriteProc); cdecl;
{ Look at ResetFileIO for details.}
procedure ImResetFileIO; cdecl;
{ These are only for documentation generation reasons.}
{ Loads Imaging functions from dll/so library.}
function ImLoadLibrary: Boolean;
{ Frees Imaging functions loaded from dll/so and releases library.}
function ImFreeLibrary: Boolean;
implementation
uses
SysUtils,
ImagingUtility;
function ImLoadLibrary: Boolean; begin Result := True; end;
function ImFreeLibrary: Boolean; begin Result := True; end;
type
TInternalList = record
List: TDynImageDataArray;
end;
PInternalList = ^TInternalList;
procedure ImGetVersion(var Major, Minor, Patch: LongInt);
begin
Major := ImagingVersionMajor;
Minor := ImagingVersionMinor;
Patch := ImagingVersionPatch;
end;
procedure ImInitImage(var Image: TImageData);
begin
try
Imaging.InitImage(Image);
except
end;
end;
function ImNewImage(Width, Height: LongInt; Format: TImageFormat;
var Image: TImageData): Boolean;
begin
try
Result := Imaging.NewImage(Width, Height, Format, Image);
except
Result := False;
end;
end;
function ImTestImage(var Image: TImageData): Boolean;
begin
try
Result := Imaging.TestImage(Image);
except
Result := False;
end;
end;
function ImFreeImage(var Image: TImageData): Boolean;
begin
try
Imaging.FreeImage(Image);
Result := True;
except
Result := False;
end;
end;
function ImDetermineFileFormat(FileName, Ext: PAnsiChar): Boolean;
var
S: string;
begin
try
S := Imaging.DetermineFileFormat(FileName);
Result := S <> '';
StrCopy(Ext, PAnsiChar(AnsiString(S)));
except
Result := False;
end;
end;
function ImDetermineMemoryFormat(Data: Pointer; Size: LongInt; Ext: PAnsiChar): Boolean;
var
S: string;
begin
try
S := Imaging.DetermineMemoryFormat(Data, Size);
Result := S <> '';
StrCopy(Ext, PAnsiChar(AnsiString(S)));
except
Result := False;
end;
end;
function ImIsFileFormatSupported(FileName: PAnsiChar): Boolean;
begin
try
Result := Imaging.IsFileFormatSupported(FileName);
except
Result := False;
end;
end;
function ImEnumFileFormats(var Index: LongInt; Name, DefaultExt, Masks: PAnsiChar;
var CanSave, IsMultiImageFormat: Boolean): Boolean;
var
StrName, StrDefaultExt, StrMasks: string;
begin
try
Result := Imaging.EnumFileFormats(Index, StrName, StrDefaultExt, StrMasks, CanSave,
IsMultiImageFormat);
StrCopy(Name, PAnsiChar(AnsiString(StrName)));
StrCopy(DefaultExt, PAnsiChar(AnsiString(StrDefaultExt)));
StrCopy(Masks, PAnsiChar(AnsiString(StrMasks)));
except
Result := False;
end;
end;
function ImInitImageList(Size: LongInt; var ImageList: TImageDataList): Boolean;
var
Int: PInternalList;
begin
try
try
ImFreeImageList(ImageList);
except
end;
New(Int);
SetLength(Int.List, Size);
ImageList := TImageDataList(Int);
Result := True;
except
Result := False;
ImageList := nil;
end;
end;
function ImGetImageListSize(ImageList: TImageDataList): LongInt;
begin
try
Result := Length(PInternalList(ImageList).List);
except
Result := -1;
end;
end;
function ImGetImageListElement(ImageList: TImageDataList; Index: LongInt;
var OutImage: TImageData): Boolean;
begin
try
Index := ClampInt(Index, 0, Length(PInternalList(ImageList).List) - 1);
ImCloneImage(PInternalList(ImageList).List[Index], OutImage);
Result := True;
except
Result := False;
end;
end;
function ImSetImageListSize(ImageList: TImageDataList; NewSize: LongInt):
Boolean;
var
I, OldSize: LongInt;
begin
try
OldSize := Length(PInternalList(ImageList).List);
if NewSize < OldSize then
for I := NewSize to OldSize - 1 do
Imaging.FreeImage(PInternalList(ImageList).List[I]);
SetLength(PInternalList(ImageList).List, NewSize);
Result := True;
except
Result := False;
end;
end;
function ImSetImageListElement(ImageList: TImageDataList; Index: LongInt;
const InImage: TImageData): Boolean;
begin
try
Index := ClampInt(Index, 0, Length(PInternalList(ImageList).List) - 1);
ImCloneImage(InImage, PInternalList(ImageList).List[Index]);
Result := True;
except
Result := False;
end;
end;
function ImTestImagesInList(ImageList: TImageDataList): Boolean;
var
I: LongInt;
Arr: TDynImageDataArray;
begin
Arr := nil;
try
Arr := PInternalList(ImageList).List;
Result := True;
for I := 0 to Length(Arr) - 1 do
begin
Result := Result and Imaging.TestImage(Arr[I]);
if not Result then Break;
end;
except
Result := False;
end;
end;
function ImFreeImageList(var ImageList: TImageDataList): Boolean;
var
Int: PInternalList;
begin
try
if ImageList <> nil then
begin
Int := PInternalList(ImageList);
FreeImagesInArray(Int.List);
Dispose(Int);
ImageList := nil;
end;
Result := True;
except
Result := False;
end;
end;
function ImLoadImageFromFile(FileName: PAnsiChar; var Image: TImageData): Boolean;
begin
try
Result := Imaging.LoadImageFromFile(FileName, Image);
except
Result := False;
end;
end;
function ImLoadImageFromMemory(Data: Pointer; Size: LongInt; var Image: TImageData): Boolean;
begin
try
Result := Imaging.LoadImageFromMemory(Data, Size, Image);
except
Result := False;
end;
end;
function ImLoadMultiImageFromFile(FileName: PAnsiChar; var ImageList: TImageDataList):
Boolean;
begin
try
ImInitImageList(0, ImageList);
Result := Imaging.LoadMultiImageFromFile(FileName,
PInternalList(ImageList).List);
except
Result := False;
end;
end;
function ImLoadMultiImageFromMemory(Data: Pointer; Size: LongInt;
var ImageList: TImageDataList): Boolean;
begin
try
ImInitImageList(0, ImageList);
Result := Imaging.LoadMultiImageFromMemory(Data, Size, PInternalList(ImageList).List);
except
Result := False;
end;
end;
function ImSaveImageToFile(FileName: PAnsiChar; const Image: TImageData): Boolean;
begin
try
Result := Imaging.SaveImageToFile(FileName, Image);
except
Result := False;
end;
end;
function ImSaveImageToMemory(Ext: PAnsiChar; Data: Pointer; var Size: LongInt;
const Image: TImageData): Boolean;
begin
try
Result := Imaging.SaveImageToMemory(Ext, Data, Size, Image);
except
Result := False;
end;
end;
function ImSaveMultiImageToFile(FileName: PAnsiChar;
ImageList: TImageDataList): Boolean;
begin
try
Result := Imaging.SaveMultiImageToFile(FileName,
PInternalList(ImageList).List);
except
Result := False;
end;
end;
function ImSaveMultiImageToMemory(Ext: PAnsiChar; Data: Pointer; Size: PLongInt;
ImageList: TImageDataList): Boolean;
begin
try
Result := Imaging.SaveMultiImageToMemory(Ext, Data, Size^,
PInternalList(ImageList).List);
except
Result := False;
end;
end;
function ImCloneImage(const Image: TImageData; var Clone: TImageData): Boolean;
begin
try
Result := Imaging.CloneImage(Image, Clone);
except
Result := False;
end;
end;
function ImConvertImage(var Image: TImageData; DestFormat: TImageFormat): Boolean;
begin
try
Result := Imaging.ConvertImage(Image, DestFormat);
except
Result := False;
end;
end;
function ImFlipImage(var Image: TImageData): Boolean;
begin
try
Result := Imaging.FlipImage(Image);
except
Result := False;
end;
end;
function ImMirrorImage(var Image: TImageData): Boolean;
begin
try
Result := Imaging.MirrorImage(Image);
except
Result := False;
end;
end;
function ImResizeImage(var Image: TImageData; NewWidth, NewHeight: LongInt;
Filter: TResizeFilter): Boolean;
begin
try
Result := Imaging.ResizeImage(Image, NewWidth, NewHeight, Filter);
except
Result := False;
end;
end;
function ImSwapChannels(var Image: TImageData; SrcChannel, DstChannel: LongInt):
Boolean;
begin
try
Result := Imaging.SwapChannels(Image, SrcChannel, DstChannel);
except
Result := False;
end;
end;
function ImReduceColors(var Image: TImageData; MaxColors: LongInt): Boolean;
begin
try
Result := Imaging.ReduceColors(Image, MaxColors);
except
Result := False;
end;
end;
function ImGenerateMipMaps(const Image: TImageData; Levels: LongInt;
var MipMaps: TImageDataList): Boolean;
begin
try
ImInitImageList(0, MipMaps);
Result := Imaging.GenerateMipMaps(Image, Levels,
PInternalList(MipMaps).List);
except
Result := False;
end;
end;
function ImMapImageToPalette(var Image: TImageData; Pal: PPalette32;
Entries: LongInt): Boolean;
begin
try
Result := Imaging.MapImageToPalette(Image, Pal, Entries);
except
Result := False;
end;
end;
function ImSplitImage(var Image: TImageData; var Chunks: TImageDataList;
ChunkWidth, ChunkHeight: LongInt; var XChunks, YChunks: LongInt;
PreserveSize: Boolean; Fill: Pointer): Boolean;
begin
try
ImInitImageList(0, Chunks);
Result := Imaging.SplitImage(Image, PInternalList(Chunks).List,
ChunkWidth, ChunkHeight, XChunks, YChunks, PreserveSize, Fill);
except
Result := False;
end;
end;
function ImMakePaletteForImages(Images: TImageDataList; Pal: PPalette32;
MaxColors: LongInt; ConvertImages: Boolean): Boolean;
begin
try
Result := Imaging.MakePaletteForImages(PInternalList(Images).List,
Pal, MaxColors, ConvertImages);
except
Result := False;
end;
end;
function ImRotateImage(var Image: TImageData; Angle: Single): Boolean;
begin
try
Result := Imaging.RotateImage(Image, Angle);
except
Result := False;
end;
end;
function ImCopyRect(const SrcImage: TImageData; SrcX, SrcY, Width, Height: LongInt;
var DstImage: TImageData; DstX, DstY: LongInt): Boolean; cdecl;
begin
try
Result := Imaging.CopyRect(SrcImage, SrcX, SrcY, Width, Height,
DstImage, DstX, DstY);
except
Result := False;
end;
end;
function ImFillRect(var Image: TImageData; X, Y, Width, Height: LongInt;
Fill: Pointer): Boolean;
begin
try
Result := Imaging.FillRect(Image, X, Y, Width, Height, Fill);
except
Result := False;
end;
end;
function ImReplaceColor(var Image: TImageData; X, Y, Width, Height: LongInt;
OldPixel, NewPixel: Pointer): Boolean;
begin
try
Result := Imaging.ReplaceColor(Image, X, Y, Width, Height, OldPixel, NewPixel);
except
Result := False;
end;
end;
function ImStretchRect(const SrcImage: TImageData; SrcX, SrcY, SrcWidth,
SrcHeight: LongInt; var DstImage: TImageData; DstX, DstY, DstWidth,
DstHeight: LongInt; Filter: TResizeFilter): Boolean; cdecl;
begin
try
Result := Imaging.StretchRect(SrcImage, SrcX, SrcY, SrcWidth, SrcHeight,
DstImage, DstX, DstY, DstWidth, DstHeight, Filter);
except
Result := False;
end;
end;
procedure ImGetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer);
begin
try
Imaging.GetPixelDirect(Image, X, Y, Pixel);
except
end;
end;
procedure ImSetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer);
begin
try
Imaging.SetPixelDirect(Image, X, Y, Pixel);
except
end;
end;
function ImGetPixel32(const Image: TImageData; X, Y: LongInt): TColor32Rec; cdecl;
begin
try
Result := Imaging.GetPixel32(Image, X, Y);
except
Result.Color := 0;
end;
end;
procedure ImSetPixel32(const Image: TImageData; X, Y: LongInt; const Color: TColor32Rec);
begin
try
Imaging.SetPixel32(Image, X, Y, Color);
except
end;
end;
function ImGetPixelFP(const Image: TImageData; X, Y: LongInt): TColorFPRec; cdecl;
begin
try
Result := Imaging.GetPixelFP(Image, X, Y);
except
FillChar(Result, SizeOf(Result), 0);
end;
end;
procedure ImSetPixelFP(const Image: TImageData; X, Y: LongInt; const Color: TColorFPRec);
begin
try
Imaging.SetPixelFP(Image, X, Y, Color);
except
end;
end;
function ImNewPalette(Entries: LongInt; var Pal: PPalette32): Boolean;
begin
try
Imaging.NewPalette(Entries, Pal);
Result := True;
except
Result := False;
end;
end;
function ImFreePalette(var Pal: PPalette32): Boolean;
begin
try
Imaging.FreePalette(Pal);
Result := True;
except
Result := False;
end;
end;
function ImCopyPalette(SrcPal, DstPal: PPalette32; SrcIdx, DstIdx, Count: LongInt): Boolean;
begin
try
Imaging.CopyPalette(SrcPal, DstPal, SrcIdx, DstIdx, Count);
Result := True;
except
Result := False;
end;
end;
function ImFindColor(Pal: PPalette32; Entries: LongInt; Color: TColor32): LongInt;
begin
try
Result := Imaging.FindColor(Pal, Entries, Color);
except
Result := 0;
end;
end;
function ImFillGrayscalePalette(Pal: PPalette32; Entries: LongInt): Boolean;
begin
try
Imaging.FillGrayscalePalette(Pal, Entries);
Result := True;
except
Result := False;
end;
end;
function ImFillCustomPalette(Pal: PPalette32; Entries: LongInt; RBits, GBits,
BBits: Byte; Alpha: Byte): Boolean;
begin
try
Imaging.FillCustomPalette(Pal, Entries, RBits, GBits, BBits, Alpha);
Result := True;
except
Result := False;
end;
end;
function ImSwapChannelsOfPalette(Pal: PPalette32; Entries, SrcChannel,
DstChannel: LongInt): Boolean;
begin
try
Imaging.SwapChannelsOfPalette(Pal, Entries, SrcChannel, DstChannel);
Result := True;
except
Result := False;
end;
end;
function ImSetOption(OptionId, Value: LongInt): Boolean;
begin
try
Result := Imaging.SetOption(OptionId, Value);
except
Result := False;
end;
end;
function ImGetOption(OptionId: LongInt): LongInt;
begin
try
Result := GetOption(OptionId);
except
Result := InvalidOption;
end;
end;
function ImPushOptions: Boolean;
begin
try
Result := Imaging.PushOptions;
except
Result := False;
end;
end;
function ImPopOptions: Boolean;
begin
try
Result := Imaging.PopOptions;
except
Result := False;
end;
end;
function ImGetImageFormatInfo(Format: TImageFormat; var Info: TImageFormatInfo): Boolean;
begin
try
Result := Imaging.GetImageFormatInfo(Format, Info);
except
Result := False;
end;
end;
function ImGetPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt;
begin
try
Result := Imaging.GetPixelsSize(Format, Width, Height);
except
Result := 0;
end;
end;
procedure ImSetUserFileIO(OpenReadProc: TOpenReadProc; OpenWriteProc:
TOpenWriteProc; CloseProc: TCloseProc; EofProc: TEofProc; SeekProc: TSeekProc;
TellProc: TTellProc; ReadProc: TReadProc; WriteProc: TWriteProc);
begin
try
Imaging.SetUserFileIO(OpenReadProc, OpenWriteProc, CloseProc, EofProc,
SeekProc, TellProc, ReadProc, WriteProc);
except
end;
end;
procedure ImResetFileIO;
begin
try
Imaging.ResetFileIO;
except
end;
end;
{
Changes/Bug Fixes:
-- TODOS ----------------------------------------------------
- nothing now
-- 0.26.3 ---------------------------------------------------
- changed PChars to PAnsiChars and some more D2009 friendly
casts.
-- 0.19 -----------------------------------------------------
- updated to reflect changes in low level interface (added pixel set/get, ...)
- changed ImInitImage to procedure to reflect change in Imaging.pas
- added ImIsFileFormatSupported
-- 0.15 -----------------------------------------------------
- behaviour of ImGetImageListElement and ImSetImageListElement
has changed - list items are now cloned rather than referenced,
because of this ImFreeImageListKeepImages was no longer needed
and was removed
- many function headers were changed - mainly pointers were
replaced with var and const parameters
-- 0.13 -----------------------------------------------------
- added TestImagesInList function and new 0.13 functions
- images were not freed when image list was resized in ImSetImageListSize
- ImSaveMultiImageTo* recreated the input image list with size = 0
}
end.

8723
Imaging/ImagingFormats.pas
View File

File diff suppressed because it is too large Load Diff

2514
Imaging/ImagingGif.pas
View File

File diff suppressed because it is too large Load Diff

1243
Imaging/ImagingIO.pas
View File

File diff suppressed because it is too large Load Diff

1346
Imaging/ImagingJpeg.pas
View File

File diff suppressed because it is too large Load Diff

5272
Imaging/ImagingNetworkGraphics.pas
View File

File diff suppressed because it is too large Load Diff

1871
Imaging/ImagingOpenGL.pas
View File

File diff suppressed because it is too large Load Diff

416
Imaging/ImagingOptions.inc
View File

@ -1,188 +1,228 @@
{ $Id: ImagingOptions.inc 174 2009-09-08 09:37:59Z galfar $ } {
User Options
{ Following defines and options can be changed by user.
User Options }
Following defines and options can be changed by user.
} { Source options }
{ Source options } {$DEFINE USE_INLINE} // Use function inlining for some functions
// works in Free Pascal and Delphi 9+.
{$DEFINE USE_INLINE} // Use function inlining for some functions {$DEFINE USE_ASM} // If defined, assembler versions of some
// works in Free Pascal and Delphi 9+. // functions will be used (only for x86).
{.$DEFINE USE_ASM} // Ff defined, assembler versions of some
// functions will be used (only for x86). // Debug options: If none of these two are defined
// your project settings are used.
// Debug options: If none of these two are defined {.$DEFINE IMAGING_DEBUG} // If defined, debug info, range/IO/overflow
// your project settings are used. // checking, stack frames, assertions, and
{ $DEFINE IMAGING_DEBUG} // If defined, debug info, range/IO/overflow // other debugging options will be turned on.
// checking, stack frames, assertions, and {$DEFINE IMAGING_RELEASE} // If defined, all debug info is off.
// other debugging options will be turned on.
{$DEFINE IMAGING_RELEASE} // If defined, all debug info is off. {$DEFINE OPENGL_NO_EXT_HEADERS}
(* File format support linking options. (* File format support linking options.
Define formats which you don't want to be registred automatically. Define formats which you don't want to be registered automatically (by adding
Default: all formats are registered = no symbols defined. Imaging.pas unit to your uses clause).
Example: If you want to disable JPEG support just uncomment //{$DEFINE DONT_LINK_JPEG} line Default: most formats are registered = no symbols defined.
*) Example: If you want to disable JPEG support just uncomment //{$DEFINE DONT_LINK_JPEG} line
*)
{$DEFINE DONT_LINK_JPEG} // link support for Jpeg images
{.$DEFINE DONT_LINK_PNG} // link support for PNG images {$DEFINE DONT_LINK_JPEG} // link support for Jpeg images
{.$DEFINE DONT_LINK_TARGA} // link support for Targa images {.$DEFINE DONT_LINK_PNG} // link support for PNG images
{.$DEFINE DONT_LINK_BITMAP} // link support for Windows Bitmap images {.$DEFINE DONT_LINK_TARGA} // link support for Targa images
{$DEFINE DONT_LINK_DDS} // link support for DDS images {.$DEFINE DONT_LINK_BITMAP} // link support for Windows Bitmap images
{$DEFINE DONT_LINK_GIF} // link support for GIF images {$DEFINE DONT_LINK_DDS} // link support for DDS images
{$DEFINE DONT_LINK_MNG} // link support for MNG images {$DEFINE DONT_LINK_GIF} // link support for GIF images
{$DEFINE DONT_LINK_JNG} // link support for JNG images {$DEFINE DONT_LINK_MNG} // link support for MNG images
{$DEFINE DONT_LINK_PNM} // link support for PortableMap images (PBM, PGM, PPM, PAM, PFM) {$DEFINE DONT_LINK_JNG} // link support for JNG images
{$DEFINE DONT_LINK_PNM} // link support for PortableMap images (PBM, PGM, PPM, PAM, PFM)
{$DEFINE DONT_LINK_EXTRAS} // link support for file formats defined in {$DEFINE DONT_LINK_RADHDR} // link support for Radiance HDR/RGBE file format
// Extras package. Exactly which formats will be
// registered depends on settings in {$DEFINE DONT_LINK_EXTRAS} // link support for file formats defined in
// ImagingExtras.pas unit. // Extensions package. Exactly which formats will be
// registered depends on settings in
{ Component set used in ImagignComponents.pas unit. You usually don't need // ImagingExtFileFormats.pas unit.
to be concerned with this - proper component library is selected automatically
according to your compiler. } {.$DEFINE DONT_LINK_FILE_FORMATS} // no auto link support of any file format
{ $DEFINE COMPONENT_SET_VCL} // use Delphi VCL {
{$DEFINE COMPONENT_SET_LCL} // use Lazarus LCL (set automatically when compiling with FPC) Auto Options
Following options and defines are set automatically and some
{ are required for Imaging to compile successfully. Do not change
Auto Options anything here if you don't know what you are doing.
Following options and defines are set automatically and some }
are required for Imaging to compile successfully. Do not change
anything here if you don't know what you are doing. { Compiler options }
}
{$ALIGN ON} // Field alignment: 8 Bytes (in D6+)
{ Compiler options } {$BOOLEVAL OFF} // Boolean eval: off
{$EXTENDEDSYNTAX ON} // Extended syntax: on
{$ALIGN ON} // Field alignment: 8 Bytes (in D6+) {$LONGSTRINGS ON} // string = AnsiString: on
{$BOOLEVAL OFF} // Boolean eval: off {$MINENUMSIZE 1} // Min enum size: 1 B
{$EXTENDEDSYNTAX ON} // Extended syntax: on {$TYPEDADDRESS OFF} // Typed pointers: off
{$LONGSTRINGS ON} // string = AnsiString: on {$WRITEABLECONST OFF} // Writeable constants: off
{$MINENUMSIZE 4} // Min enum size: 4 B
{$TYPEDADDRESS OFF} // Typed pointers: off {$IFNDEF FPC}
{$WRITEABLECONST OFF} // Writeable constants: off {$DEFINE DCC} // if not using FPC then DCC compiler is used (Delphi/BCB)
// others are not supported
{$IFNDEF FPC} {$ENDIF}
{$DEFINE DCC} // if not using FPC then DCC compiler is used (Delphi/Kylix)
// others are not supported {$IFDEF DCC}
{$ENDIF} {$DEFINE DELPHI}
{$IF (Defined(DCC) and (CompilerVersion >= 25.0))}
{$IFDEF DCC} {$LEGACYIFEND ON}
{$IFDEF LINUX} {$IFEND}
{$DEFINE KYLIX} // using Kylix {$ENDIF}
{$ENDIF}
{$ENDIF} {$IF (Defined(DCC) and (CompilerVersion >= 18.5))}
{$IFDEF RELEASE}
{$IFDEF DCC} {$UNDEF DEBUG} // If we are using Delphi 2007+ where you can set
{$IFNDEF KYLIX} // DEBUG/RELEASE mode in project options and RELEASE
{$DEFINE DELPHI} // using Delphi // is currently set we undef DEBUG mode
{$ENDIF} {$ENDIF}
{$ENDIF} {$IFEND}
{$IF Defined(IMAGING_DEBUG)} {$IF Defined(IMAGING_DEBUG)}
{$ASSERTIONS ON} {$ASSERTIONS ON}
{$DEBUGINFO ON} {$DEBUGINFO ON}
{$RANGECHECKS ON} {$RANGECHECKS ON}
{$IOCHECKS ON} {$IOCHECKS ON}
{$OVERFLOWCHECKS ON} {$OVERFLOWCHECKS ON}
{$IFDEF DCC} {$IFDEF DCC}
{$OPTIMIZATION OFF} {$OPTIMIZATION OFF}
{$STACKFRAMES ON} {$STACKFRAMES ON}
{$LOCALSYMBOLS ON} {$LOCALSYMBOLS ON}
{$DEFINE MEMCHECK} {$DEFINE MEMCHECK}
{$ENDIF} {$ENDIF}
{$IFDEF FPC} {$IFDEF FPC}
{$S+} {$S+}
{$CHECKPOINTER ON} {$CHECKPOINTER ON}
{$ENDIF} {$ENDIF}
{$ELSEIF Defined(IMAGING_RELEASE)} {$ELSEIF Defined(IMAGING_RELEASE)}
{$ASSERTIONS OFF} {$ASSERTIONS OFF}
{$DEBUGINFO OFF} {$DEBUGINFO OFF}
{$RANGECHECKS OFF} {$RANGECHECKS OFF}
{$IOCHECKS OFF} {$IOCHECKS OFF}
{$OVERFLOWCHECKS OFF} {$OVERFLOWCHECKS OFF}
{$IFDEF DCC} {$IFDEF DCC}
{$OPTIMIZATION ON} {$OPTIMIZATION ON}
{$STACKFRAMES OFF} {$STACKFRAMES OFF}
{$LOCALSYMBOLS OFF} {$LOCALSYMBOLS OFF}
{$ENDIF} {$ENDIF}
{$IFDEF FPC} {$IFDEF FPC}
{$S-} {$S-}
{$ENDIF} {$ENDIF}
{$IFEND} {$IFEND}
{$IF Defined(CPU86) and not Defined(CPUX86)}
{ Compiler capabilities } {$DEFINE CPUX86} // Compatibility with Delphi
{$IFEND}
// Define if compiler supports inlining of functions and procedures
// Note that FPC inline support crashed in older versions (1.9.8) {$IF Defined(CPUX86_64) and not Defined(CPUX64)}
{$IF (Defined(FPC) and Defined(CPU86))} {$DEFINE CPUX64} // Compatibility with Delphi
{$DEFINE HAS_INLINE} {$IFEND}
{$IFEND}
{$IF Defined(DARWIN) and not Defined(MACOS)}
// Define if compiler supports operator overloading {$DEFINE MACOS} // Compatibility with Delphi
// (unfortunately Delphi and FPC operator overloaing is not compatible) {$IFEND}
{$IF Defined(FPC)} {$IF Defined(MACOS)}
{$DEFINE HAS_OPERATOR_OVERLOADING} {$DEFINE MACOSX}
{$IFEND} {$IFEND}
{ Imaging options check} {$IF Defined(DCC) and (CompilerVersion < 23)} // < XE2
{$DEFINE CPUX86} // Compatibility with older Delphi
{$IFNDEF HAS_INLINE} {$IFEND}
{$UNDEF USE_INLINE}
{$ENDIF} {$IF Defined(WIN32) or Defined(WIN64)}
{$DEFINE MSWINDOWS} // Compatibility with Delphi
{$IFDEF FPC} {$IFEND}
{$IFNDEF CPU86}
{$UNDEF USE_ASM} {$IF Defined(UNIX) and not Defined(POSIX)}
{$ENDIF} {$DEFINE POSIX} // Compatibility with Delphi
{$ENDIF} {$IFEND}
{$IFDEF FPC} { Compiler capabilities }
{$DEFINE COMPONENT_SET_LCL}
{$UNDEF COMPONENT_SET_VCL} // Define if compiler supports inlining of functions and procedures
{$ENDIF} {$IF (Defined(DCC) and (CompilerVersion >= 17)) or Defined(FPC)}
{$DEFINE HAS_INLINE}
{$IFDEF DELPHI} {$IFEND}
{$UNDEF COMPONENT_SET_LCL}
{$DEFINE COMPONENT_SET_VCL} // Define if compiler supports advanced records with methods
{$ENDIF} {$IF (Defined(DCC) and (CompilerVersion >= 18)) or
(Defined(FPC) and (FPC_FULLVERSION >= 20600))}
{ Platform options } {$DEFINE HAS_ADVANCED_RECORDS}
{$IFEND}
{$IFDEF WIN32}
{$DEFINE MSWINDOWS} // Define if compiler supports operator overloading
{$ENDIF} // (unfortunately Delphi and FPC operator overloading is not compatible).
// FPC supports Delphi compatible operator overloads since 2.6.0
{$IFDEF DPMI} {$IF (Defined(DCC) and (CompilerVersion >= 18)) or
{$DEFINE MSDOS} (Defined(FPC) and (FPC_FULLVERSION >= 20600))}
{$ENDIF} {$DEFINE HAS_OPERATOR_OVERLOADING}
{$IFEND}
{$IFDEF LINUX}
{$DEFINE UNIX} // Anonymous methods
{$ENDIF} {$IF Defined(DCC) and (CompilerVersion >= 20) }
{$DEFINE HAS_ANON_METHODS}
{ More compiler options } {$IFEND}
{$IFDEF FPC} // Free Pascal options - some options set above (like min enum size) // Generic types (Delphi and FPC implementations incompatible).
// are reset to defaults by setting {$MODE} so they are // Update: FPC supports Delphi compatible generics since 2.6.0
// redeclared here {$IF (Defined(DCC) and (CompilerVersion >= 20)) or
{$MODE DELPHI} // compatible with delphi (Defined(FPC) and (FPC_FULLVERSION >= 20600))}
{$GOTO ON} // alow goto {$DEFINE HAS_GENERICS}
{$PACKRECORDS 8} // same as ALING 8 for Delphi {$IFEND}
{$PACKENUM 4} // Min enum size: 4 B
{$CALLING REGISTER} // default calling convention is register { Compiler pecularities }
{$IFDEF CPU86}
{$ASMMODE INTEL} // intel assembler mode // Delphi 64bit POSIX targets
{$ENDIF} {$IF Defined(DCC) and (SizeOf(Integer) <> SizeOf(LongInt))}
{$ENDIF} {$DEFINE LONGINT_IS_NOT_INTEGER}
{$IFEND}
{$IFDEF HAS_INLINE}
{$INLINE ON} // turns inlining on for compilers that support it // They used to force IFEND, now they warn about it
{$ENDIF} {$IF Defined(DCC) and (CompilerVersion >= 33)}
{$LEGACYIFEND ON}
{$IFEND}
{ Imaging options check}
{$IFNDEF HAS_INLINE}
{$UNDEF USE_INLINE}
{$ENDIF}
{$IF not Defined(CPUX86)}
{$UNDEF USE_ASM}
{$IFEND}
{$IFDEF FPC}
{$DEFINE COMPONENT_SET_LCL}
{$UNDEF COMPONENT_SET_VCL}
{$ENDIF}
{$IFDEF DELPHI}
{$UNDEF COMPONENT_SET_LCL}
{$DEFINE COMPONENT_SET_VCL}
{$ENDIF}
{ More compiler options }
{$IFDEF FPC} // Free Pascal options - some options set above (like min enum size)
// are reset to defaults by setting {$MODE} so they are
// redeclared here
{$MODE DELPHI} // compatible with delphi
{$GOTO ON} // alow goto
{$PACKRECORDS 8} // same as ALING 8 for Delphi
{$PACKENUM 4} // Min enum size: 4 B
{$IFDEF CPU86}
{$ASMMODE INTEL} // intel assembler mode
{$ENDIF}
{$ENDIF}
{$IFDEF HAS_INLINE}
{$INLINE ON} // turns inlining on for compilers that support it
{$ENDIF}

1981
Imaging/ImagingPortableMaps.pas
View File

File diff suppressed because it is too large Load Diff

480
Imaging/ImagingRadiance.pas Normal file
View File

@ -0,0 +1,480 @@
{
Vampyre Imaging Library
by Marek Mauder
https://github.com/galfar/imaginglib
https://imaginglib.sourceforge.io
- - - - -
This Source Code Form is subject to the terms of the Mozilla Public
License, v. 2.0. If a copy of the MPL was not distributed with this
file, You can obtain one at https://mozilla.org/MPL/2.0.
}
{ This unit contains image format loader/saver for Radiance HDR/RGBE images.}
unit ImagingRadiance;
{$I ImagingOptions.inc}
interface
uses
SysUtils, Classes, Imaging, ImagingTypes, ImagingUtility;
type
{ Radiance is a suite of tools for performing lighting simulation. It's
development started in 1985 and it pioneered the concept of
high dynamic range imaging. Radiance defined an image format for storing
HDR images, now described as RGBE image format. Since it was the first
HDR image format, this format is supported by many other software packages.
Radiance image file consists of three sections: a header, resolution string,
followed by the pixel data. Each pixel is stored as 4 bytes, one byte
mantissa for each r, g, b and a shared one byte exponent.
The pixel data may be stored uncompressed or using run length encoding.
Imaging translates RGBE pixels to original float values and stores them
in ifR32G32B32F data format. It can read both compressed and uncompressed
files, and saves files as compressed.}
THdrFileFormat = class(TImageFileFormat)
protected
procedure Define; override;
function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
OnlyFirstLevel: Boolean): Boolean; override;
function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
Index: LongInt): Boolean; override;
procedure ConvertToSupported(var Image: TImageData;
const Info: TImageFormatInfo); override;
public
function TestFormat(Handle: TImagingHandle): Boolean; override;
end;
implementation
uses
Math, ImagingIO;
const
SHdrFormatName = 'Radiance HDR/RGBE';
SHdrMasks = '*.hdr';
HdrSupportedFormats: TImageFormats = [ifR32G32B32F];
type
TSignature = array[0..9] of AnsiChar;
THdrFormat = (hfRgb, hfXyz);
THdrHeader = record
Format: THdrFormat;
Width: Integer;
Height: Integer;
end;
TRgbe = packed record
R, G, B, E: Byte;
end;
TDynRgbeArray = array of TRgbe;
const
RadianceSignature: TSignature = '#?RADIANCE';
RgbeSignature: TSignature = '#?RGBE';
SFmtRgbeRle = '32-bit_rle_rgbe';
SFmtXyzeRle = '32-bit_rle_xyze';
resourcestring
SErrorBadHeader = 'Bad HDR/RGBE header format.';
SWrongScanLineWidth = 'Wrong scanline width.';
SXyzNotSupported = 'XYZ color space not supported.';
{ THdrFileFormat }
procedure THdrFileFormat.Define;
begin
inherited;
FName := SHdrFormatName;
FFeatures := [ffLoad, ffSave];
FSupportedFormats := HdrSupportedFormats;
AddMasks(SHdrMasks);
end;
function THdrFileFormat.LoadData(Handle: TImagingHandle;
var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
var
Header: THdrHeader;
IO: TIOFunctions;
function ReadHeader: Boolean;
const
CommentIds: TAnsiCharSet = ['#', '!'];
var
Line: AnsiString;
HasResolution: Boolean;
Count, Idx: Integer;
ValStr, NativeLine: string;
ValFloat: Double;
begin
Result := False;
HasResolution := False;
Count := 0;
repeat
if not ReadLine(IO, Handle, Line) then
Exit;
Inc(Count);
if Count > 16 then // Too long header for HDR
Exit;
if Length(Line) = 0 then
Continue;
if Line[1] in CommentIds then
Continue;
NativeLine := string(Line);
if StrMaskMatch(NativeLine, 'Format=*') then
begin
// Data format parsing
ValStr := Copy(NativeLine, 8, MaxInt);
if ValStr = SFmtRgbeRle then
Header.Format := hfRgb
else if ValStr = SFmtXyzeRle then
Header.Format := hfXyz
else
Exit;
end;
if StrMaskMatch(NativeLine, 'Gamma=*') then
begin
ValStr := Copy(NativeLine, 7, MaxInt);
if TryStrToFloat(ValStr, ValFloat, GetFormatSettingsForFloats) then
FMetadata.SetMetaItem(SMetaGamma, ValFloat);
end;
if StrMaskMatch(NativeLine, 'Exposure=*') then
begin
ValStr := Copy(NativeLine, 10, MaxInt);
if TryStrToFloat(ValStr, ValFloat, GetFormatSettingsForFloats) then
FMetadata.SetMetaItem(SMetaExposure, ValFloat);
end;
if StrMaskMatch(NativeLine, '?Y * ?X *') then
begin
Idx := Pos('X', NativeLine);
ValStr := SubString(NativeLine, 4, Idx - 2);
if not TryStrToInt(ValStr, Header.Height) then
Exit;
ValStr := Copy(NativeLine, Idx + 2, MaxInt);
if not TryStrToInt(ValStr, Header.Width) then
Exit;
if (NativeLine[1] = '-') then
Header.Height := -Header.Height;
if (NativeLine[Idx - 1] = '-') then
Header.Width := -Header.Width;
HasResolution := True;
end;
until HasResolution;
Result := True;
end;
procedure DecodeRgbe(const Src: TRgbe; Dest: PColor96FPRec); {$IFDEF USE_INLINE}inline;{$ENDIF}
var
Mult: Single;
begin
if Src.E > 0 then
begin
Mult := Math.Ldexp(1, Src.E - 128);
Dest.R := Src.R / 255 * Mult;
Dest.G := Src.G / 255 * Mult;
Dest.B := Src.B / 255 * Mult;
end
else
begin
Dest.R := 0;
Dest.G := 0;
Dest.B := 0;
end;
end;
procedure ReadCompressedLine(Width, Y: Integer; var DestBuffer: TDynRgbeArray);
var
Pos: Integer;
I, X, Count: Integer;
Code, Value: Byte;
LineBuff: TDynByteArray;
Rgbe: TRgbe;
Ptr: PByte;
begin
SetLength(LineBuff, Width);
IO.Read(Handle, @Rgbe, SizeOf(Rgbe));
if ((Rgbe.B shl 8) or Rgbe.E) <> Width then
RaiseImaging(SWrongScanLineWidth);
for I := 0 to 3 do
begin
Pos := 0;
while Pos < Width do
begin
IO.Read(Handle, @Code, SizeOf(Byte));
if Code > 128 then
begin
Count := Code - 128;
IO.Read(Handle, @Value, SizeOf(Byte));
FillMemoryByte(@LineBuff[Pos], Count, Value);
end
else
begin
Count := Code;
IO.Read(Handle, @LineBuff[Pos], Count * SizeOf(Byte));
end;
Inc(Pos, Count);
end;
Ptr := @PByteArray(@DestBuffer[0])[I];
for X := 0 to Width - 1 do
begin
Ptr^ := LineBuff[X];
Inc(Ptr, 4);
end;
end;
end;
procedure ReadPixels(var Image: TImageData);
var
Y, X, SrcLineLen: Integer;
Dest: PColor96FPRec;
Compressed: Boolean;
Rgbe: TRgbe;
Buffer: TDynRgbeArray;
begin
Dest := Image.Bits;
Compressed := not ((Image.Width < 8) or (Image.Width > $7FFFF));
SrcLineLen := Image.Width * SizeOf(TRgbe);
IO.Read(Handle, @Rgbe, SizeOf(Rgbe));
IO.Seek(Handle, -SizeOf(Rgbe), smFromCurrent);
if (Rgbe.R <> 2) or (Rgbe.G <> 2) or ((Rgbe.B and 128) > 0) then
Compressed := False;
SetLength(Buffer, Image.Width);
for Y := 0 to Image.Height - 1 do
begin
if Compressed then
ReadCompressedLine(Image.Width, Y, Buffer)
else
IO.Read(Handle, @Buffer[0], SrcLineLen);
for X := 0 to Image.Width - 1 do
begin
DecodeRgbe(Buffer[X], Dest);
Inc(Dest);
end;
end;
end;
begin
IO := GetIO;
SetLength(Images, 1);
// Read header, allocate new image and, then read and convert the pixels
if not ReadHeader then
RaiseImaging(SErrorBadHeader);
if (Header.Format = hfXyz) then
RaiseImaging(SXyzNotSupported);
NewImage(Abs(Header.Width), Abs(Header.Height), ifR32G32B32F, Images[0]);
ReadPixels(Images[0]);
// Flip/mirror the image as needed (height < 0 is default top-down)
if Header.Width < 0 then
MirrorImage(Images[0]);
if Header.Height > 0 then
FlipImage(Images[0]);
Result := True;
end;
function THdrFileFormat.SaveData(Handle: TImagingHandle;
const Images: TDynImageDataArray; Index: LongInt): Boolean;
const
LineEnd = #$0A;
SPrgComment = '#Made with Vampyre Imaging Library';
SSizeFmt = '-Y %d +X %d';
var
ImageToSave: TImageData;
MustBeFreed: Boolean;
IO: TIOFunctions;
procedure SaveHeader;
begin
WriteLine(IO, Handle, RadianceSignature, LineEnd);
WriteLine(IO, Handle, SPrgComment, LineEnd);
WriteLine(IO, Handle, 'FORMAT=' + SFmtRgbeRle, LineEnd + LineEnd);
WriteLine(IO, Handle, AnsiString(Format(SSizeFmt, [ImageToSave.Height, ImageToSave.Width])), LineEnd);
end;
procedure EncodeRgbe(const Src: TColor96FPRec; var DestR, DestG, DestB, DestE: Byte); {$IFDEF USE_INLINE}inline;{$ENDIF}
var
V, M: {$IFDEF FPC}Float{$ELSE}Extended{$ENDIF};
E: Integer;
begin
V := Src.R;
if (Src.G > V) then
V := Src.G;
if (Src.B > V) then
V := Src.B;
if V < 1e-32 then
begin
DestR := 0;
DestG := 0;
DestB := 0;
DestE := 0;
end
else
begin
Frexp(V, M, E);
V := M * 256.0 / V;
DestR := ClampToByte(Round(Src.R * V));
DestG := ClampToByte(Round(Src.G * V));
DestB := ClampToByte(Round(Src.B * V));
DestE := ClampToByte(E + 128);
end;
end;
procedure WriteRleLine(const Line: array of Byte; Width: Integer);
const
MinRunLength = 4;
var
Cur, BeginRun, RunCount, OldRunCount, NonRunCount: Integer;
Buf: array[0..1] of Byte;
begin
Cur := 0;
while Cur < Width do
begin
BeginRun := Cur;
RunCount := 0;
OldRunCount := 0;
while (RunCount < MinRunLength) and (BeginRun < Width) do
begin
Inc(BeginRun, RunCount);
OldRunCount := RunCount;
RunCount := 1;
while (BeginRun + RunCount < Width) and (RunCount < 127) and (Line[BeginRun] = Line[BeginRun + RunCount]) do
Inc(RunCount);
end;
if (OldRunCount > 1) and (OldRunCount = BeginRun - Cur) then
begin
Buf[0] := 128 + OldRunCount;
Buf[1] := Line[Cur];
IO.Write(Handle, @Buf, 2);
Cur := BeginRun;
end;
while Cur < BeginRun do
begin
NonRunCount := Min(128, BeginRun - Cur);
Buf[0] := NonRunCount;
IO.Write(Handle, @Buf, 1);
IO.Write(Handle, @Line[Cur], NonRunCount);
Inc(Cur, NonRunCount);
end;
if RunCount >= MinRunLength then
begin
Buf[0] := 128 + RunCount;
Buf[1] := Line[BeginRun];
IO.Write(Handle, @Buf, 2);
Inc(Cur, RunCount);
end;
end;
end;
procedure SavePixels;
var
Y, X, I, Width: Integer;
SrcPtr: PColor96FPRecArray;
Components: array of array of Byte;
StartLine: array[0..3] of Byte;
begin
Width := ImageToSave.Width;
// Save using RLE, each component is compressed separately
SetLength(Components, 4, Width);
for Y := 0 to ImageToSave.Height - 1 do
begin
SrcPtr := @PColor96FPRecArray(ImageToSave.Bits)[ImageToSave.Width * Y];
// Identify line as using "new" RLE scheme (separate components)
StartLine[0] := 2;
StartLine[1] := 2;
StartLine[2] := Width shr 8;
StartLine[3] := Width and $FF;
IO.Write(Handle, @StartLine, SizeOf(StartLine));
for X := 0 to Width - 1 do
begin
EncodeRgbe(SrcPtr[X], Components[0, X], Components[1, X],
Components[2, X], Components[3, X]);
end;
for I := 0 to 3 do
WriteRleLine(Components[I], Width);
end;
end;
begin
Result := False;
IO := GetIO;
// Makes image to save compatible with Jpeg saving capabilities
if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then
with ImageToSave do
try
// Save header
SaveHeader;
// Save uncompressed pixels
SavePixels;
Result := True;
finally
if MustBeFreed then
FreeImage(ImageToSave);
end;
end;
procedure THdrFileFormat.ConvertToSupported(var Image: TImageData;
const Info: TImageFormatInfo);
begin
ConvertImage(Image, ifR32G32B32F);
end;
function THdrFileFormat.TestFormat(Handle: TImagingHandle): Boolean;
var
FileSig: TSignature;
ReadCount: Integer;
begin
Result := False;
if Handle <> nil then
begin
ReadCount := GetIO.Read(Handle, @FileSig, SizeOf(FileSig));
GetIO.Seek(Handle, -ReadCount, smFromCurrent);
Result := (ReadCount = SizeOf(FileSig)) and
((FileSig = RadianceSignature) or CompareMem(@FileSig, @RgbeSignature, 6));
end;
end;
initialization
RegisterImageFileFormat(THdrFileFormat);
{
File Notes:
-- 0.77.1 ---------------------------------------------------
- Added RLE compression to saving.
- Added image saving.
- Unit created with initial stuff (loading only).
}
end.

1227
Imaging/ImagingTarga.pas
View File

File diff suppressed because it is too large Load Diff

1063
Imaging/ImagingTypes.pas
View File

File diff suppressed because it is too large Load Diff

2678
Imaging/ImagingUtility.pas
View File

File diff suppressed because it is too large Load Diff

801
Imaging/JpegLib/imjcapimin.pas
View File

@ -1,401 +1,400 @@
unit imjcapimin; unit imjcapimin;
{$N+}
{ This file contains application interface code for the compression half { This file contains application interface code for the compression half
of the JPEG library. These are the "minimum" API routines that may be of the JPEG library. These are the "minimum" API routines that may be
needed in either the normal full-compression case or the transcoding-only needed in either the normal full-compression case or the transcoding-only
case. case.
Most of the routines intended to be called directly by an application Most of the routines intended to be called directly by an application
are in this file or in jcapistd.c. But also see jcparam.c for are in this file or in jcapistd.c. But also see jcparam.c for
parameter-setup helper routines, jcomapi.c for routines shared by parameter-setup helper routines, jcomapi.c for routines shared by
compression and decompression, and jctrans.c for the transcoding case. } compression and decompression, and jctrans.c for the transcoding case. }
{ jcapimin.c ; Copyright (C) 1994-1998, Thomas G. Lane. } { jcapimin.c ; Copyright (C) 1994-1998, Thomas G. Lane. }
interface interface
{$I imjconfig.inc} {$I imjconfig.inc}
uses uses
imjmorecfg, imjmorecfg,
imjinclude, imjinclude,
imjdeferr, imjdeferr,
imjerror, imjerror,
imjpeglib, imjpeglib,
imjcomapi, imjcomapi,
imjmemmgr, imjmemmgr,
imjcmarker; imjcmarker;
{ Initialization of JPEG compression objects. { Initialization of JPEG compression objects.
Nomssi: This is a macro in the original code. Nomssi: This is a macro in the original code.
jpeg_create_compress() and jpeg_create_decompress() are the exported jpeg_create_compress() and jpeg_create_decompress() are the exported
names that applications should call. These expand to calls on names that applications should call. These expand to calls on
jpeg_CreateCompress and jpeg_CreateDecompress with additional information jpeg_CreateCompress and jpeg_CreateDecompress with additional information
passed for version mismatch checking. passed for version mismatch checking.
NB: you must set up the error-manager BEFORE calling jpeg_create_xxx. } NB: you must set up the error-manager BEFORE calling jpeg_create_xxx. }
procedure jpeg_create_compress(cinfo : j_compress_ptr); procedure jpeg_create_compress(cinfo : j_compress_ptr);
{ Initialization of a JPEG compression object. { Initialization of a JPEG compression object.
The error manager must already be set up (in case memory manager fails). } The error manager must already be set up (in case memory manager fails). }
{GLOBAL} {GLOBAL}
procedure jpeg_CreateCompress (cinfo : j_compress_ptr; procedure jpeg_CreateCompress (cinfo : j_compress_ptr;
version : int; version : int;
structsize : size_t); structsize : size_t);
{ Destruction of a JPEG compression object } { Destruction of a JPEG compression object }
{GLOBAL} {GLOBAL}
procedure jpeg_destroy_compress (cinfo : j_compress_ptr); procedure jpeg_destroy_compress (cinfo : j_compress_ptr);
{ Abort processing of a JPEG compression operation, { Abort processing of a JPEG compression operation,
but don't destroy the object itself. } but don't destroy the object itself. }
{GLOBAL} {GLOBAL}
procedure jpeg_abort_compress (cinfo : j_compress_ptr); procedure jpeg_abort_compress (cinfo : j_compress_ptr);
{ Forcibly suppress or un-suppress all quantization and Huffman tables. { Forcibly suppress or un-suppress all quantization and Huffman tables.
Marks all currently defined tables as already written (if suppress) Marks all currently defined tables as already written (if suppress)
or not written (if !suppress). This will control whether they get emitted or not written (if !suppress). This will control whether they get emitted
by a subsequent jpeg_start_compress call. by a subsequent jpeg_start_compress call.
This routine is exported for use by applications that want to produce This routine is exported for use by applications that want to produce
abbreviated JPEG datastreams. It logically belongs in jcparam.c, but abbreviated JPEG datastreams. It logically belongs in jcparam.c, but
since it is called by jpeg_start_compress, we put it here --- otherwise since it is called by jpeg_start_compress, we put it here --- otherwise
jcparam.o would be linked whether the application used it or not. } jcparam.o would be linked whether the application used it or not. }
{GLOBAL} {GLOBAL}
procedure jpeg_suppress_tables (cinfo : j_compress_ptr; procedure jpeg_suppress_tables (cinfo : j_compress_ptr;
suppress : boolean); suppress : boolean);
{ Finish JPEG compression. { Finish JPEG compression.
If a multipass operating mode was selected, this may do a great deal of If a multipass operating mode was selected, this may do a great deal of
work including most of the actual output. } work including most of the actual output. }
{GLOBAL} {GLOBAL}
procedure jpeg_finish_compress (cinfo : j_compress_ptr); procedure jpeg_finish_compress (cinfo : j_compress_ptr);
{ Write a special marker. { Write a special marker.
This is only recommended for writing COM or APPn markers. This is only recommended for writing COM or APPn markers.
Must be called after jpeg_start_compress() and before Must be called after jpeg_start_compress() and before
first call to jpeg_write_scanlines() or jpeg_write_raw_data(). } first call to jpeg_write_scanlines() or jpeg_write_raw_data(). }
{GLOBAL} {GLOBAL}
procedure jpeg_write_marker (cinfo : j_compress_ptr; procedure jpeg_write_marker (cinfo : j_compress_ptr;
marker : int; marker : int;
dataptr : JOCTETptr; dataptr : JOCTETptr;
datalen : uInt); datalen : uInt);
{GLOBAL} {GLOBAL}
procedure jpeg_write_m_header (cinfo : j_compress_ptr; procedure jpeg_write_m_header (cinfo : j_compress_ptr;
marker : int; marker : int;
datalen : uint); datalen : uint);
{GLOBAL} {GLOBAL}
procedure jpeg_write_m_byte (cinfo : j_compress_ptr; val : int); procedure jpeg_write_m_byte (cinfo : j_compress_ptr; val : int);
{ Alternate compression function: just write an abbreviated table file. { Alternate compression function: just write an abbreviated table file.
Before calling this, all parameters and a data destination must be set up. Before calling this, all parameters and a data destination must be set up.
To produce a pair of files containing abbreviated tables and abbreviated To produce a pair of files containing abbreviated tables and abbreviated
image data, one would proceed as follows: image data, one would proceed as follows:
initialize JPEG object initialize JPEG object
set JPEG parameters set JPEG parameters
set destination to table file set destination to table file
jpeg_write_tables(cinfo); jpeg_write_tables(cinfo);
set destination to image file set destination to image file
jpeg_start_compress(cinfo, FALSE); jpeg_start_compress(cinfo, FALSE);
write data... write data...
jpeg_finish_compress(cinfo); jpeg_finish_compress(cinfo);
jpeg_write_tables has the side effect of marking all tables written jpeg_write_tables has the side effect of marking all tables written
(same as jpeg_suppress_tables(..., TRUE)). Thus a subsequent start_compress (same as jpeg_suppress_tables(..., TRUE)). Thus a subsequent start_compress
will not re-emit the tables unless it is passed write_all_tables=TRUE. } will not re-emit the tables unless it is passed write_all_tables=TRUE. }
{GLOBAL} {GLOBAL}
procedure jpeg_write_tables (cinfo : j_compress_ptr); procedure jpeg_write_tables (cinfo : j_compress_ptr);
implementation implementation
procedure jpeg_create_compress(cinfo : j_compress_ptr); procedure jpeg_create_compress(cinfo : j_compress_ptr);
begin begin
jpeg_CreateCompress(cinfo, JPEG_LIB_VERSION, jpeg_CreateCompress(cinfo, JPEG_LIB_VERSION,
size_t(sizeof(jpeg_compress_struct))); size_t(sizeof(jpeg_compress_struct)));
end; end;
{ Initialization of a JPEG compression object. { Initialization of a JPEG compression object.
The error manager must already be set up (in case memory manager fails). } The error manager must already be set up (in case memory manager fails). }
{GLOBAL} {GLOBAL}
procedure jpeg_CreateCompress (cinfo : j_compress_ptr; procedure jpeg_CreateCompress (cinfo : j_compress_ptr;
version : int; version : int;
structsize : size_t); structsize : size_t);
var var
i : int; i : int;
var var
err : jpeg_error_mgr_ptr; err : jpeg_error_mgr_ptr;
client_data : voidp; client_data : voidp;
begin begin
{ Guard against version mismatches between library and caller. } { Guard against version mismatches between library and caller. }
cinfo^.mem := NIL; { so jpeg_destroy knows mem mgr not called } cinfo^.mem := NIL; { so jpeg_destroy knows mem mgr not called }
if (version <> JPEG_LIB_VERSION) then if (version <> JPEG_LIB_VERSION) then
ERREXIT2(j_common_ptr(cinfo), JERR_BAD_LIB_VERSION, JPEG_LIB_VERSION, version); ERREXIT2(j_common_ptr(cinfo), JERR_BAD_LIB_VERSION, JPEG_LIB_VERSION, version);
if (structsize <> SIZEOF(jpeg_compress_struct)) then if (structsize <> SIZEOF(jpeg_compress_struct)) then
ERREXIT2(j_common_ptr(cinfo), JERR_BAD_STRUCT_SIZE, ERREXIT2(j_common_ptr(cinfo), JERR_BAD_STRUCT_SIZE,
int(SIZEOF(jpeg_compress_struct)), int(structsize)); int(SIZEOF(jpeg_compress_struct)), int(structsize));
{ For debugging purposes, we zero the whole master structure. { For debugging purposes, we zero the whole master structure.
But the application has already set the err pointer, and may have set But the application has already set the err pointer, and may have set
client_data, so we have to save and restore those fields. client_data, so we have to save and restore those fields. }
Note: if application hasn't set client_data, tools like Purify may
complain here. } err := cinfo^.err;
client_data := cinfo^.client_data;
err := cinfo^.err; MEMZERO(cinfo, SIZEOF(jpeg_compress_struct));
client_data := cinfo^.client_data; { ignore Purify complaint here } cinfo^.err := err;
MEMZERO(cinfo, SIZEOF(jpeg_compress_struct)); cinfo^.is_decompressor := FALSE;
cinfo^.err := err; cinfo^.client_data := client_data;
cinfo^.is_decompressor := FALSE;
{ Initialize a memory manager instance for this object }
{ Initialize a memory manager instance for this object } jinit_memory_mgr(j_common_ptr(cinfo));
jinit_memory_mgr(j_common_ptr(cinfo));
{ Zero out pointers to permanent structures. }
{ Zero out pointers to permanent structures. } cinfo^.progress := NIL;
cinfo^.progress := NIL; cinfo^.dest := NIL;
cinfo^.dest := NIL;
cinfo^.comp_info := NIL;
cinfo^.comp_info := NIL;
for i := 0 to pred(NUM_QUANT_TBLS) do
for i := 0 to pred(NUM_QUANT_TBLS) do cinfo^.quant_tbl_ptrs[i] := NIL;
cinfo^.quant_tbl_ptrs[i] := NIL;
for i := 0 to pred(NUM_HUFF_TBLS) do
for i := 0 to pred(NUM_HUFF_TBLS) do begin
begin cinfo^.dc_huff_tbl_ptrs[i] := NIL;
cinfo^.dc_huff_tbl_ptrs[i] := NIL; cinfo^.ac_huff_tbl_ptrs[i] := NIL;
cinfo^.ac_huff_tbl_ptrs[i] := NIL; end;
end;
cinfo^.script_space := NIL;
cinfo^.script_space := NIL;
cinfo^.input_gamma := 1.0; { in case application forgets }
cinfo^.input_gamma := 1.0; { in case application forgets }
{ OK, I'm ready }
{ OK, I'm ready } cinfo^.global_state := CSTATE_START;
cinfo^.global_state := CSTATE_START; end;
end;
{ Destruction of a JPEG compression object }
{ Destruction of a JPEG compression object }
{GLOBAL}
{GLOBAL} procedure jpeg_destroy_compress (cinfo : j_compress_ptr);
procedure jpeg_destroy_compress (cinfo : j_compress_ptr); begin
begin jpeg_destroy(j_common_ptr(cinfo)); { use common routine }
jpeg_destroy(j_common_ptr(cinfo)); { use common routine } end;
end;
{ Abort processing of a JPEG compression operation,
{ Abort processing of a JPEG compression operation, but don't destroy the object itself. }
but don't destroy the object itself. }
{GLOBAL}
{GLOBAL} procedure jpeg_abort_compress (cinfo : j_compress_ptr);
procedure jpeg_abort_compress (cinfo : j_compress_ptr); begin
begin jpeg_abort(j_common_ptr(cinfo)); { use common routine }
jpeg_abort(j_common_ptr(cinfo)); { use common routine } end;
end;
{ Forcibly suppress or un-suppress all quantization and Huffman tables.
{ Forcibly suppress or un-suppress all quantization and Huffman tables. Marks all currently defined tables as already written (if suppress)
Marks all currently defined tables as already written (if suppress) or not written (if !suppress). This will control whether they get emitted
or not written (if !suppress). This will control whether they get emitted by a subsequent jpeg_start_compress call.
by a subsequent jpeg_start_compress call.
This routine is exported for use by applications that want to produce
This routine is exported for use by applications that want to produce abbreviated JPEG datastreams. It logically belongs in jcparam.c, but
abbreviated JPEG datastreams. It logically belongs in jcparam.c, but since it is called by jpeg_start_compress, we put it here --- otherwise
since it is called by jpeg_start_compress, we put it here --- otherwise jcparam.o would be linked whether the application used it or not. }
jcparam.o would be linked whether the application used it or not. }
{GLOBAL}
{GLOBAL} procedure jpeg_suppress_tables (cinfo : j_compress_ptr;
procedure jpeg_suppress_tables (cinfo : j_compress_ptr; suppress : boolean);
suppress : boolean); var
var i : int;
i : int; qtbl : JQUANT_TBL_PTR;
qtbl : JQUANT_TBL_PTR; htbl : JHUFF_TBL_PTR;
htbl : JHUFF_TBL_PTR; begin
begin for i := 0 to pred(NUM_QUANT_TBLS) do
for i := 0 to pred(NUM_QUANT_TBLS) do begin
begin qtbl := cinfo^.quant_tbl_ptrs[i];
qtbl := cinfo^.quant_tbl_ptrs[i]; if (qtbl <> NIL) then
if (qtbl <> NIL) then qtbl^.sent_table := suppress;
qtbl^.sent_table := suppress; end;
end;
for i := 0 to pred(NUM_HUFF_TBLS) do
for i := 0 to pred(NUM_HUFF_TBLS) do begin
begin htbl := cinfo^.dc_huff_tbl_ptrs[i];
htbl := cinfo^.dc_huff_tbl_ptrs[i]; if (htbl <> NIL) then
if (htbl <> NIL) then htbl^.sent_table := suppress;
htbl^.sent_table := suppress; htbl := cinfo^.ac_huff_tbl_ptrs[i];
htbl := cinfo^.ac_huff_tbl_ptrs[i]; if (htbl <> NIL) then
if (htbl <> NIL) then htbl^.sent_table := suppress;
htbl^.sent_table := suppress; end;
end; end;
end;
{ Finish JPEG compression.
{ Finish JPEG compression.
If a multipass operating mode was selected, this may do a great deal of
If a multipass operating mode was selected, this may do a great deal of work including most of the actual output. }
work including most of the actual output. }
{GLOBAL}
{GLOBAL} procedure jpeg_finish_compress (cinfo : j_compress_ptr);
procedure jpeg_finish_compress (cinfo : j_compress_ptr); var
var iMCU_row : JDIMENSION;
iMCU_row : JDIMENSION; begin
begin if (cinfo^.global_state = CSTATE_SCANNING) or
if (cinfo^.global_state = CSTATE_SCANNING) or (cinfo^.global_state = CSTATE_RAW_OK) then
(cinfo^.global_state = CSTATE_RAW_OK) then begin
begin { Terminate first pass }
{ Terminate first pass } if (cinfo^.next_scanline < cinfo^.image_height) then
if (cinfo^.next_scanline < cinfo^.image_height) then ERREXIT(j_common_ptr(cinfo), JERR_TOO_LITTLE_DATA);
ERREXIT(j_common_ptr(cinfo), JERR_TOO_LITTLE_DATA); cinfo^.master^.finish_pass (cinfo);
cinfo^.master^.finish_pass (cinfo); end
end else
else if (cinfo^.global_state <> CSTATE_WRCOEFS) then
if (cinfo^.global_state <> CSTATE_WRCOEFS) then ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); { Perform any remaining passes }
{ Perform any remaining passes } while (not cinfo^.master^.is_last_pass) do
while (not cinfo^.master^.is_last_pass) do begin
begin cinfo^.master^.prepare_for_pass (cinfo);
cinfo^.master^.prepare_for_pass (cinfo); for iMCU_row := 0 to pred(cinfo^.total_iMCU_rows) do
for iMCU_row := 0 to pred(cinfo^.total_iMCU_rows) do begin
begin if (cinfo^.progress <> NIL) then
if (cinfo^.progress <> NIL) then begin
begin cinfo^.progress^.pass_counter := long (iMCU_row);
cinfo^.progress^.pass_counter := long (iMCU_row); cinfo^.progress^.pass_limit := long (cinfo^.total_iMCU_rows);
cinfo^.progress^.pass_limit := long (cinfo^.total_iMCU_rows); cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo)); end;
end; { We bypass the main controller and invoke coef controller directly;
{ We bypass the main controller and invoke coef controller directly; all work is being done from the coefficient buffer. }
all work is being done from the coefficient buffer. }
if (not cinfo^.coef^.compress_data (cinfo, JSAMPIMAGE(NIL))) then
if (not cinfo^.coef^.compress_data (cinfo, JSAMPIMAGE(NIL))) then ERREXIT(j_common_ptr(cinfo), JERR_CANT_SUSPEND);
ERREXIT(j_common_ptr(cinfo), JERR_CANT_SUSPEND); end;
end; cinfo^.master^.finish_pass (cinfo);
cinfo^.master^.finish_pass (cinfo); end;
end; { Write EOI, do final cleanup }
{ Write EOI, do final cleanup } cinfo^.marker^.write_file_trailer (cinfo);
cinfo^.marker^.write_file_trailer (cinfo); cinfo^.dest^.term_destination (cinfo);
cinfo^.dest^.term_destination (cinfo); { We can use jpeg_abort to release memory and reset global_state }
{ We can use jpeg_abort to release memory and reset global_state } jpeg_abort(j_common_ptr(cinfo));
jpeg_abort(j_common_ptr(cinfo)); end;
end;
{ Write a special marker.
{ Write a special marker. This is only recommended for writing COM or APPn markers.
This is only recommended for writing COM or APPn markers. Must be called after jpeg_start_compress() and before
Must be called after jpeg_start_compress() and before first call to jpeg_write_scanlines() or jpeg_write_raw_data(). }
first call to jpeg_write_scanlines() or jpeg_write_raw_data(). }
{GLOBAL}
{GLOBAL} procedure jpeg_write_marker (cinfo : j_compress_ptr;
procedure jpeg_write_marker (cinfo : j_compress_ptr; marker : int;
marker : int; dataptr : JOCTETptr;
dataptr : JOCTETptr; datalen : uInt);
datalen : uInt); var
var write_marker_byte : procedure(info : j_compress_ptr; val : int);
write_marker_byte : procedure(info : j_compress_ptr; val : int); begin
begin if (cinfo^.next_scanline <> 0) or
if (cinfo^.next_scanline <> 0) or ((cinfo^.global_state <> CSTATE_SCANNING) and
((cinfo^.global_state <> CSTATE_SCANNING) and (cinfo^.global_state <> CSTATE_RAW_OK) and
(cinfo^.global_state <> CSTATE_RAW_OK) and (cinfo^.global_state <> CSTATE_WRCOEFS)) then
(cinfo^.global_state <> CSTATE_WRCOEFS)) then ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
cinfo^.marker^.write_marker_header (cinfo, marker, datalen);
cinfo^.marker^.write_marker_header (cinfo, marker, datalen); write_marker_byte := cinfo^.marker^.write_marker_byte; { copy for speed }
write_marker_byte := cinfo^.marker^.write_marker_byte; { copy for speed } while (datalen <> 0) do
while (datalen <> 0) do begin
begin Dec(datalen);
Dec(datalen); write_marker_byte (cinfo, dataptr^);
write_marker_byte (cinfo, dataptr^); Inc(dataptr);
Inc(dataptr); end;
end; end;
end;
{ Same, but piecemeal. }
{ Same, but piecemeal. }
{GLOBAL}
{GLOBAL} procedure jpeg_write_m_header (cinfo : j_compress_ptr;
procedure jpeg_write_m_header (cinfo : j_compress_ptr; marker : int;
marker : int; datalen : uint);
datalen : uint); begin
begin if (cinfo^.next_scanline <> 0) or
if (cinfo^.next_scanline <> 0) or ((cinfo^.global_state <> CSTATE_SCANNING) and
((cinfo^.global_state <> CSTATE_SCANNING) and (cinfo^.global_state <> CSTATE_RAW_OK) and
(cinfo^.global_state <> CSTATE_RAW_OK) and (cinfo^.global_state <> CSTATE_WRCOEFS)) then
(cinfo^.global_state <> CSTATE_WRCOEFS)) then ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
cinfo^.marker^.write_marker_header (cinfo, marker, datalen);
cinfo^.marker^.write_marker_header (cinfo, marker, datalen); end;
end;
{GLOBAL}
{GLOBAL} procedure jpeg_write_m_byte (cinfo : j_compress_ptr; val : int);
procedure jpeg_write_m_byte (cinfo : j_compress_ptr; val : int); begin
begin cinfo^.marker^.write_marker_byte (cinfo, val);
cinfo^.marker^.write_marker_byte (cinfo, val); end;
end;
{ Alternate compression function: just write an abbreviated table file.
{ Alternate compression function: just write an abbreviated table file. Before calling this, all parameters and a data destination must be set up.
Before calling this, all parameters and a data destination must be set up.
To produce a pair of files containing abbreviated tables and abbreviated
To produce a pair of files containing abbreviated tables and abbreviated image data, one would proceed as follows:
image data, one would proceed as follows:
initialize JPEG object
initialize JPEG object set JPEG parameters
set JPEG parameters set destination to table file
set destination to table file jpeg_write_tables(cinfo);
jpeg_write_tables(cinfo); set destination to image file
set destination to image file jpeg_start_compress(cinfo, FALSE);
jpeg_start_compress(cinfo, FALSE); write data...
write data... jpeg_finish_compress(cinfo);
jpeg_finish_compress(cinfo);
jpeg_write_tables has the side effect of marking all tables written
jpeg_write_tables has the side effect of marking all tables written (same as jpeg_suppress_tables(..., TRUE)). Thus a subsequent start_compress
(same as jpeg_suppress_tables(..., TRUE)). Thus a subsequent start_compress will not re-emit the tables unless it is passed write_all_tables=TRUE. }
will not re-emit the tables unless it is passed write_all_tables=TRUE. }
{GLOBAL}
{GLOBAL} procedure jpeg_write_tables (cinfo : j_compress_ptr);
procedure jpeg_write_tables (cinfo : j_compress_ptr); begin
begin if (cinfo^.global_state <> CSTATE_START) then
if (cinfo^.global_state <> CSTATE_START) then ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
{ (Re)initialize error mgr and destination modules }
{ (Re)initialize error mgr and destination modules } cinfo^.err^.reset_error_mgr (j_common_ptr(cinfo));
cinfo^.err^.reset_error_mgr (j_common_ptr(cinfo)); cinfo^.dest^.init_destination (cinfo);
cinfo^.dest^.init_destination (cinfo); { Initialize the marker writer ... bit of a crock to do it here. }
{ Initialize the marker writer ... bit of a crock to do it here. } jinit_marker_writer(cinfo);
jinit_marker_writer(cinfo); { Write them tables! }
{ Write them tables! } cinfo^.marker^.write_tables_only (cinfo);
cinfo^.marker^.write_tables_only (cinfo); { And clean up. }
{ And clean up. } cinfo^.dest^.term_destination (cinfo);
cinfo^.dest^.term_destination (cinfo);
{ In library releases up through v6a, we called jpeg_abort() here to free
{ In library releases up through v6a, we called jpeg_abort() here to free any working memory allocated by the destination manager and marker
any working memory allocated by the destination manager and marker writer. Some applications had a problem with that: they allocated space
writer. Some applications had a problem with that: they allocated space of their own from the library memory manager, and didn't want it to go
of their own from the library memory manager, and didn't want it to go away during write_tables. So now we do nothing. This will cause a
away during write_tables. So now we do nothing. This will cause a memory leak if an app calls write_tables repeatedly without doing a full
memory leak if an app calls write_tables repeatedly without doing a full compression cycle or otherwise resetting the JPEG object. However, that
compression cycle or otherwise resetting the JPEG object. However, that seems less bad than unexpectedly freeing memory in the normal case.
seems less bad than unexpectedly freeing memory in the normal case. An app that prefers the old behavior can call jpeg_abort for itself after
An app that prefers the old behavior can call jpeg_abort for itself after each call to jpeg_write_tables(). }
each call to jpeg_write_tables(). } end;
end;
end.
end.

444
Imaging/JpegLib/imjcapistd.pas
View File

@ -1,222 +1,222 @@
unit imjcapistd; unit imjcapistd;
{ Original : jcapistd.c ; Copyright (C) 1994-1996, Thomas G. Lane. } { Original : jcapistd.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
{ This file is part of the Independent JPEG Group's software. { This file is part of the Independent JPEG Group's software.
For conditions of distribution and use, see the accompanying README file. For conditions of distribution and use, see the accompanying README file.
This file contains application interface code for the compression half This file contains application interface code for the compression half
of the JPEG library. These are the "standard" API routines that are of the JPEG library. These are the "standard" API routines that are
used in the normal full-compression case. They are not used by a used in the normal full-compression case. They are not used by a
transcoding-only application. Note that if an application links in transcoding-only application. Note that if an application links in
jpeg_start_compress, it will end up linking in the entire compressor. jpeg_start_compress, it will end up linking in the entire compressor.
We thus must separate this file from jcapimin.c to avoid linking the We thus must separate this file from jcapimin.c to avoid linking the
whole compression library into a transcoder. } whole compression library into a transcoder. }
interface interface
{$I imjconfig.inc} {$I imjconfig.inc}
uses uses
imjmorecfg, imjmorecfg,
imjinclude, imjinclude,
imjdeferr, imjdeferr,
imjerror, imjerror,
imjpeglib, imjpeglib,
imjcapimin, imjcinit; imjcapimin, imjcinit;
{ Compression initialization. { Compression initialization.
Before calling this, all parameters and a data destination must be set up. Before calling this, all parameters and a data destination must be set up.
We require a write_all_tables parameter as a failsafe check when writing We require a write_all_tables parameter as a failsafe check when writing
multiple datastreams from the same compression object. Since prior runs multiple datastreams from the same compression object. Since prior runs
will have left all the tables marked sent_table=TRUE, a subsequent run will have left all the tables marked sent_table=TRUE, a subsequent run
would emit an abbreviated stream (no tables) by default. This may be what would emit an abbreviated stream (no tables) by default. This may be what
is wanted, but for safety's sake it should not be the default behavior: is wanted, but for safety's sake it should not be the default behavior:
programmers should have to make a deliberate choice to emit abbreviated programmers should have to make a deliberate choice to emit abbreviated
images. Therefore the documentation and examples should encourage people images. Therefore the documentation and examples should encourage people
to pass write_all_tables=TRUE; then it will take active thought to do the to pass write_all_tables=TRUE; then it will take active thought to do the
wrong thing. } wrong thing. }
{GLOBAL} {GLOBAL}
procedure jpeg_start_compress (cinfo : j_compress_ptr; procedure jpeg_start_compress (cinfo : j_compress_ptr;
write_all_tables : boolean); write_all_tables : boolean);
{ Write some scanlines of data to the JPEG compressor. { Write some scanlines of data to the JPEG compressor.
The return value will be the number of lines actually written. The return value will be the number of lines actually written.
This should be less than the supplied num_lines only in case that This should be less than the supplied num_lines only in case that
the data destination module has requested suspension of the compressor, the data destination module has requested suspension of the compressor,
or if more than image_height scanlines are passed in. or if more than image_height scanlines are passed in.
Note: we warn about excess calls to jpeg_write_scanlines() since Note: we warn about excess calls to jpeg_write_scanlines() since
this likely signals an application programmer error. However, this likely signals an application programmer error. However,
excess scanlines passed in the last valid call are *silently* ignored, excess scanlines passed in the last valid call are *silently* ignored,
so that the application need not adjust num_lines for end-of-image so that the application need not adjust num_lines for end-of-image
when using a multiple-scanline buffer. } when using a multiple-scanline buffer. }
{GLOBAL} {GLOBAL}
function jpeg_write_scanlines (cinfo : j_compress_ptr; function jpeg_write_scanlines (cinfo : j_compress_ptr;
scanlines : JSAMPARRAY; scanlines : JSAMPARRAY;
num_lines : JDIMENSION) : JDIMENSION; num_lines : JDIMENSION) : JDIMENSION;
{ Alternate entry point to write raw data. { Alternate entry point to write raw data.
Processes exactly one iMCU row per call, unless suspended. } Processes exactly one iMCU row per call, unless suspended. }
{GLOBAL} {GLOBAL}
function jpeg_write_raw_data (cinfo : j_compress_ptr; function jpeg_write_raw_data (cinfo : j_compress_ptr;
data : JSAMPIMAGE; data : JSAMPIMAGE;
num_lines : JDIMENSION) : JDIMENSION; num_lines : JDIMENSION) : JDIMENSION;
implementation implementation
{ Compression initialization. { Compression initialization.
Before calling this, all parameters and a data destination must be set up. Before calling this, all parameters and a data destination must be set up.
We require a write_all_tables parameter as a failsafe check when writing We require a write_all_tables parameter as a failsafe check when writing
multiple datastreams from the same compression object. Since prior runs multiple datastreams from the same compression object. Since prior runs
will have left all the tables marked sent_table=TRUE, a subsequent run will have left all the tables marked sent_table=TRUE, a subsequent run
would emit an abbreviated stream (no tables) by default. This may be what would emit an abbreviated stream (no tables) by default. This may be what
is wanted, but for safety's sake it should not be the default behavior: is wanted, but for safety's sake it should not be the default behavior:
programmers should have to make a deliberate choice to emit abbreviated programmers should have to make a deliberate choice to emit abbreviated
images. Therefore the documentation and examples should encourage people images. Therefore the documentation and examples should encourage people
to pass write_all_tables=TRUE; then it will take active thought to do the to pass write_all_tables=TRUE; then it will take active thought to do the
wrong thing. } wrong thing. }
{GLOBAL} {GLOBAL}
procedure jpeg_start_compress (cinfo : j_compress_ptr; procedure jpeg_start_compress (cinfo : j_compress_ptr;
write_all_tables : boolean); write_all_tables : boolean);
begin begin
if (cinfo^.global_state <> CSTATE_START) then if (cinfo^.global_state <> CSTATE_START) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
if (write_all_tables) then if (write_all_tables) then
jpeg_suppress_tables(cinfo, FALSE); { mark all tables to be written } jpeg_suppress_tables(cinfo, FALSE); { mark all tables to be written }
{ (Re)initialize error mgr and destination modules } { (Re)initialize error mgr and destination modules }
cinfo^.err^.reset_error_mgr (j_common_ptr(cinfo)); cinfo^.err^.reset_error_mgr (j_common_ptr(cinfo));
cinfo^.dest^.init_destination (cinfo); cinfo^.dest^.init_destination (cinfo);
{ Perform master selection of active modules } { Perform master selection of active modules }
jinit_compress_master(cinfo); jinit_compress_master(cinfo);
{ Set up for the first pass } { Set up for the first pass }
cinfo^.master^.prepare_for_pass (cinfo); cinfo^.master^.prepare_for_pass (cinfo);
{ Ready for application to drive first pass through jpeg_write_scanlines { Ready for application to drive first pass through jpeg_write_scanlines
or jpeg_write_raw_data. } or jpeg_write_raw_data. }
cinfo^.next_scanline := 0; cinfo^.next_scanline := 0;
if cinfo^.raw_data_in then if cinfo^.raw_data_in then
cinfo^.global_state := CSTATE_RAW_OK cinfo^.global_state := CSTATE_RAW_OK
else else
cinfo^.global_state := CSTATE_SCANNING; cinfo^.global_state := CSTATE_SCANNING;
end; end;
{ Write some scanlines of data to the JPEG compressor. { Write some scanlines of data to the JPEG compressor.
The return value will be the number of lines actually written. The return value will be the number of lines actually written.
This should be less than the supplied num_lines only in case that This should be less than the supplied num_lines only in case that
the data destination module has requested suspension of the compressor, the data destination module has requested suspension of the compressor,
or if more than image_height scanlines are passed in. or if more than image_height scanlines are passed in.
Note: we warn about excess calls to jpeg_write_scanlines() since Note: we warn about excess calls to jpeg_write_scanlines() since
this likely signals an application programmer error. However, this likely signals an application programmer error. However,
excess scanlines passed in the last valid call are *silently* ignored, excess scanlines passed in the last valid call are *silently* ignored,
so that the application need not adjust num_lines for end-of-image so that the application need not adjust num_lines for end-of-image
when using a multiple-scanline buffer. } when using a multiple-scanline buffer. }
{GLOBAL} {GLOBAL}
function jpeg_write_scanlines (cinfo : j_compress_ptr; function jpeg_write_scanlines (cinfo : j_compress_ptr;
scanlines : JSAMPARRAY; scanlines : JSAMPARRAY;
num_lines : JDIMENSION) : JDIMENSION; num_lines : JDIMENSION) : JDIMENSION;
var var
row_ctr, rows_left : JDIMENSION; row_ctr, rows_left : JDIMENSION;
begin begin
if (cinfo^.global_state <> CSTATE_SCANNING) then if (cinfo^.global_state <> CSTATE_SCANNING) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
if (cinfo^.next_scanline >= cinfo^.image_height) then if (cinfo^.next_scanline >= cinfo^.image_height) then
WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA); WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA);
{ Call progress monitor hook if present } { Call progress monitor hook if present }
if (cinfo^.progress <> NIL) then if (cinfo^.progress <> NIL) then
begin begin
cinfo^.progress^.pass_counter := long (cinfo^.next_scanline); cinfo^.progress^.pass_counter := long (cinfo^.next_scanline);
cinfo^.progress^.pass_limit := long (cinfo^.image_height); cinfo^.progress^.pass_limit := long (cinfo^.image_height);
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo)); cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
end; end;
{ Give master control module another chance if this is first call to { Give master control module another chance if this is first call to
jpeg_write_scanlines. This lets output of the frame/scan headers be jpeg_write_scanlines. This lets output of the frame/scan headers be
delayed so that application can write COM, etc, markers between delayed so that application can write COM, etc, markers between
jpeg_start_compress and jpeg_write_scanlines. } jpeg_start_compress and jpeg_write_scanlines. }
if (cinfo^.master^.call_pass_startup) then if (cinfo^.master^.call_pass_startup) then
cinfo^.master^.pass_startup (cinfo); cinfo^.master^.pass_startup (cinfo);
{ Ignore any extra scanlines at bottom of image. } { Ignore any extra scanlines at bottom of image. }
rows_left := cinfo^.image_height - cinfo^.next_scanline; rows_left := cinfo^.image_height - cinfo^.next_scanline;
if (num_lines > rows_left) then if (num_lines > rows_left) then
num_lines := rows_left; num_lines := rows_left;
row_ctr := 0; row_ctr := 0;
cinfo^.main^.process_data (cinfo, scanlines, {var}row_ctr, num_lines); cinfo^.main^.process_data (cinfo, scanlines, {var}row_ctr, num_lines);
Inc(cinfo^.next_scanline, row_ctr); Inc(cinfo^.next_scanline, row_ctr);
jpeg_write_scanlines := row_ctr; jpeg_write_scanlines := row_ctr;
end; end;
{ Alternate entry point to write raw data. { Alternate entry point to write raw data.
Processes exactly one iMCU row per call, unless suspended. } Processes exactly one iMCU row per call, unless suspended. }
{GLOBAL} {GLOBAL}
function jpeg_write_raw_data (cinfo : j_compress_ptr; function jpeg_write_raw_data (cinfo : j_compress_ptr;
data : JSAMPIMAGE; data : JSAMPIMAGE;
num_lines : JDIMENSION) : JDIMENSION; num_lines : JDIMENSION) : JDIMENSION;
var var
lines_per_iMCU_row : JDIMENSION; lines_per_iMCU_row : JDIMENSION;
begin begin
if (cinfo^.global_state <> CSTATE_RAW_OK) then if (cinfo^.global_state <> CSTATE_RAW_OK) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
if (cinfo^.next_scanline >= cinfo^.image_height) then if (cinfo^.next_scanline >= cinfo^.image_height) then
begin begin
WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA); WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA);
jpeg_write_raw_data := 0; jpeg_write_raw_data := 0;
exit; exit;
end; end;
{ Call progress monitor hook if present } { Call progress monitor hook if present }
if (cinfo^.progress <> NIL) then if (cinfo^.progress <> NIL) then
begin begin
cinfo^.progress^.pass_counter := long(cinfo^.next_scanline); cinfo^.progress^.pass_counter := long(cinfo^.next_scanline);
cinfo^.progress^.pass_limit := long(cinfo^.image_height); cinfo^.progress^.pass_limit := long(cinfo^.image_height);
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo)); cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
end; end;
{ Give master control module another chance if this is first call to { Give master control module another chance if this is first call to
jpeg_write_raw_data. This lets output of the frame/scan headers be jpeg_write_raw_data. This lets output of the frame/scan headers be
delayed so that application can write COM, etc, markers between delayed so that application can write COM, etc, markers between
jpeg_start_compress and jpeg_write_raw_data. } jpeg_start_compress and jpeg_write_raw_data. }
if (cinfo^.master^.call_pass_startup) then if (cinfo^.master^.call_pass_startup) then
cinfo^.master^.pass_startup (cinfo); cinfo^.master^.pass_startup (cinfo);
{ Verify that at least one iMCU row has been passed. } { Verify that at least one iMCU row has been passed. }
lines_per_iMCU_row := cinfo^.max_v_samp_factor * DCTSIZE; lines_per_iMCU_row := cinfo^.max_v_samp_factor * DCTSIZE;
if (num_lines < lines_per_iMCU_row) then if (num_lines < lines_per_iMCU_row) then
ERREXIT(j_common_ptr(cinfo), JERR_BUFFER_SIZE); ERREXIT(j_common_ptr(cinfo), JERR_BUFFER_SIZE);
{ Directly compress the row. } { Directly compress the row. }
if (not cinfo^.coef^.compress_data (cinfo, data)) then if (not cinfo^.coef^.compress_data (cinfo, data)) then
begin begin
{ If compressor did not consume the whole row, suspend processing. } { If compressor did not consume the whole row, suspend processing. }
jpeg_write_raw_data := 0; jpeg_write_raw_data := 0;
exit; exit;
end; end;
{ OK, we processed one iMCU row. } { OK, we processed one iMCU row. }
Inc(cinfo^.next_scanline, lines_per_iMCU_row); Inc(cinfo^.next_scanline, lines_per_iMCU_row);
jpeg_write_raw_data := lines_per_iMCU_row; jpeg_write_raw_data := lines_per_iMCU_row;
end; end;
end. end.

1042
Imaging/JpegLib/imjccoefct.pas
View File

File diff suppressed because it is too large Load Diff

1063
Imaging/JpegLib/imjccolor.pas
View File

File diff suppressed because it is too large Load Diff

1027
Imaging/JpegLib/imjcdctmgr.pas
View File

File diff suppressed because it is too large Load Diff

2232
Imaging/JpegLib/imjchuff.pas
View File

File diff suppressed because it is too large Load Diff

190
Imaging/JpegLib/imjcinit.pas
View File

@ -1,95 +1,95 @@
unit imjcinit; unit imjcinit;
{ Original: jcinit.c ; Copyright (C) 1991-1997, Thomas G. Lane. } { Original: jcinit.c ; Copyright (C) 1991-1997, Thomas G. Lane. }
{ This file contains initialization logic for the JPEG compressor. { This file contains initialization logic for the JPEG compressor.
This routine is in charge of selecting the modules to be executed and This routine is in charge of selecting the modules to be executed and
making an initialization call to each one. making an initialization call to each one.
Logically, this code belongs in jcmaster.c. It's split out because Logically, this code belongs in jcmaster.c. It's split out because
linking this routine implies linking the entire compression library. linking this routine implies linking the entire compression library.
For a transcoding-only application, we want to be able to use jcmaster.c For a transcoding-only application, we want to be able to use jcmaster.c
without linking in the whole library. } without linking in the whole library. }
interface interface
{$I imjconfig.inc} {$I imjconfig.inc}
uses uses
imjinclude, imjinclude,
imjdeferr, imjdeferr,
imjerror, imjerror,
imjpeglib, imjpeglib,
{$ifdef C_PROGRESSIVE_SUPPORTED} {$ifdef C_PROGRESSIVE_SUPPORTED}
imjcphuff, imjcphuff,
{$endif} {$endif}
imjchuff, imjcmaster, imjccolor, imjcsample, imjcprepct, imjchuff, imjcmaster, imjccolor, imjcsample, imjcprepct,
imjcdctmgr, imjccoefct, imjcmainct, imjcmarker; imjcdctmgr, imjccoefct, imjcmainct, imjcmarker;
{ Master selection of compression modules. { Master selection of compression modules.
This is done once at the start of processing an image. We determine This is done once at the start of processing an image. We determine
which modules will be used and give them appropriate initialization calls. } which modules will be used and give them appropriate initialization calls. }
{GLOBAL} {GLOBAL}
procedure jinit_compress_master (cinfo : j_compress_ptr); procedure jinit_compress_master (cinfo : j_compress_ptr);
implementation implementation
{ Master selection of compression modules. { Master selection of compression modules.
This is done once at the start of processing an image. We determine This is done once at the start of processing an image. We determine
which modules will be used and give them appropriate initialization calls. } which modules will be used and give them appropriate initialization calls. }
{GLOBAL} {GLOBAL}
procedure jinit_compress_master (cinfo : j_compress_ptr); procedure jinit_compress_master (cinfo : j_compress_ptr);
begin begin
{ Initialize master control (includes parameter checking/processing) } { Initialize master control (includes parameter checking/processing) }
jinit_c_master_control(cinfo, FALSE { full compression }); jinit_c_master_control(cinfo, FALSE { full compression });
{ Preprocessing } { Preprocessing }
if (not cinfo^.raw_data_in) then if (not cinfo^.raw_data_in) then
begin begin
jinit_color_converter(cinfo); jinit_color_converter(cinfo);
jinit_downsampler(cinfo); jinit_downsampler(cinfo);
jinit_c_prep_controller(cinfo, FALSE { never need full buffer here }); jinit_c_prep_controller(cinfo, FALSE { never need full buffer here });
end; end;
{ Forward DCT } { Forward DCT }
jinit_forward_dct(cinfo); jinit_forward_dct(cinfo);
{ Entropy encoding: either Huffman or arithmetic coding. } { Entropy encoding: either Huffman or arithmetic coding. }
if (cinfo^.arith_code) then if (cinfo^.arith_code) then
begin begin
ERREXIT(j_common_ptr(cinfo), JERR_ARITH_NOTIMPL); ERREXIT(j_common_ptr(cinfo), JERR_ARITH_NOTIMPL);
end end
else else
begin begin
if (cinfo^.progressive_mode) then if (cinfo^.progressive_mode) then
begin begin
{$ifdef C_PROGRESSIVE_SUPPORTED} {$ifdef C_PROGRESSIVE_SUPPORTED}
jinit_phuff_encoder(cinfo); jinit_phuff_encoder(cinfo);
{$else} {$else}
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
{$endif} {$endif}
end end
else else
jinit_huff_encoder(cinfo); jinit_huff_encoder(cinfo);
end; end;
{ Need a full-image coefficient buffer in any multi-pass mode. } { Need a full-image coefficient buffer in any multi-pass mode. }
jinit_c_coef_controller(cinfo, jinit_c_coef_controller(cinfo,
(cinfo^.num_scans > 1) or (cinfo^.optimize_coding)); (cinfo^.num_scans > 1) or (cinfo^.optimize_coding));
jinit_c_main_controller(cinfo, FALSE { never need full buffer here }); jinit_c_main_controller(cinfo, FALSE { never need full buffer here });
jinit_marker_writer(cinfo); jinit_marker_writer(cinfo);
{ We can now tell the memory manager to allocate virtual arrays. } { We can now tell the memory manager to allocate virtual arrays. }
cinfo^.mem^.realize_virt_arrays (j_common_ptr(cinfo)); cinfo^.mem^.realize_virt_arrays (j_common_ptr(cinfo));
{ Write the datastream header (SOI) immediately. { Write the datastream header (SOI) immediately.
Frame and scan headers are postponed till later. Frame and scan headers are postponed till later.
This lets application insert special markers after the SOI. } This lets application insert special markers after the SOI. }
cinfo^.marker^.write_file_header (cinfo); cinfo^.marker^.write_file_header (cinfo);
end; end;
end. end.

686
Imaging/JpegLib/imjcmainct.pas
View File

@ -1,343 +1,343 @@
unit imjcmainct; unit imjcmainct;
{ This file contains the main buffer controller for compression. { This file contains the main buffer controller for compression.
The main buffer lies between the pre-processor and the JPEG The main buffer lies between the pre-processor and the JPEG
compressor proper; it holds downsampled data in the JPEG colorspace. } compressor proper; it holds downsampled data in the JPEG colorspace. }
{ Original : jcmainct.c ; Copyright (C) 1994-1996, Thomas G. Lane. } { Original : jcmainct.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
interface interface
{$I imjconfig.inc} {$I imjconfig.inc}
{ Note: currently, there is no operating mode in which a full-image buffer { Note: currently, there is no operating mode in which a full-image buffer
is needed at this step. If there were, that mode could not be used with is needed at this step. If there were, that mode could not be used with
"raw data" input, since this module is bypassed in that case. However, "raw data" input, since this module is bypassed in that case. However,
we've left the code here for possible use in special applications. } we've left the code here for possible use in special applications. }
{$undef FULL_MAIN_BUFFER_SUPPORTED} {$undef FULL_MAIN_BUFFER_SUPPORTED}
uses uses
imjmorecfg, imjmorecfg,
imjinclude, imjinclude,
imjdeferr, imjdeferr,
imjerror, imjerror,
{$ifdef FULL_MAIN_BUFFER_SUPPORTED} {$ifdef FULL_MAIN_BUFFER_SUPPORTED}
imjutils, imjutils,
{$endif} {$endif}
imjpeglib; imjpeglib;
{ Initialize main buffer controller. } { Initialize main buffer controller. }
{GLOBAL} {GLOBAL}
procedure jinit_c_main_controller (cinfo : j_compress_ptr; procedure jinit_c_main_controller (cinfo : j_compress_ptr;
need_full_buffer : boolean); need_full_buffer : boolean);
implementation implementation
{ Private buffer controller object } { Private buffer controller object }
type type
my_main_ptr = ^my_main_controller; my_main_ptr = ^my_main_controller;
my_main_controller = record my_main_controller = record
pub : jpeg_c_main_controller; { public fields } pub : jpeg_c_main_controller; { public fields }
cur_iMCU_row : JDIMENSION; { number of current iMCU row } cur_iMCU_row : JDIMENSION; { number of current iMCU row }
rowgroup_ctr : JDIMENSION; { counts row groups received in iMCU row } rowgroup_ctr : JDIMENSION; { counts row groups received in iMCU row }
suspended : boolean; { remember if we suspended output } suspended : boolean; { remember if we suspended output }
pass_mode : J_BUF_MODE; { current operating mode } pass_mode : J_BUF_MODE; { current operating mode }
{ If using just a strip buffer, this points to the entire set of buffers { If using just a strip buffer, this points to the entire set of buffers
(we allocate one for each component). In the full-image case, this (we allocate one for each component). In the full-image case, this
points to the currently accessible strips of the virtual arrays. } points to the currently accessible strips of the virtual arrays. }
buffer : array[0..MAX_COMPONENTS-1] of JSAMPARRAY; buffer : array[0..MAX_COMPONENTS-1] of JSAMPARRAY;
{$ifdef FULL_MAIN_BUFFER_SUPPORTED} {$ifdef FULL_MAIN_BUFFER_SUPPORTED}
{ If using full-image storage, this array holds pointers to virtual-array { If using full-image storage, this array holds pointers to virtual-array
control blocks for each component. Unused if not full-image storage. } control blocks for each component. Unused if not full-image storage. }
whole_image : array[0..MAX_COMPONENTS-1] of jvirt_sarray_ptr; whole_image : array[0..MAX_COMPONENTS-1] of jvirt_sarray_ptr;
{$endif} {$endif}
end; {my_main_controller} end; {my_main_controller}
{ Forward declarations } { Forward declarations }
{METHODDEF} {METHODDEF}
procedure process_data_simple_main(cinfo : j_compress_ptr; procedure process_data_simple_main(cinfo : j_compress_ptr;
input_buf : JSAMPARRAY; input_buf : JSAMPARRAY;
var in_row_ctr: JDIMENSION; var in_row_ctr: JDIMENSION;
in_rows_avail : JDIMENSION); forward; in_rows_avail : JDIMENSION); forward;
{$ifdef FULL_MAIN_BUFFER_SUPPORTED} {$ifdef FULL_MAIN_BUFFER_SUPPORTED}
{METHODDEF} {METHODDEF}
procedure process_data_buffer_main(cinfo : j_compress_ptr; procedure process_data_buffer_main(cinfo : j_compress_ptr;
input_buf : JSAMPARRAY; input_buf : JSAMPARRAY;
var in_row_ctr : JDIMENSION; var in_row_ctr : JDIMENSION;
in_rows_avail : JDIMENSION); forward; in_rows_avail : JDIMENSION); forward;
{$endif} {$endif}
{ Initialize for a processing pass. } { Initialize for a processing pass. }
{METHODDEF} {METHODDEF}
procedure start_pass_main (cinfo : j_compress_ptr; procedure start_pass_main (cinfo : j_compress_ptr;
pass_mode : J_BUF_MODE); pass_mode : J_BUF_MODE);
var var
main : my_main_ptr; main : my_main_ptr;
begin begin
main := my_main_ptr (cinfo^.main); main := my_main_ptr (cinfo^.main);
{ Do nothing in raw-data mode. } { Do nothing in raw-data mode. }
if (cinfo^.raw_data_in) then if (cinfo^.raw_data_in) then
exit; exit;
main^.cur_iMCU_row := 0; { initialize counters } main^.cur_iMCU_row := 0; { initialize counters }
main^.rowgroup_ctr := 0; main^.rowgroup_ctr := 0;
main^.suspended := FALSE; main^.suspended := FALSE;
main^.pass_mode := pass_mode; { save mode for use by process_data } main^.pass_mode := pass_mode; { save mode for use by process_data }
case (pass_mode) of case (pass_mode) of
JBUF_PASS_THRU: JBUF_PASS_THRU:
begin begin
{$ifdef FULL_MAIN_BUFFER_SUPPORTED} {$ifdef FULL_MAIN_BUFFER_SUPPORTED}
if (main^.whole_image[0] <> NIL) then if (main^.whole_image[0] <> NIL) then
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
{$endif} {$endif}
main^.pub.process_data := process_data_simple_main; main^.pub.process_data := process_data_simple_main;
end; end;
{$ifdef FULL_MAIN_BUFFER_SUPPORTED} {$ifdef FULL_MAIN_BUFFER_SUPPORTED}
JBUF_SAVE_SOURCE, JBUF_SAVE_SOURCE,
JBUF_CRANK_DEST, JBUF_CRANK_DEST,
JBUF_SAVE_AND_PASS: JBUF_SAVE_AND_PASS:
begin begin
if (main^.whole_image[0] = NIL) then if (main^.whole_image[0] = NIL) then
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
main^.pub.process_data := process_data_buffer_main; main^.pub.process_data := process_data_buffer_main;
end; end;
{$endif} {$endif}
else else
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
end; end;
end; end;
{ Process some data. { Process some data.
This routine handles the simple pass-through mode, This routine handles the simple pass-through mode,
where we have only a strip buffer. } where we have only a strip buffer. }
{METHODDEF} {METHODDEF}
procedure process_data_simple_main (cinfo : j_compress_ptr; procedure process_data_simple_main (cinfo : j_compress_ptr;
input_buf : JSAMPARRAY; input_buf : JSAMPARRAY;
var in_row_ctr : JDIMENSION; var in_row_ctr : JDIMENSION;
in_rows_avail : JDIMENSION); in_rows_avail : JDIMENSION);
var var
main : my_main_ptr; main : my_main_ptr;
begin begin
main := my_main_ptr (cinfo^.main); main := my_main_ptr (cinfo^.main);
while (main^.cur_iMCU_row < cinfo^.total_iMCU_rows) do while (main^.cur_iMCU_row < cinfo^.total_iMCU_rows) do
begin begin
{ Read input data if we haven't filled the main buffer yet } { Read input data if we haven't filled the main buffer yet }
if (main^.rowgroup_ctr < DCTSIZE) then if (main^.rowgroup_ctr < DCTSIZE) then
cinfo^.prep^.pre_process_data (cinfo, cinfo^.prep^.pre_process_data (cinfo,
input_buf, input_buf,
in_row_ctr, in_row_ctr,
in_rows_avail, in_rows_avail,
JSAMPIMAGE(@main^.buffer), JSAMPIMAGE(@main^.buffer),
main^.rowgroup_ctr, main^.rowgroup_ctr,
JDIMENSION(DCTSIZE)); JDIMENSION(DCTSIZE));
{ If we don't have a full iMCU row buffered, return to application for { If we don't have a full iMCU row buffered, return to application for
more data. Note that preprocessor will always pad to fill the iMCU row more data. Note that preprocessor will always pad to fill the iMCU row
at the bottom of the image. } at the bottom of the image. }
if (main^.rowgroup_ctr <> DCTSIZE) then if (main^.rowgroup_ctr <> DCTSIZE) then
exit; exit;
{ Send the completed row to the compressor } { Send the completed row to the compressor }
if (not cinfo^.coef^.compress_data (cinfo, JSAMPIMAGE(@main^.buffer))) then if (not cinfo^.coef^.compress_data (cinfo, JSAMPIMAGE(@main^.buffer))) then
begin begin
{ If compressor did not consume the whole row, then we must need to { If compressor did not consume the whole row, then we must need to
suspend processing and return to the application. In this situation suspend processing and return to the application. In this situation
we pretend we didn't yet consume the last input row; otherwise, if we pretend we didn't yet consume the last input row; otherwise, if
it happened to be the last row of the image, the application would it happened to be the last row of the image, the application would
think we were done. } think we were done. }
if (not main^.suspended) then if (not main^.suspended) then
begin begin
Dec(in_row_ctr); Dec(in_row_ctr);
main^.suspended := TRUE; main^.suspended := TRUE;
end; end;
exit; exit;
end; end;
{ We did finish the row. Undo our little suspension hack if a previous { We did finish the row. Undo our little suspension hack if a previous
call suspended; then mark the main buffer empty. } call suspended; then mark the main buffer empty. }
if (main^.suspended) then if (main^.suspended) then
begin begin
Inc(in_row_ctr); Inc(in_row_ctr);
main^.suspended := FALSE; main^.suspended := FALSE;
end; end;
main^.rowgroup_ctr := 0; main^.rowgroup_ctr := 0;
Inc(main^.cur_iMCU_row); Inc(main^.cur_iMCU_row);
end; end;
end; end;
{$ifdef FULL_MAIN_BUFFER_SUPPORTED} {$ifdef FULL_MAIN_BUFFER_SUPPORTED}
{ Process some data. { Process some data.
This routine handles all of the modes that use a full-size buffer. } This routine handles all of the modes that use a full-size buffer. }
{METHODDEF} {METHODDEF}
procedure process_data_buffer_main (cinfo : j_compress_ptr; procedure process_data_buffer_main (cinfo : j_compress_ptr;
input_buf : JSAMPARRAY; input_buf : JSAMPARRAY;
var in_row_ctr : JDIMENSION; var in_row_ctr : JDIMENSION;
in_rows_avail : JDIMENSION); in_rows_avail : JDIMENSION);
var var
main : my_main_ptr; main : my_main_ptr;
ci : int; ci : int;
compptr : jpeg_component_info_ptr; compptr : jpeg_component_info_ptr;
writing : boolean; writing : boolean;
begin begin
main := my_main_ptr (cinfo^.main); main := my_main_ptr (cinfo^.main);
writing := (main^.pass_mode <> JBUF_CRANK_DEST); writing := (main^.pass_mode <> JBUF_CRANK_DEST);
while (main^.cur_iMCU_row < cinfo^.total_iMCU_rows) do while (main^.cur_iMCU_row < cinfo^.total_iMCU_rows) do
begin begin
{ Realign the virtual buffers if at the start of an iMCU row. } { Realign the virtual buffers if at the start of an iMCU row. }
if (main^.rowgroup_ctr = 0) then if (main^.rowgroup_ctr = 0) then
begin begin
compptr := cinfo^.comp_info; compptr := cinfo^.comp_info;
for ci := 0 to pred(cinfo^.num_components) do for ci := 0 to pred(cinfo^.num_components) do
begin begin
main^.buffer[ci] := cinfo^.mem^.access_virt_sarray main^.buffer[ci] := cinfo^.mem^.access_virt_sarray
(j_common_ptr (cinfo), main^.whole_image[ci], (j_common_ptr (cinfo), main^.whole_image[ci],
main^.cur_iMCU_row * (compptr^.v_samp_factor * DCTSIZE), main^.cur_iMCU_row * (compptr^.v_samp_factor * DCTSIZE),
JDIMENSION (compptr^.v_samp_factor * DCTSIZE), writing); JDIMENSION (compptr^.v_samp_factor * DCTSIZE), writing);
Inc(compptr); Inc(compptr);
end; end;
{ In a read pass, pretend we just read some source data. } { In a read pass, pretend we just read some source data. }
if (not writing) then if (not writing) then
begin begin
Inc(in_row_ctr, cinfo^.max_v_samp_factor * DCTSIZE); Inc(in_row_ctr, cinfo^.max_v_samp_factor * DCTSIZE);
main^.rowgroup_ctr := DCTSIZE; main^.rowgroup_ctr := DCTSIZE;
end; end;
end; end;
{ If a write pass, read input data until the current iMCU row is full. } { If a write pass, read input data until the current iMCU row is full. }
{ Note: preprocessor will pad if necessary to fill the last iMCU row. } { Note: preprocessor will pad if necessary to fill the last iMCU row. }
if (writing) then if (writing) then
begin begin
cinfo^.prep^.pre_process_data (cinfo, cinfo^.prep^.pre_process_data (cinfo,
input_buf, in_row_ctr, in_rows_avail, input_buf, in_row_ctr, in_rows_avail,
JSAMPIMAGE(@main^.buffer), JSAMPIMAGE(@main^.buffer),
main^.rowgroup_ctr, main^.rowgroup_ctr,
JDIMENSION (DCTSIZE)); JDIMENSION (DCTSIZE));
{ Return to application if we need more data to fill the iMCU row. } { Return to application if we need more data to fill the iMCU row. }
if (main^.rowgroup_ctr < DCTSIZE) then if (main^.rowgroup_ctr < DCTSIZE) then
exit; exit;
end; end;
{ Emit data, unless this is a sink-only pass. } { Emit data, unless this is a sink-only pass. }
if (main^.pass_mode <> JBUF_SAVE_SOURCE) then if (main^.pass_mode <> JBUF_SAVE_SOURCE) then
begin begin
if (not cinfo^.coef^.compress_data (cinfo, if (not cinfo^.coef^.compress_data (cinfo,
JSAMPIMAGE(@main^.buffer))) then JSAMPIMAGE(@main^.buffer))) then
begin begin
{ If compressor did not consume the whole row, then we must need to { If compressor did not consume the whole row, then we must need to
suspend processing and return to the application. In this situation suspend processing and return to the application. In this situation
we pretend we didn't yet consume the last input row; otherwise, if we pretend we didn't yet consume the last input row; otherwise, if
it happened to be the last row of the image, the application would it happened to be the last row of the image, the application would
think we were done. } think we were done. }
if (not main^.suspended) then if (not main^.suspended) then
begin begin
Dec(in_row_ctr); Dec(in_row_ctr);
main^.suspended := TRUE; main^.suspended := TRUE;
end; end;
exit; exit;
end; end;
{ We did finish the row. Undo our little suspension hack if a previous { We did finish the row. Undo our little suspension hack if a previous
call suspended; then mark the main buffer empty. } call suspended; then mark the main buffer empty. }
if (main^.suspended) then if (main^.suspended) then
begin begin
Inc(in_row_ctr); Inc(in_row_ctr);
main^.suspended := FALSE; main^.suspended := FALSE;
end; end;
end; end;
{ If get here, we are done with this iMCU row. Mark buffer empty. } { If get here, we are done with this iMCU row. Mark buffer empty. }
main^.rowgroup_ctr := 0; main^.rowgroup_ctr := 0;
Inc(main^.cur_iMCU_row); Inc(main^.cur_iMCU_row);
end; end;
end; end;
{$endif} { FULL_MAIN_BUFFER_SUPPORTED } {$endif} { FULL_MAIN_BUFFER_SUPPORTED }
{ Initialize main buffer controller. } { Initialize main buffer controller. }
{GLOBAL} {GLOBAL}
procedure jinit_c_main_controller (cinfo : j_compress_ptr; procedure jinit_c_main_controller (cinfo : j_compress_ptr;
need_full_buffer : boolean); need_full_buffer : boolean);
var var
main : my_main_ptr; main : my_main_ptr;
ci : int; ci : int;
compptr : jpeg_component_info_ptr; compptr : jpeg_component_info_ptr;
begin begin
main := my_main_ptr( main := my_main_ptr(
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
SIZEOF(my_main_controller)) ); SIZEOF(my_main_controller)) );
cinfo^.main := jpeg_c_main_controller_ptr(main); cinfo^.main := jpeg_c_main_controller_ptr(main);
main^.pub.start_pass := start_pass_main; main^.pub.start_pass := start_pass_main;
{ We don't need to create a buffer in raw-data mode. } { We don't need to create a buffer in raw-data mode. }
if (cinfo^.raw_data_in) then if (cinfo^.raw_data_in) then
exit; exit;
{ Create the buffer. It holds downsampled data, so each component { Create the buffer. It holds downsampled data, so each component
may be of a different size. } may be of a different size. }
if (need_full_buffer) then if (need_full_buffer) then
begin begin
{$ifdef FULL_MAIN_BUFFER_SUPPORTED} {$ifdef FULL_MAIN_BUFFER_SUPPORTED}
{ Allocate a full-image virtual array for each component } { Allocate a full-image virtual array for each component }
{ Note we pad the bottom to a multiple of the iMCU height } { Note we pad the bottom to a multiple of the iMCU height }
compptr := cinfo^.comp_info; compptr := cinfo^.comp_info;
for ci := 0 to pred(cinfo^.num_components) do for ci := 0 to pred(cinfo^.num_components) do
begin begin
main^.whole_image[ci] := cinfo^.mem^.request_virt_sarray main^.whole_image[ci] := cinfo^.mem^.request_virt_sarray
(j_common_ptr(cinfo), JPOOL_IMAGE, FALSE, (j_common_ptr(cinfo), JPOOL_IMAGE, FALSE,
compptr^.width_in_blocks * DCTSIZE, compptr^.width_in_blocks * DCTSIZE,
JDIMENSION (jround_up( long (compptr^.height_in_blocks), JDIMENSION (jround_up( long (compptr^.height_in_blocks),
long (compptr^.v_samp_factor)) * DCTSIZE), long (compptr^.v_samp_factor)) * DCTSIZE),
JDIMENSION (compptr^.v_samp_factor * DCTSIZE)); JDIMENSION (compptr^.v_samp_factor * DCTSIZE));
Inc(compptr); Inc(compptr);
end; end;
{$else} {$else}
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
{$endif} {$endif}
end end
else else
begin begin
{$ifdef FULL_MAIN_BUFFER_SUPPORTED} {$ifdef FULL_MAIN_BUFFER_SUPPORTED}
main^.whole_image[0] := NIL; { flag for no virtual arrays } main^.whole_image[0] := NIL; { flag for no virtual arrays }
{$endif} {$endif}
{ Allocate a strip buffer for each component } { Allocate a strip buffer for each component }
compptr := jpeg_component_info_ptr(cinfo^.comp_info); compptr := jpeg_component_info_ptr(cinfo^.comp_info);
for ci := 0 to pred(cinfo^.num_components) do for ci := 0 to pred(cinfo^.num_components) do
begin begin
main^.buffer[ci] := cinfo^.mem^.alloc_sarray main^.buffer[ci] := cinfo^.mem^.alloc_sarray
(j_common_ptr(cinfo), JPOOL_IMAGE, (j_common_ptr(cinfo), JPOOL_IMAGE,
compptr^.width_in_blocks * DCTSIZE, compptr^.width_in_blocks * DCTSIZE,
JDIMENSION (compptr^.v_samp_factor * DCTSIZE)); JDIMENSION (compptr^.v_samp_factor * DCTSIZE));
Inc(compptr); Inc(compptr);
end; end;
end; end;
end; end;
end. end.

1448
Imaging/JpegLib/imjcmarker.pas
View File

File diff suppressed because it is too large Load Diff

1402
Imaging/JpegLib/imjcmaster.pas
View File

File diff suppressed because it is too large Load Diff

260
Imaging/JpegLib/imjcomapi.pas
View File

@ -1,130 +1,130 @@
unit imjcomapi; unit imjcomapi;
{ This file contains application interface routines that are used for both { This file contains application interface routines that are used for both
compression and decompression. } compression and decompression. }
{ Original: jcomapi.c; Copyright (C) 1994-1997, Thomas G. Lane. } { Original: jcomapi.c; Copyright (C) 1994-1997, Thomas G. Lane. }
interface interface
{$I imjconfig.inc} {$I imjconfig.inc}
uses uses
imjmorecfg, imjmorecfg,
imjinclude, imjinclude,
imjpeglib; imjpeglib;
{ Abort processing of a JPEG compression or decompression operation, { Abort processing of a JPEG compression or decompression operation,
but don't destroy the object itself. } but don't destroy the object itself. }
{GLOBAL} {GLOBAL}
procedure jpeg_abort (cinfo : j_common_ptr); procedure jpeg_abort (cinfo : j_common_ptr);
{ Destruction of a JPEG object. } { Destruction of a JPEG object. }
{GLOBAL} {GLOBAL}
procedure jpeg_destroy (cinfo : j_common_ptr); procedure jpeg_destroy (cinfo : j_common_ptr);
{GLOBAL} {GLOBAL}
function jpeg_alloc_quant_table (cinfo : j_common_ptr) : JQUANT_TBL_PTR; function jpeg_alloc_quant_table (cinfo : j_common_ptr) : JQUANT_TBL_PTR;
{GLOBAL} {GLOBAL}
function jpeg_alloc_huff_table (cinfo : j_common_ptr) : JHUFF_TBL_PTR; function jpeg_alloc_huff_table (cinfo : j_common_ptr) : JHUFF_TBL_PTR;
implementation implementation
{ Abort processing of a JPEG compression or decompression operation, { Abort processing of a JPEG compression or decompression operation,
but don't destroy the object itself. but don't destroy the object itself.
For this, we merely clean up all the nonpermanent memory pools. For this, we merely clean up all the nonpermanent memory pools.
Note that temp files (virtual arrays) are not allowed to belong to Note that temp files (virtual arrays) are not allowed to belong to
the permanent pool, so we will be able to close all temp files here. the permanent pool, so we will be able to close all temp files here.
Closing a data source or destination, if necessary, is the application's Closing a data source or destination, if necessary, is the application's
responsibility. } responsibility. }
{GLOBAL} {GLOBAL}
procedure jpeg_abort (cinfo : j_common_ptr); procedure jpeg_abort (cinfo : j_common_ptr);
var var
pool : int; pool : int;
begin begin
{ Do nothing if called on a not-initialized or destroyed JPEG object. } { Do nothing if called on a not-initialized or destroyed JPEG object. }
if (cinfo^.mem = NIL) then if (cinfo^.mem = NIL) then
exit; exit;
{ Releasing pools in reverse order might help avoid fragmentation { Releasing pools in reverse order might help avoid fragmentation
with some (brain-damaged) malloc libraries. } with some (brain-damaged) malloc libraries. }
for pool := JPOOL_NUMPOOLS-1 downto JPOOL_PERMANENT+1 do for pool := JPOOL_NUMPOOLS-1 downto JPOOL_PERMANENT+1 do
begin begin
cinfo^.mem^.free_pool (cinfo, pool); cinfo^.mem^.free_pool (cinfo, pool);
end; end;
{ Reset overall state for possible reuse of object } { Reset overall state for possible reuse of object }
if (cinfo^.is_decompressor) then if (cinfo^.is_decompressor) then
begin begin
cinfo^.global_state := DSTATE_START; cinfo^.global_state := DSTATE_START;
{ Try to keep application from accessing now-deleted marker list. { Try to keep application from accessing now-deleted marker list.
A bit kludgy to do it here, but this is the most central place. } A bit kludgy to do it here, but this is the most central place. }
j_decompress_ptr(cinfo)^.marker_list := NIL; j_decompress_ptr(cinfo)^.marker_list := NIL;
end end
else else
begin begin
cinfo^.global_state := CSTATE_START; cinfo^.global_state := CSTATE_START;
end; end;
end; end;
{ Destruction of a JPEG object. { Destruction of a JPEG object.
Everything gets deallocated except the master jpeg_compress_struct itself Everything gets deallocated except the master jpeg_compress_struct itself
and the error manager struct. Both of these are supplied by the application and the error manager struct. Both of these are supplied by the application
and must be freed, if necessary, by the application. (Often they are on and must be freed, if necessary, by the application. (Often they are on
the stack and so don't need to be freed anyway.) the stack and so don't need to be freed anyway.)
Closing a data source or destination, if necessary, is the application's Closing a data source or destination, if necessary, is the application's
responsibility. } responsibility. }
{GLOBAL} {GLOBAL}
procedure jpeg_destroy (cinfo : j_common_ptr); procedure jpeg_destroy (cinfo : j_common_ptr);
begin begin
{ We need only tell the memory manager to release everything. } { We need only tell the memory manager to release everything. }
{ NB: mem pointer is NIL if memory mgr failed to initialize. } { NB: mem pointer is NIL if memory mgr failed to initialize. }
if (cinfo^.mem <> NIL) then if (cinfo^.mem <> NIL) then
cinfo^.mem^.self_destruct (cinfo); cinfo^.mem^.self_destruct (cinfo);
cinfo^.mem := NIL; { be safe if jpeg_destroy is called twice } cinfo^.mem := NIL; { be safe if jpeg_destroy is called twice }
cinfo^.global_state := 0; { mark it destroyed } cinfo^.global_state := 0; { mark it destroyed }
end; end;
{ Convenience routines for allocating quantization and Huffman tables. { Convenience routines for allocating quantization and Huffman tables.
(Would jutils.c be a more reasonable place to put these?) } (Would jutils.c be a more reasonable place to put these?) }
{GLOBAL} {GLOBAL}
function jpeg_alloc_quant_table (cinfo : j_common_ptr) : JQUANT_TBL_PTR; function jpeg_alloc_quant_table (cinfo : j_common_ptr) : JQUANT_TBL_PTR;
var var
tbl : JQUANT_TBL_PTR; tbl : JQUANT_TBL_PTR;
begin begin
tbl := JQUANT_TBL_PTR( tbl := JQUANT_TBL_PTR(
cinfo^.mem^.alloc_small (cinfo, JPOOL_PERMANENT, SIZEOF(JQUANT_TBL)) cinfo^.mem^.alloc_small (cinfo, JPOOL_PERMANENT, SIZEOF(JQUANT_TBL))
); );
tbl^.sent_table := FALSE; { make sure this is false in any new table } tbl^.sent_table := FALSE; { make sure this is false in any new table }
jpeg_alloc_quant_table := tbl; jpeg_alloc_quant_table := tbl;
end; end;
{GLOBAL} {GLOBAL}
function jpeg_alloc_huff_table (cinfo : j_common_ptr) : JHUFF_TBL_PTR; function jpeg_alloc_huff_table (cinfo : j_common_ptr) : JHUFF_TBL_PTR;
var var
tbl : JHUFF_TBL_PTR; tbl : JHUFF_TBL_PTR;
begin begin
tbl := JHUFF_TBL_PTR( tbl := JHUFF_TBL_PTR(
cinfo^.mem^.alloc_small (cinfo, JPOOL_PERMANENT, SIZEOF(JHUFF_TBL)) cinfo^.mem^.alloc_small (cinfo, JPOOL_PERMANENT, SIZEOF(JHUFF_TBL))
); );
tbl^.sent_table := FALSE; { make sure this is false in any new table } tbl^.sent_table := FALSE; { make sure this is false in any new table }
jpeg_alloc_huff_table := tbl; jpeg_alloc_huff_table := tbl;
end; end;
end. end.

250
Imaging/JpegLib/imjconfig.inc
View File

@ -1,124 +1,126 @@
{ ----------------------- JPEG_INTERNAL_OPTIONS ---------------------- } { ----------------------- JPEG_INTERNAL_OPTIONS ---------------------- }
{ These defines indicate whether to include various optional functions. { These defines indicate whether to include various optional functions.
Undefining some of these symbols will produce a smaller but less capable Undefining some of these symbols will produce a smaller but less capable
library. Note that you can leave certain source files out of the library. Note that you can leave certain source files out of the
compilation/linking process if you've #undef'd the corresponding symbols. compilation/linking process if you've #undef'd the corresponding symbols.
(You may HAVE to do that if your compiler doesn't like null source files.)} (You may HAVE to do that if your compiler doesn't like null source files.)}
{ Arithmetic coding is unsupported for legal reasons. Complaints to IBM. } { Arithmetic coding is unsupported for legal reasons. Complaints to IBM. }
{ Capability options common to encoder and decoder: } { Capability options common to encoder and decoder: }
{$define DCT_ISLOW_SUPPORTED} { slow but accurate integer algorithm } {$define DCT_ISLOW_SUPPORTED} { slow but accurate integer algorithm }
{$define DCT_IFAST_SUPPORTED} { faster, less accurate integer method } {$define DCT_IFAST_SUPPORTED} { faster, less accurate integer method }
{$define DCT_FLOAT_SUPPORTED} { floating-point: accurate, fast on fast HW } {$define DCT_FLOAT_SUPPORTED} { floating-point: accurate, fast on fast HW }
{ Encoder capability options: } { Encoder capability options: }
{$undef C_ARITH_CODING_SUPPORTED} { Arithmetic coding back end? } {$undef C_ARITH_CODING_SUPPORTED} { Arithmetic coding back end? }
{$define C_MULTISCAN_FILES_SUPPORTED} { Multiple-scan JPEG files? } {$define C_MULTISCAN_FILES_SUPPORTED} { Multiple-scan JPEG files? }
{$define C_PROGRESSIVE_SUPPORTED} { Progressive JPEG? (Requires MULTISCAN)} {$define C_PROGRESSIVE_SUPPORTED} { Progressive JPEG? (Requires MULTISCAN)}
{$define ENTROPY_OPT_SUPPORTED} { Optimization of entropy coding parms? } {$define ENTROPY_OPT_SUPPORTED} { Optimization of entropy coding parms? }
{ Note: if you selected 12-bit data precision, it is dangerous to turn off { Note: if you selected 12-bit data precision, it is dangerous to turn off
ENTROPY_OPT_SUPPORTED. The standard Huffman tables are only good for 8-bit ENTROPY_OPT_SUPPORTED. The standard Huffman tables are only good for 8-bit
precision, so jchuff.c normally uses entropy optimization to compute precision, so jchuff.c normally uses entropy optimization to compute
usable tables for higher precision. If you don't want to do optimization, usable tables for higher precision. If you don't want to do optimization,
you'll have to supply different default Huffman tables. you'll have to supply different default Huffman tables.
The exact same statements apply for progressive JPEG: the default tables The exact same statements apply for progressive JPEG: the default tables
don't work for progressive mode. (This may get fixed, however.) } don't work for progressive mode. (This may get fixed, however.) }
{$define INPUT_SMOOTHING_SUPPORTED} { Input image smoothing option? } {$define INPUT_SMOOTHING_SUPPORTED} { Input image smoothing option? }
{ Decoder capability options: } { Decoder capability options: }
{$undef D_ARITH_CODING_SUPPORTED} { Arithmetic coding back end? } {$undef D_ARITH_CODING_SUPPORTED} { Arithmetic coding back end? }
{$define D_MULTISCAN_FILES_SUPPORTED} { Multiple-scan JPEG files? } {$define D_MULTISCAN_FILES_SUPPORTED} { Multiple-scan JPEG files? }
{$define D_PROGRESSIVE_SUPPORTED} { Progressive JPEG? (Requires MULTISCAN)} {$define D_PROGRESSIVE_SUPPORTED} { Progressive JPEG? (Requires MULTISCAN)}
{$define SAVE_MARKERS_SUPPORTED} { jpeg_save_markers() needed? } {$define SAVE_MARKERS_SUPPORTED} { jpeg_save_markers() needed? }
{$define BLOCK_SMOOTHING_SUPPORTED} { Block smoothing? (Progressive only) } {$define BLOCK_SMOOTHING_SUPPORTED} { Block smoothing? (Progressive only) }
{$define IDCT_SCALING_SUPPORTED} { Output rescaling via IDCT? } {$define IDCT_SCALING_SUPPORTED} { Output rescaling via IDCT? }
{$undef UPSAMPLE_SCALING_SUPPORTED} { Output rescaling at upsample stage? } {$undef UPSAMPLE_SCALING_SUPPORTED} { Output rescaling at upsample stage? }
{$define UPSAMPLE_MERGING_SUPPORTED} { Fast path for sloppy upsampling? } {$define UPSAMPLE_MERGING_SUPPORTED} { Fast path for sloppy upsampling? }
{$define QUANT_1PASS_SUPPORTED} { 1-pass color quantization? } {$define QUANT_1PASS_SUPPORTED} { 1-pass color quantization? }
{$define QUANT_2PASS_SUPPORTED} { 2-pass color quantization? } {$define QUANT_2PASS_SUPPORTED} { 2-pass color quantization? }
{ If you happen not to want the image transform support, disable it here } { If you happen not to want the image transform support, disable it here }
{$define TRANSFORMS_SUPPORTED} {$define TRANSFORMS_SUPPORTED}
{ more capability options later, no doubt } { more capability options later, no doubt }
{$ifopt I+} {$define IOcheck} {$endif} {$ifopt I+} {$define IOcheck} {$endif}
{ ------------------------------------------------------------------------ } { ------------------------------------------------------------------------ }
{$define USE_FMEM} { Borland has _fmemcpy() and _fmemset() } {$define USE_FMEM} { Borland has _fmemcpy() and _fmemset() }
{$define FMEMCOPY} {$define FMEMCOPY}
{$define FMEMZERO} {$define FMEMZERO}
{$define DCTSIZE_IS_8} { e.g. unroll the inner loop } {$define DCTSIZE_IS_8} { e.g. unroll the inner loop }
{$define RIGHT_SHIFT_IS_UNSIGNED} {$define RIGHT_SHIFT_IS_UNSIGNED}
{$undef AVOID_TABLES} {$undef AVOID_TABLES}
{$undef FAST_DIVIDE} {$undef FAST_DIVIDE}
{$define BITS_IN_JSAMPLE_IS_8} {$define BITS_IN_JSAMPLE_IS_8}
{----------------------------------------------------------------} {----------------------------------------------------------------}
{ for test of 12 bit JPEG code only. !! } { for test of 12 bit JPEG code only. !! }
{-- $undef BITS_IN_JSAMPLE_IS_8} {-- $undef BITS_IN_JSAMPLE_IS_8}
{----------------------------------------------------------------} {----------------------------------------------------------------}
//{$define RGB_RED_IS_0} //{$define RGB_RED_IS_0}
{ !CHANGE: This must be defined for Delphi/Kylix/FPC } { !CHANGE: This must be defined for Delphi/Kylix/FPC }
{$define RGB_RED_IS_2} { RGB byte order } {$define RGB_RED_IS_2} { RGB byte order }
{$define RGB_PIXELSIZE_IS_3} {$define RGB_PIXELSIZE_IS_3}
{$define SLOW_SHIFT_32} {$define SLOW_SHIFT_32}
{$undef NO_ZERO_ROW_TEST} {$undef NO_ZERO_ROW_TEST}
{$define USE_MSDOS_MEMMGR} { Define this if you use jmemdos.c } {$define USE_MSDOS_MEMMGR} { Define this if you use jmemdos.c }
{$define XMS_SUPPORTED} {$define XMS_SUPPORTED}
{$define EMS_SUPPORTED} {$define EMS_SUPPORTED}
{$undef MEM_STATS} { Write out memory usage } {$undef MEM_STATS} { Write out memory usage }
{$define AM_MEMORY_MANAGER} { we define jvirt_Xarray_control structs } {$define AM_MEMORY_MANAGER} { we define jvirt_Xarray_control structs }
{$undef FULL_MAIN_BUFFER_SUPPORTED} {$undef FULL_MAIN_BUFFER_SUPPORTED}
{$define PROGRESS_REPORT} {$define PROGRESS_REPORT}
{$define TWO_FILE_COMMANDLINE} {$define TWO_FILE_COMMANDLINE}
{$undef BMP_SUPPORTED} {$undef BMP_SUPPORTED}
{$undef PPM_SUPPORTED} {$undef PPM_SUPPORTED}
{$undef GIF_SUPPORTED} {$undef GIF_SUPPORTED}
{$undef RLE_SUPPORTED} {$undef RLE_SUPPORTED}
{$undef TARGA_SUPPORTED} {$undef TARGA_SUPPORTED}
{$define EXT_SWITCH} {$define EXT_SWITCH}
{$ifndef BITS_IN_JSAMPLE_IS_8} { for 12 bit samples } {$ifndef BITS_IN_JSAMPLE_IS_8} { for 12 bit samples }
{$undef BMP_SUPPORTED} {$undef BMP_SUPPORTED}
{$undef RLE_SUPPORTED} {$undef RLE_SUPPORTED}
{$undef TARGA_SUPPORTED} {$undef TARGA_SUPPORTED}
{$endif} {$endif}
{!CHANGE: Allowed only for Delphi} {!CHANGE: Allowed only for Delphi}
{$undef BASM16} { for TP7 - use BASM for fast multiply } {$undef BASM16} { for TP7 - use BASM for fast multiply }
{$ifdef Win32} {$ifdef Win32}
{$ifndef FPC} {$ifndef FPC}
{$define BASM} { jidctint with BASM for Delphi 2/3 } {$define BASM} { jidctint with BASM for Delphi 2/3 }
{$undef RGB_RED_IS_0} { BGR byte order in JQUANT2 } {$undef RGB_RED_IS_0} { BGR byte order in JQUANT2 }
{$endif} {$endif}
{$endif} {$endif}
{$ifdef FPC} {$ifdef FPC}
{$MODE DELPHI} {$MODE DELPHI}
{$endif} {$endif}
{!CHANGE: Added this} {!CHANGE: Added this}
{$define Delphi_Stream} {$define Delphi_Stream}
{$Q-} {$Q-}
{$MINENUMSIZE 4}
{$ALIGN 8}

1402
Imaging/JpegLib/imjcparam.pas
View File

File diff suppressed because it is too large Load Diff

1924
Imaging/JpegLib/imjcphuff.pas
View File

File diff suppressed because it is too large Load Diff

812
Imaging/JpegLib/imjcprepct.pas
View File

@ -1,406 +1,406 @@
unit imjcprepct; unit imjcprepct;
{ Original : jcprepct.c ; Copyright (C) 1994-1996, Thomas G. Lane. } { Original : jcprepct.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
{ This file contains the compression preprocessing controller. { This file contains the compression preprocessing controller.
This controller manages the color conversion, downsampling, This controller manages the color conversion, downsampling,
and edge expansion steps. and edge expansion steps.
Most of the complexity here is associated with buffering input rows Most of the complexity here is associated with buffering input rows
as required by the downsampler. See the comments at the head of as required by the downsampler. See the comments at the head of
jcsample.c for the downsampler's needs. } jcsample.c for the downsampler's needs. }
interface interface
{$I imjconfig.inc} {$I imjconfig.inc}
uses uses
imjmorecfg, imjmorecfg,
imjpeglib, imjpeglib,
imjdeferr, imjdeferr,
imjerror, imjerror,
imjinclude, imjinclude,
imjutils; imjutils;
{GLOBAL} {GLOBAL}
procedure jinit_c_prep_controller (cinfo : j_compress_ptr; procedure jinit_c_prep_controller (cinfo : j_compress_ptr;
need_full_buffer : boolean); need_full_buffer : boolean);
implementation implementation
{ At present, jcsample.c can request context rows only for smoothing. { At present, jcsample.c can request context rows only for smoothing.
In the future, we might also need context rows for CCIR601 sampling In the future, we might also need context rows for CCIR601 sampling
or other more-complex downsampling procedures. The code to support or other more-complex downsampling procedures. The code to support
context rows should be compiled only if needed. } context rows should be compiled only if needed. }
{$ifdef INPUT_SMOOTHING_SUPPORTED} {$ifdef INPUT_SMOOTHING_SUPPORTED}
{$define CONTEXT_ROWS_SUPPORTED} {$define CONTEXT_ROWS_SUPPORTED}
{$endif} {$endif}
{ For the simple (no-context-row) case, we just need to buffer one { For the simple (no-context-row) case, we just need to buffer one
row group's worth of pixels for the downsampling step. At the bottom of row group's worth of pixels for the downsampling step. At the bottom of
the image, we pad to a full row group by replicating the last pixel row. the image, we pad to a full row group by replicating the last pixel row.
The downsampler's last output row is then replicated if needed to pad The downsampler's last output row is then replicated if needed to pad
out to a full iMCU row. out to a full iMCU row.
When providing context rows, we must buffer three row groups' worth of When providing context rows, we must buffer three row groups' worth of
pixels. Three row groups are physically allocated, but the row pointer pixels. Three row groups are physically allocated, but the row pointer
arrays are made five row groups high, with the extra pointers above and arrays are made five row groups high, with the extra pointers above and
below "wrapping around" to point to the last and first real row groups. below "wrapping around" to point to the last and first real row groups.
This allows the downsampler to access the proper context rows. This allows the downsampler to access the proper context rows.
At the top and bottom of the image, we create dummy context rows by At the top and bottom of the image, we create dummy context rows by
copying the first or last real pixel row. This copying could be avoided copying the first or last real pixel row. This copying could be avoided
by pointer hacking as is done in jdmainct.c, but it doesn't seem worth the by pointer hacking as is done in jdmainct.c, but it doesn't seem worth the
trouble on the compression side. } trouble on the compression side. }
{ Private buffer controller object } { Private buffer controller object }
type type
my_prep_ptr = ^my_prep_controller; my_prep_ptr = ^my_prep_controller;
my_prep_controller = record my_prep_controller = record
pub : jpeg_c_prep_controller; { public fields } pub : jpeg_c_prep_controller; { public fields }
{ Downsampling input buffer. This buffer holds color-converted data { Downsampling input buffer. This buffer holds color-converted data
until we have enough to do a downsample step. } until we have enough to do a downsample step. }
color_buf : array[0..MAX_COMPONENTS-1] of JSAMPARRAY; color_buf : array[0..MAX_COMPONENTS-1] of JSAMPARRAY;
rows_to_go : JDIMENSION; { counts rows remaining in source image } rows_to_go : JDIMENSION; { counts rows remaining in source image }
next_buf_row : int; { index of next row to store in color_buf } next_buf_row : int; { index of next row to store in color_buf }
{$ifdef CONTEXT_ROWS_SUPPORTED} { only needed for context case } {$ifdef CONTEXT_ROWS_SUPPORTED} { only needed for context case }
this_row_group : int; { starting row index of group to process } this_row_group : int; { starting row index of group to process }
next_buf_stop : int; { downsample when we reach this index } next_buf_stop : int; { downsample when we reach this index }
{$endif} {$endif}
end; {my_prep_controller;} end; {my_prep_controller;}
{ Initialize for a processing pass. } { Initialize for a processing pass. }
{METHODDEF} {METHODDEF}
procedure start_pass_prep (cinfo : j_compress_ptr; procedure start_pass_prep (cinfo : j_compress_ptr;
pass_mode : J_BUF_MODE ); pass_mode : J_BUF_MODE );
var var
prep : my_prep_ptr; prep : my_prep_ptr;
begin begin
prep := my_prep_ptr (cinfo^.prep); prep := my_prep_ptr (cinfo^.prep);
if (pass_mode <> JBUF_PASS_THRU) then if (pass_mode <> JBUF_PASS_THRU) then
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
{ Initialize total-height counter for detecting bottom of image } { Initialize total-height counter for detecting bottom of image }
prep^.rows_to_go := cinfo^.image_height; prep^.rows_to_go := cinfo^.image_height;
{ Mark the conversion buffer empty } { Mark the conversion buffer empty }
prep^.next_buf_row := 0; prep^.next_buf_row := 0;
{$ifdef CONTEXT_ROWS_SUPPORTED} {$ifdef CONTEXT_ROWS_SUPPORTED}
{ Preset additional state variables for context mode. { Preset additional state variables for context mode.
These aren't used in non-context mode, so we needn't test which mode. } These aren't used in non-context mode, so we needn't test which mode. }
prep^.this_row_group := 0; prep^.this_row_group := 0;
{ Set next_buf_stop to stop after two row groups have been read in. } { Set next_buf_stop to stop after two row groups have been read in. }
prep^.next_buf_stop := 2 * cinfo^.max_v_samp_factor; prep^.next_buf_stop := 2 * cinfo^.max_v_samp_factor;
{$endif} {$endif}
end; end;
{ Expand an image vertically from height input_rows to height output_rows, { Expand an image vertically from height input_rows to height output_rows,
by duplicating the bottom row. } by duplicating the bottom row. }
{LOCAL} {LOCAL}
procedure expand_bottom_edge (image_data : JSAMPARRAY; procedure expand_bottom_edge (image_data : JSAMPARRAY;
num_cols : JDIMENSION; num_cols : JDIMENSION;
input_rows : int; input_rows : int;
output_rows : int); output_rows : int);
var var
{register} row : int; {register} row : int;
begin begin
for row := input_rows to pred(output_rows) do for row := input_rows to pred(output_rows) do
begin begin
jcopy_sample_rows(image_data, input_rows-1, image_data, row, jcopy_sample_rows(image_data, input_rows-1, image_data, row,
1, num_cols); 1, num_cols);
end; end;
end; end;
{ Process some data in the simple no-context case. { Process some data in the simple no-context case.
Preprocessor output data is counted in "row groups". A row group Preprocessor output data is counted in "row groups". A row group
is defined to be v_samp_factor sample rows of each component. is defined to be v_samp_factor sample rows of each component.
Downsampling will produce this much data from each max_v_samp_factor Downsampling will produce this much data from each max_v_samp_factor
input rows. } input rows. }
{METHODDEF} {METHODDEF}
procedure pre_process_data (cinfo : j_compress_ptr; procedure pre_process_data (cinfo : j_compress_ptr;
input_buf : JSAMPARRAY; input_buf : JSAMPARRAY;
var in_row_ctr : JDIMENSION; var in_row_ctr : JDIMENSION;
in_rows_avail : JDIMENSION; in_rows_avail : JDIMENSION;
output_buf : JSAMPIMAGE; output_buf : JSAMPIMAGE;
var out_row_group_ctr : JDIMENSION; var out_row_group_ctr : JDIMENSION;
out_row_groups_avail : JDIMENSION); out_row_groups_avail : JDIMENSION);
var var
prep : my_prep_ptr; prep : my_prep_ptr;
numrows, ci : int; numrows, ci : int;
inrows : JDIMENSION; inrows : JDIMENSION;
compptr : jpeg_component_info_ptr; compptr : jpeg_component_info_ptr;
var var
local_input_buf : JSAMPARRAY; local_input_buf : JSAMPARRAY;
begin begin
prep := my_prep_ptr (cinfo^.prep); prep := my_prep_ptr (cinfo^.prep);
while (in_row_ctr < in_rows_avail) and while (in_row_ctr < in_rows_avail) and
(out_row_group_ctr < out_row_groups_avail) do (out_row_group_ctr < out_row_groups_avail) do
begin begin
{ Do color conversion to fill the conversion buffer. } { Do color conversion to fill the conversion buffer. }
inrows := in_rows_avail - in_row_ctr; inrows := in_rows_avail - in_row_ctr;
numrows := cinfo^.max_v_samp_factor - prep^.next_buf_row; numrows := cinfo^.max_v_samp_factor - prep^.next_buf_row;
{numrows := int( MIN(JDIMENSION(numrows), inrows) );} {numrows := int( MIN(JDIMENSION(numrows), inrows) );}
if inrows < JDIMENSION(numrows) then if inrows < JDIMENSION(numrows) then
numrows := int(inrows); numrows := int(inrows);
local_input_buf := JSAMPARRAY(@(input_buf^[in_row_ctr])); local_input_buf := JSAMPARRAY(@(input_buf^[in_row_ctr]));
cinfo^.cconvert^.color_convert (cinfo, local_input_buf, cinfo^.cconvert^.color_convert (cinfo, local_input_buf,
JSAMPIMAGE(@prep^.color_buf), JSAMPIMAGE(@prep^.color_buf),
JDIMENSION(prep^.next_buf_row), JDIMENSION(prep^.next_buf_row),
numrows); numrows);
Inc(in_row_ctr, numrows); Inc(in_row_ctr, numrows);
Inc(prep^.next_buf_row, numrows); Inc(prep^.next_buf_row, numrows);
Dec(prep^.rows_to_go, numrows); Dec(prep^.rows_to_go, numrows);
{ If at bottom of image, pad to fill the conversion buffer. } { If at bottom of image, pad to fill the conversion buffer. }
if (prep^.rows_to_go = 0) and if (prep^.rows_to_go = 0) and
(prep^.next_buf_row < cinfo^.max_v_samp_factor) then (prep^.next_buf_row < cinfo^.max_v_samp_factor) then
begin begin
for ci := 0 to pred(cinfo^.num_components) do for ci := 0 to pred(cinfo^.num_components) do
begin begin
expand_bottom_edge(prep^.color_buf[ci], cinfo^.image_width, expand_bottom_edge(prep^.color_buf[ci], cinfo^.image_width,
prep^.next_buf_row, cinfo^.max_v_samp_factor); prep^.next_buf_row, cinfo^.max_v_samp_factor);
end; end;
prep^.next_buf_row := cinfo^.max_v_samp_factor; prep^.next_buf_row := cinfo^.max_v_samp_factor;
end; end;
{ If we've filled the conversion buffer, empty it. } { If we've filled the conversion buffer, empty it. }
if (prep^.next_buf_row = cinfo^.max_v_samp_factor) then if (prep^.next_buf_row = cinfo^.max_v_samp_factor) then
begin begin
cinfo^.downsample^.downsample (cinfo, cinfo^.downsample^.downsample (cinfo,
JSAMPIMAGE(@prep^.color_buf), JSAMPIMAGE(@prep^.color_buf),
JDIMENSION (0), JDIMENSION (0),
output_buf, output_buf,
out_row_group_ctr); out_row_group_ctr);
prep^.next_buf_row := 0; prep^.next_buf_row := 0;
Inc(out_row_group_ctr);; Inc(out_row_group_ctr);;
end; end;
{ If at bottom of image, pad the output to a full iMCU height. { If at bottom of image, pad the output to a full iMCU height.
Note we assume the caller is providing a one-iMCU-height output buffer! } Note we assume the caller is providing a one-iMCU-height output buffer! }
if (prep^.rows_to_go = 0) and if (prep^.rows_to_go = 0) and
(out_row_group_ctr < out_row_groups_avail) then (out_row_group_ctr < out_row_groups_avail) then
begin begin
compptr := jpeg_component_info_ptr(cinfo^.comp_info); compptr := jpeg_component_info_ptr(cinfo^.comp_info);
for ci := 0 to pred(cinfo^.num_components) do for ci := 0 to pred(cinfo^.num_components) do
begin begin
expand_bottom_edge(output_buf^[ci], expand_bottom_edge(output_buf^[ci],
compptr^.width_in_blocks * DCTSIZE, compptr^.width_in_blocks * DCTSIZE,
int (out_row_group_ctr) * compptr^.v_samp_factor, int (out_row_group_ctr) * compptr^.v_samp_factor,
int (out_row_groups_avail) * compptr^.v_samp_factor); int (out_row_groups_avail) * compptr^.v_samp_factor);
Inc(compptr); Inc(compptr);
end; end;
out_row_group_ctr := out_row_groups_avail; out_row_group_ctr := out_row_groups_avail;
break; { can exit outer loop without test } break; { can exit outer loop without test }
end; end;
end; end;
end; end;
{$ifdef CONTEXT_ROWS_SUPPORTED} {$ifdef CONTEXT_ROWS_SUPPORTED}
{ Process some data in the context case. } { Process some data in the context case. }
{METHODDEF} {METHODDEF}
procedure pre_process_context (cinfo : j_compress_ptr; procedure pre_process_context (cinfo : j_compress_ptr;
input_buf : JSAMPARRAY; input_buf : JSAMPARRAY;
var in_row_ctr : JDIMENSION; var in_row_ctr : JDIMENSION;
in_rows_avail : JDIMENSION; in_rows_avail : JDIMENSION;
output_buf : JSAMPIMAGE; output_buf : JSAMPIMAGE;
var out_row_group_ctr : JDIMENSION; var out_row_group_ctr : JDIMENSION;
out_row_groups_avail : JDIMENSION); out_row_groups_avail : JDIMENSION);
var var
prep : my_prep_ptr; prep : my_prep_ptr;
numrows, ci : int; numrows, ci : int;
buf_height : int; buf_height : int;
inrows : JDIMENSION; inrows : JDIMENSION;
var var
row : int; row : int;
begin begin
prep := my_prep_ptr (cinfo^.prep); prep := my_prep_ptr (cinfo^.prep);
buf_height := cinfo^.max_v_samp_factor * 3; buf_height := cinfo^.max_v_samp_factor * 3;
while (out_row_group_ctr < out_row_groups_avail) do while (out_row_group_ctr < out_row_groups_avail) do
begin begin
if (in_row_ctr < in_rows_avail) then if (in_row_ctr < in_rows_avail) then
begin begin
{ Do color conversion to fill the conversion buffer. } { Do color conversion to fill the conversion buffer. }
inrows := in_rows_avail - in_row_ctr; inrows := in_rows_avail - in_row_ctr;
numrows := prep^.next_buf_stop - prep^.next_buf_row; numrows := prep^.next_buf_stop - prep^.next_buf_row;
{numrows := int ( MIN( JDIMENSION(numrows), inrows) );} {numrows := int ( MIN( JDIMENSION(numrows), inrows) );}
if inrows < JDIMENSION(numrows) then if inrows < JDIMENSION(numrows) then
numrows := int(inrows); numrows := int(inrows);
cinfo^.cconvert^.color_convert (cinfo, cinfo^.cconvert^.color_convert (cinfo,
JSAMPARRAY(@input_buf^[in_row_ctr]), JSAMPARRAY(@input_buf^[in_row_ctr]),
JSAMPIMAGE(@prep^.color_buf), JSAMPIMAGE(@prep^.color_buf),
JDIMENSION (prep^.next_buf_row), JDIMENSION (prep^.next_buf_row),
numrows); numrows);
{ Pad at top of image, if first time through } { Pad at top of image, if first time through }
if (prep^.rows_to_go = cinfo^.image_height) then if (prep^.rows_to_go = cinfo^.image_height) then
begin begin
for ci := 0 to pred(cinfo^.num_components) do for ci := 0 to pred(cinfo^.num_components) do
begin begin
for row := 1 to cinfo^.max_v_samp_factor do for row := 1 to cinfo^.max_v_samp_factor do
begin begin
jcopy_sample_rows(prep^.color_buf[ci], 0, jcopy_sample_rows(prep^.color_buf[ci], 0,
prep^.color_buf[ci], -row, prep^.color_buf[ci], -row,
1, cinfo^.image_width); 1, cinfo^.image_width);
end; end;
end; end;
end; end;
Inc(in_row_ctr, numrows); Inc(in_row_ctr, numrows);
Inc(prep^.next_buf_row, numrows); Inc(prep^.next_buf_row, numrows);
Dec(prep^.rows_to_go, numrows); Dec(prep^.rows_to_go, numrows);
end end
else else
begin begin
{ Return for more data, unless we are at the bottom of the image. } { Return for more data, unless we are at the bottom of the image. }
if (prep^.rows_to_go <> 0) then if (prep^.rows_to_go <> 0) then
break; break;
{ When at bottom of image, pad to fill the conversion buffer. } { When at bottom of image, pad to fill the conversion buffer. }
if (prep^.next_buf_row < prep^.next_buf_stop) then if (prep^.next_buf_row < prep^.next_buf_stop) then
begin begin
for ci := 0 to pred(cinfo^.num_components) do for ci := 0 to pred(cinfo^.num_components) do
begin begin
expand_bottom_edge(prep^.color_buf[ci], cinfo^.image_width, expand_bottom_edge(prep^.color_buf[ci], cinfo^.image_width,
prep^.next_buf_row, prep^.next_buf_stop); prep^.next_buf_row, prep^.next_buf_stop);
end; end;
prep^.next_buf_row := prep^.next_buf_stop; prep^.next_buf_row := prep^.next_buf_stop;
end; end;
end; end;
{ If we've gotten enough data, downsample a row group. } { If we've gotten enough data, downsample a row group. }
if (prep^.next_buf_row = prep^.next_buf_stop) then if (prep^.next_buf_row = prep^.next_buf_stop) then
begin begin
cinfo^.downsample^.downsample (cinfo, cinfo^.downsample^.downsample (cinfo,
JSAMPIMAGE(@prep^.color_buf), JSAMPIMAGE(@prep^.color_buf),
JDIMENSION(prep^.this_row_group), JDIMENSION(prep^.this_row_group),
output_buf, output_buf,
out_row_group_ctr); out_row_group_ctr);
Inc(out_row_group_ctr); Inc(out_row_group_ctr);
{ Advance pointers with wraparound as necessary. } { Advance pointers with wraparound as necessary. }
Inc(prep^.this_row_group, cinfo^.max_v_samp_factor); Inc(prep^.this_row_group, cinfo^.max_v_samp_factor);
if (prep^.this_row_group >= buf_height) then if (prep^.this_row_group >= buf_height) then
prep^.this_row_group := 0; prep^.this_row_group := 0;
if (prep^.next_buf_row >= buf_height) then if (prep^.next_buf_row >= buf_height) then
prep^.next_buf_row := 0; prep^.next_buf_row := 0;
prep^.next_buf_stop := prep^.next_buf_row + cinfo^.max_v_samp_factor; prep^.next_buf_stop := prep^.next_buf_row + cinfo^.max_v_samp_factor;
end; end;
end; end;
end; end;
{ Create the wrapped-around downsampling input buffer needed for context mode. } { Create the wrapped-around downsampling input buffer needed for context mode. }
{LOCAL} {LOCAL}
procedure create_context_buffer (cinfo : j_compress_ptr); procedure create_context_buffer (cinfo : j_compress_ptr);
var var
prep : my_prep_ptr; prep : my_prep_ptr;
rgroup_height : int; rgroup_height : int;
ci, i : int; ci, i : int;
compptr : jpeg_component_info_ptr; compptr : jpeg_component_info_ptr;
true_buffer, fake_buffer : JSAMPARRAY; true_buffer, fake_buffer : JSAMPARRAY;
begin begin
prep := my_prep_ptr (cinfo^.prep); prep := my_prep_ptr (cinfo^.prep);
rgroup_height := cinfo^.max_v_samp_factor; rgroup_height := cinfo^.max_v_samp_factor;
{ Grab enough space for fake row pointers for all the components; { Grab enough space for fake row pointers for all the components;
we need five row groups' worth of pointers for each component. } we need five row groups' worth of pointers for each component. }
fake_buffer := JSAMPARRAY( fake_buffer := JSAMPARRAY(
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
(cinfo^.num_components * 5 * rgroup_height) * (cinfo^.num_components * 5 * rgroup_height) *
SIZEOF(JSAMPROW)) ); SIZEOF(JSAMPROW)) );
compptr := jpeg_component_info_ptr(cinfo^.comp_info); compptr := jpeg_component_info_ptr(cinfo^.comp_info);
for ci := 0 to pred(cinfo^.num_components) do for ci := 0 to pred(cinfo^.num_components) do
begin begin
{ Allocate the actual buffer space (3 row groups) for this component. { Allocate the actual buffer space (3 row groups) for this component.
We make the buffer wide enough to allow the downsampler to edge-expand We make the buffer wide enough to allow the downsampler to edge-expand
horizontally within the buffer, if it so chooses. } horizontally within the buffer, if it so chooses. }
true_buffer := cinfo^.mem^.alloc_sarray true_buffer := cinfo^.mem^.alloc_sarray
(j_common_ptr(cinfo), JPOOL_IMAGE, (j_common_ptr(cinfo), JPOOL_IMAGE,
JDIMENSION (( long(compptr^.width_in_blocks) * DCTSIZE * JDIMENSION (( long(compptr^.width_in_blocks) * DCTSIZE *
cinfo^.max_h_samp_factor) div compptr^.h_samp_factor), cinfo^.max_h_samp_factor) div compptr^.h_samp_factor),
JDIMENSION (3 * rgroup_height)); JDIMENSION (3 * rgroup_height));
{ Copy true buffer row pointers into the middle of the fake row array } { Copy true buffer row pointers into the middle of the fake row array }
MEMCOPY(JSAMPARRAY(@ fake_buffer^[rgroup_height]), true_buffer, MEMCOPY(JSAMPARRAY(@ fake_buffer^[rgroup_height]), true_buffer,
3 * rgroup_height * SIZEOF(JSAMPROW)); 3 * rgroup_height * SIZEOF(JSAMPROW));
{ Fill in the above and below wraparound pointers } { Fill in the above and below wraparound pointers }
for i := 0 to pred(rgroup_height) do for i := 0 to pred(rgroup_height) do
begin begin
fake_buffer^[i] := true_buffer^[2 * rgroup_height + i]; fake_buffer^[i] := true_buffer^[2 * rgroup_height + i];
fake_buffer^[4 * rgroup_height + i] := true_buffer^[i]; fake_buffer^[4 * rgroup_height + i] := true_buffer^[i];
end; end;
prep^.color_buf[ci] := JSAMPARRAY(@ fake_buffer^[rgroup_height]); prep^.color_buf[ci] := JSAMPARRAY(@ fake_buffer^[rgroup_height]);
Inc(JSAMPROW_PTR(fake_buffer), 5 * rgroup_height); { point to space for next component } Inc(JSAMPROW_PTR(fake_buffer), 5 * rgroup_height); { point to space for next component }
Inc(compptr); Inc(compptr);
end; end;
end; end;
{$endif} { CONTEXT_ROWS_SUPPORTED } {$endif} { CONTEXT_ROWS_SUPPORTED }
{ Initialize preprocessing controller. } { Initialize preprocessing controller. }
{GLOBAL} {GLOBAL}
procedure jinit_c_prep_controller (cinfo : j_compress_ptr; procedure jinit_c_prep_controller (cinfo : j_compress_ptr;
need_full_buffer : boolean); need_full_buffer : boolean);
var var
prep : my_prep_ptr; prep : my_prep_ptr;
ci : int; ci : int;
compptr : jpeg_component_info_ptr; compptr : jpeg_component_info_ptr;
begin begin
if (need_full_buffer) then { safety check } if (need_full_buffer) then { safety check }
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
prep := my_prep_ptr( prep := my_prep_ptr(
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
SIZEOF(my_prep_controller)) ); SIZEOF(my_prep_controller)) );
cinfo^.prep := jpeg_c_prep_controller_ptr(prep); cinfo^.prep := jpeg_c_prep_controller_ptr(prep);
prep^.pub.start_pass := start_pass_prep; prep^.pub.start_pass := start_pass_prep;
{ Allocate the color conversion buffer. { Allocate the color conversion buffer.
We make the buffer wide enough to allow the downsampler to edge-expand We make the buffer wide enough to allow the downsampler to edge-expand
horizontally within the buffer, if it so chooses. } horizontally within the buffer, if it so chooses. }
if (cinfo^.downsample^.need_context_rows) then if (cinfo^.downsample^.need_context_rows) then
begin begin
{ Set up to provide context rows } { Set up to provide context rows }
{$ifdef CONTEXT_ROWS_SUPPORTED} {$ifdef CONTEXT_ROWS_SUPPORTED}
prep^.pub.pre_process_data := pre_process_context; prep^.pub.pre_process_data := pre_process_context;
create_context_buffer(cinfo); create_context_buffer(cinfo);
{$else} {$else}
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
{$endif} {$endif}
end end
else else
begin begin
{ No context, just make it tall enough for one row group } { No context, just make it tall enough for one row group }
prep^.pub.pre_process_data := pre_process_data; prep^.pub.pre_process_data := pre_process_data;
compptr := jpeg_component_info_ptr(cinfo^.comp_info); compptr := jpeg_component_info_ptr(cinfo^.comp_info);
for ci := 0 to pred(cinfo^.num_components) do for ci := 0 to pred(cinfo^.num_components) do
begin begin
prep^.color_buf[ci] := cinfo^.mem^.alloc_sarray prep^.color_buf[ci] := cinfo^.mem^.alloc_sarray
(j_common_ptr(cinfo), JPOOL_IMAGE, (j_common_ptr(cinfo), JPOOL_IMAGE,
JDIMENSION (( long(compptr^.width_in_blocks) * DCTSIZE * JDIMENSION (( long(compptr^.width_in_blocks) * DCTSIZE *
cinfo^.max_h_samp_factor) div compptr^.h_samp_factor), cinfo^.max_h_samp_factor) div compptr^.h_samp_factor),
JDIMENSION(cinfo^.max_v_samp_factor) ); JDIMENSION(cinfo^.max_v_samp_factor) );
Inc(compptr); Inc(compptr);
end; end;
end; end;
end; end;
end. end.

1262
Imaging/JpegLib/imjcsample.pas
View File

File diff suppressed because it is too large Load Diff

1008
Imaging/JpegLib/imjdapimin.pas
View File

File diff suppressed because it is too large Load Diff

754
Imaging/JpegLib/imjdapistd.pas
View File

@ -1,377 +1,377 @@
unit imjdapistd; unit imjdapistd;
{ Original : jdapistd.c ; Copyright (C) 1994-1996, Thomas G. Lane. } { Original : jdapistd.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
{ This file is part of the Independent JPEG Group's software. { This file is part of the Independent JPEG Group's software.
For conditions of distribution and use, see the accompanying README file. For conditions of distribution and use, see the accompanying README file.
This file contains application interface code for the decompression half This file contains application interface code for the decompression half
of the JPEG library. These are the "standard" API routines that are of the JPEG library. These are the "standard" API routines that are
used in the normal full-decompression case. They are not used by a used in the normal full-decompression case. They are not used by a
transcoding-only application. Note that if an application links in transcoding-only application. Note that if an application links in
jpeg_start_decompress, it will end up linking in the entire decompressor. jpeg_start_decompress, it will end up linking in the entire decompressor.
We thus must separate this file from jdapimin.c to avoid linking the We thus must separate this file from jdapimin.c to avoid linking the
whole decompression library into a transcoder. } whole decompression library into a transcoder. }
interface interface
{$I imjconfig.inc} {$I imjconfig.inc}
uses uses
imjmorecfg, imjmorecfg,
imjinclude, imjinclude,
imjdeferr, imjdeferr,
imjerror, imjerror,
imjpeglib, imjpeglib,
imjdmaster; imjdmaster;
{ Read some scanlines of data from the JPEG decompressor. { Read some scanlines of data from the JPEG decompressor.
The return value will be the number of lines actually read. The return value will be the number of lines actually read.
This may be less than the number requested in several cases, This may be less than the number requested in several cases,
including bottom of image, data source suspension, and operating including bottom of image, data source suspension, and operating
modes that emit multiple scanlines at a time. modes that emit multiple scanlines at a time.
Note: we warn about excess calls to jpeg_read_scanlines() since Note: we warn about excess calls to jpeg_read_scanlines() since
this likely signals an application programmer error. However, this likely signals an application programmer error. However,
an oversize buffer (max_lines > scanlines remaining) is not an error. } an oversize buffer (max_lines > scanlines remaining) is not an error. }
{GLOBAL} {GLOBAL}
function jpeg_read_scanlines (cinfo : j_decompress_ptr; function jpeg_read_scanlines (cinfo : j_decompress_ptr;
scanlines : JSAMPARRAY; scanlines : JSAMPARRAY;
max_lines : JDIMENSION) : JDIMENSION; max_lines : JDIMENSION) : JDIMENSION;
{ Alternate entry point to read raw data. { Alternate entry point to read raw data.
Processes exactly one iMCU row per call, unless suspended. } Processes exactly one iMCU row per call, unless suspended. }
{GLOBAL} {GLOBAL}
function jpeg_read_raw_data (cinfo : j_decompress_ptr; function jpeg_read_raw_data (cinfo : j_decompress_ptr;
data : JSAMPIMAGE; data : JSAMPIMAGE;
max_lines : JDIMENSION) : JDIMENSION; max_lines : JDIMENSION) : JDIMENSION;
{$ifdef D_MULTISCAN_FILES_SUPPORTED} {$ifdef D_MULTISCAN_FILES_SUPPORTED}
{ Initialize for an output pass in buffered-image mode. } { Initialize for an output pass in buffered-image mode. }
{GLOBAL} {GLOBAL}
function jpeg_start_output (cinfo : j_decompress_ptr; function jpeg_start_output (cinfo : j_decompress_ptr;
scan_number : int) : boolean; scan_number : int) : boolean;
{ Finish up after an output pass in buffered-image mode. { Finish up after an output pass in buffered-image mode.
Returns FALSE if suspended. The return value need be inspected only if Returns FALSE if suspended. The return value need be inspected only if
a suspending data source is used. } a suspending data source is used. }
{GLOBAL} {GLOBAL}
function jpeg_finish_output (cinfo : j_decompress_ptr) : boolean; function jpeg_finish_output (cinfo : j_decompress_ptr) : boolean;
{$endif} { D_MULTISCAN_FILES_SUPPORTED } {$endif} { D_MULTISCAN_FILES_SUPPORTED }
{ Decompression initialization. { Decompression initialization.
jpeg_read_header must be completed before calling this. jpeg_read_header must be completed before calling this.
If a multipass operating mode was selected, this will do all but the If a multipass operating mode was selected, this will do all but the
last pass, and thus may take a great deal of time. last pass, and thus may take a great deal of time.
Returns FALSE if suspended. The return value need be inspected only if Returns FALSE if suspended. The return value need be inspected only if
a suspending data source is used. } a suspending data source is used. }
{GLOBAL} {GLOBAL}
function jpeg_start_decompress (cinfo : j_decompress_ptr) : boolean; function jpeg_start_decompress (cinfo : j_decompress_ptr) : boolean;
implementation implementation
{ Forward declarations } { Forward declarations }
{LOCAL} {LOCAL}
function output_pass_setup (cinfo : j_decompress_ptr) : boolean; forward; function output_pass_setup (cinfo : j_decompress_ptr) : boolean; forward;
{ Decompression initialization. { Decompression initialization.
jpeg_read_header must be completed before calling this. jpeg_read_header must be completed before calling this.
If a multipass operating mode was selected, this will do all but the If a multipass operating mode was selected, this will do all but the
last pass, and thus may take a great deal of time. last pass, and thus may take a great deal of time.
Returns FALSE if suspended. The return value need be inspected only if Returns FALSE if suspended. The return value need be inspected only if
a suspending data source is used. } a suspending data source is used. }
{GLOBAL} {GLOBAL}
function jpeg_start_decompress (cinfo : j_decompress_ptr) : boolean; function jpeg_start_decompress (cinfo : j_decompress_ptr) : boolean;
var var
retcode : int; retcode : int;
begin begin
if (cinfo^.global_state = DSTATE_READY) then if (cinfo^.global_state = DSTATE_READY) then
begin begin
{ First call: initialize master control, select active modules } { First call: initialize master control, select active modules }
jinit_master_decompress(cinfo); jinit_master_decompress(cinfo);
if (cinfo^.buffered_image) then if (cinfo^.buffered_image) then
begin begin
{ No more work here; expecting jpeg_start_output next } { No more work here; expecting jpeg_start_output next }
cinfo^.global_state := DSTATE_BUFIMAGE; cinfo^.global_state := DSTATE_BUFIMAGE;
jpeg_start_decompress := TRUE; jpeg_start_decompress := TRUE;
exit; exit;
end; end;
cinfo^.global_state := DSTATE_PRELOAD; cinfo^.global_state := DSTATE_PRELOAD;
end; end;
if (cinfo^.global_state = DSTATE_PRELOAD) then if (cinfo^.global_state = DSTATE_PRELOAD) then
begin begin
{ If file has multiple scans, absorb them all into the coef buffer } { If file has multiple scans, absorb them all into the coef buffer }
if (cinfo^.inputctl^.has_multiple_scans) then if (cinfo^.inputctl^.has_multiple_scans) then
begin begin
{$ifdef D_MULTISCAN_FILES_SUPPORTED} {$ifdef D_MULTISCAN_FILES_SUPPORTED}
while TRUE do while TRUE do
begin begin
{ Call progress monitor hook if present } { Call progress monitor hook if present }
if (cinfo^.progress <> NIL) then if (cinfo^.progress <> NIL) then
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo)); cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
{ Absorb some more input } { Absorb some more input }
retcode := cinfo^.inputctl^.consume_input (cinfo); retcode := cinfo^.inputctl^.consume_input (cinfo);
if (retcode = JPEG_SUSPENDED) then if (retcode = JPEG_SUSPENDED) then
begin begin
jpeg_start_decompress := FALSE; jpeg_start_decompress := FALSE;
exit; exit;
end; end;
if (retcode = JPEG_REACHED_EOI) then if (retcode = JPEG_REACHED_EOI) then
break; break;
{ Advance progress counter if appropriate } { Advance progress counter if appropriate }
if (cinfo^.progress <> NIL) and if (cinfo^.progress <> NIL) and
((retcode = JPEG_ROW_COMPLETED) or (retcode = JPEG_REACHED_SOS)) then ((retcode = JPEG_ROW_COMPLETED) or (retcode = JPEG_REACHED_SOS)) then
begin begin
Inc(cinfo^.progress^.pass_counter); Inc(cinfo^.progress^.pass_counter);
if (cinfo^.progress^.pass_counter >= cinfo^.progress^.pass_limit) then if (cinfo^.progress^.pass_counter >= cinfo^.progress^.pass_limit) then
begin begin
{ jdmaster underestimated number of scans; ratchet up one scan } { jdmaster underestimated number of scans; ratchet up one scan }
Inc(cinfo^.progress^.pass_limit, long(cinfo^.total_iMCU_rows)); Inc(cinfo^.progress^.pass_limit, long(cinfo^.total_iMCU_rows));
end; end;
end; end;
end; end;
{$else} {$else}
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
{$endif} { D_MULTISCAN_FILES_SUPPORTED } {$endif} { D_MULTISCAN_FILES_SUPPORTED }
end; end;
cinfo^.output_scan_number := cinfo^.input_scan_number; cinfo^.output_scan_number := cinfo^.input_scan_number;
end end
else else
if (cinfo^.global_state <> DSTATE_PRESCAN) then if (cinfo^.global_state <> DSTATE_PRESCAN) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
{ Perform any dummy output passes, and set up for the final pass } { Perform any dummy output passes, and set up for the final pass }
jpeg_start_decompress := output_pass_setup(cinfo); jpeg_start_decompress := output_pass_setup(cinfo);
end; end;
{ Set up for an output pass, and perform any dummy pass(es) needed. { Set up for an output pass, and perform any dummy pass(es) needed.
Common subroutine for jpeg_start_decompress and jpeg_start_output. Common subroutine for jpeg_start_decompress and jpeg_start_output.
Entry: global_state := DSTATE_PRESCAN only if previously suspended. Entry: global_state := DSTATE_PRESCAN only if previously suspended.
Exit: If done, returns TRUE and sets global_state for proper output mode. Exit: If done, returns TRUE and sets global_state for proper output mode.
If suspended, returns FALSE and sets global_state := DSTATE_PRESCAN. } If suspended, returns FALSE and sets global_state := DSTATE_PRESCAN. }
{LOCAL} {LOCAL}
function output_pass_setup (cinfo : j_decompress_ptr) : boolean; function output_pass_setup (cinfo : j_decompress_ptr) : boolean;
var var
last_scanline : JDIMENSION; last_scanline : JDIMENSION;
begin begin
if (cinfo^.global_state <> DSTATE_PRESCAN) then if (cinfo^.global_state <> DSTATE_PRESCAN) then
begin begin
{ First call: do pass setup } { First call: do pass setup }
cinfo^.master^.prepare_for_output_pass (cinfo); cinfo^.master^.prepare_for_output_pass (cinfo);
cinfo^.output_scanline := 0; cinfo^.output_scanline := 0;
cinfo^.global_state := DSTATE_PRESCAN; cinfo^.global_state := DSTATE_PRESCAN;
end; end;
{ Loop over any required dummy passes } { Loop over any required dummy passes }
while (cinfo^.master^.is_dummy_pass) do while (cinfo^.master^.is_dummy_pass) do
begin begin
{$ifdef QUANT_2PASS_SUPPORTED} {$ifdef QUANT_2PASS_SUPPORTED}
{ Crank through the dummy pass } { Crank through the dummy pass }
while (cinfo^.output_scanline < cinfo^.output_height) do while (cinfo^.output_scanline < cinfo^.output_height) do
begin begin
{ Call progress monitor hook if present } { Call progress monitor hook if present }
if (cinfo^.progress <> NIL) then if (cinfo^.progress <> NIL) then
begin begin
cinfo^.progress^.pass_counter := long (cinfo^.output_scanline); cinfo^.progress^.pass_counter := long (cinfo^.output_scanline);
cinfo^.progress^.pass_limit := long (cinfo^.output_height); cinfo^.progress^.pass_limit := long (cinfo^.output_height);
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo)); cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
end; end;
{ Process some data } { Process some data }
last_scanline := cinfo^.output_scanline; last_scanline := cinfo^.output_scanline;
cinfo^.main^.process_data (cinfo, JSAMPARRAY(NIL), cinfo^.main^.process_data (cinfo, JSAMPARRAY(NIL),
cinfo^.output_scanline, {var} cinfo^.output_scanline, {var}
JDIMENSION(0)); JDIMENSION(0));
if (cinfo^.output_scanline = last_scanline) then if (cinfo^.output_scanline = last_scanline) then
begin begin
output_pass_setup := FALSE; { No progress made, must suspend } output_pass_setup := FALSE; { No progress made, must suspend }
exit; exit;
end; end;
end; end;
{ Finish up dummy pass, and set up for another one } { Finish up dummy pass, and set up for another one }
cinfo^.master^.finish_output_pass (cinfo); cinfo^.master^.finish_output_pass (cinfo);
cinfo^.master^.prepare_for_output_pass (cinfo); cinfo^.master^.prepare_for_output_pass (cinfo);
cinfo^.output_scanline := 0; cinfo^.output_scanline := 0;
{$else} {$else}
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
{$endif} { QUANT_2PASS_SUPPORTED } {$endif} { QUANT_2PASS_SUPPORTED }
end; end;
{ Ready for application to drive output pass through { Ready for application to drive output pass through
jpeg_read_scanlines or jpeg_read_raw_data. } jpeg_read_scanlines or jpeg_read_raw_data. }
if cinfo^.raw_data_out then if cinfo^.raw_data_out then
cinfo^.global_state := DSTATE_RAW_OK cinfo^.global_state := DSTATE_RAW_OK
else else
cinfo^.global_state := DSTATE_SCANNING; cinfo^.global_state := DSTATE_SCANNING;
output_pass_setup := TRUE; output_pass_setup := TRUE;
end; end;
{ Read some scanlines of data from the JPEG decompressor. { Read some scanlines of data from the JPEG decompressor.
The return value will be the number of lines actually read. The return value will be the number of lines actually read.
This may be less than the number requested in several cases, This may be less than the number requested in several cases,
including bottom of image, data source suspension, and operating including bottom of image, data source suspension, and operating
modes that emit multiple scanlines at a time. modes that emit multiple scanlines at a time.
Note: we warn about excess calls to jpeg_read_scanlines() since Note: we warn about excess calls to jpeg_read_scanlines() since
this likely signals an application programmer error. However, this likely signals an application programmer error. However,
an oversize buffer (max_lines > scanlines remaining) is not an error. } an oversize buffer (max_lines > scanlines remaining) is not an error. }
{GLOBAL} {GLOBAL}
function jpeg_read_scanlines (cinfo : j_decompress_ptr; function jpeg_read_scanlines (cinfo : j_decompress_ptr;
scanlines : JSAMPARRAY; scanlines : JSAMPARRAY;
max_lines : JDIMENSION) : JDIMENSION; max_lines : JDIMENSION) : JDIMENSION;
var var
row_ctr : JDIMENSION; row_ctr : JDIMENSION;
begin begin
if (cinfo^.global_state <> DSTATE_SCANNING) then if (cinfo^.global_state <> DSTATE_SCANNING) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
if (cinfo^.output_scanline >= cinfo^.output_height) then if (cinfo^.output_scanline >= cinfo^.output_height) then
begin begin
WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA); WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA);
jpeg_read_scanlines := 0; jpeg_read_scanlines := 0;
exit; exit;
end; end;
{ Call progress monitor hook if present } { Call progress monitor hook if present }
if (cinfo^.progress <> NIL) then if (cinfo^.progress <> NIL) then
begin begin
cinfo^.progress^.pass_counter := long (cinfo^.output_scanline); cinfo^.progress^.pass_counter := long (cinfo^.output_scanline);
cinfo^.progress^.pass_limit := long (cinfo^.output_height); cinfo^.progress^.pass_limit := long (cinfo^.output_height);
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo)); cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
end; end;
{ Process some data } { Process some data }
row_ctr := 0; row_ctr := 0;
cinfo^.main^.process_data (cinfo, scanlines, {var}row_ctr, max_lines); cinfo^.main^.process_data (cinfo, scanlines, {var}row_ctr, max_lines);
Inc(cinfo^.output_scanline, row_ctr); Inc(cinfo^.output_scanline, row_ctr);
jpeg_read_scanlines := row_ctr; jpeg_read_scanlines := row_ctr;
end; end;
{ Alternate entry point to read raw data. { Alternate entry point to read raw data.
Processes exactly one iMCU row per call, unless suspended. } Processes exactly one iMCU row per call, unless suspended. }
{GLOBAL} {GLOBAL}
function jpeg_read_raw_data (cinfo : j_decompress_ptr; function jpeg_read_raw_data (cinfo : j_decompress_ptr;
data : JSAMPIMAGE; data : JSAMPIMAGE;
max_lines : JDIMENSION) : JDIMENSION; max_lines : JDIMENSION) : JDIMENSION;
var var
lines_per_iMCU_row : JDIMENSION; lines_per_iMCU_row : JDIMENSION;
begin begin
if (cinfo^.global_state <> DSTATE_RAW_OK) then if (cinfo^.global_state <> DSTATE_RAW_OK) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
if (cinfo^.output_scanline >= cinfo^.output_height) then if (cinfo^.output_scanline >= cinfo^.output_height) then
begin begin
WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA); WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA);
jpeg_read_raw_data := 0; jpeg_read_raw_data := 0;
exit; exit;
end; end;
{ Call progress monitor hook if present } { Call progress monitor hook if present }
if (cinfo^.progress <> NIL) then if (cinfo^.progress <> NIL) then
begin begin
cinfo^.progress^.pass_counter := long (cinfo^.output_scanline); cinfo^.progress^.pass_counter := long (cinfo^.output_scanline);
cinfo^.progress^.pass_limit := long (cinfo^.output_height); cinfo^.progress^.pass_limit := long (cinfo^.output_height);
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo)); cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
end; end;
{ Verify that at least one iMCU row can be returned. } { Verify that at least one iMCU row can be returned. }
lines_per_iMCU_row := cinfo^.max_v_samp_factor * cinfo^.min_DCT_scaled_size; lines_per_iMCU_row := cinfo^.max_v_samp_factor * cinfo^.min_DCT_scaled_size;
if (max_lines < lines_per_iMCU_row) then if (max_lines < lines_per_iMCU_row) then
ERREXIT(j_common_ptr(cinfo), JERR_BUFFER_SIZE); ERREXIT(j_common_ptr(cinfo), JERR_BUFFER_SIZE);
{ Decompress directly into user's buffer. } { Decompress directly into user's buffer. }
if (cinfo^.coef^.decompress_data (cinfo, data) = 0) then if (cinfo^.coef^.decompress_data (cinfo, data) = 0) then
begin begin
jpeg_read_raw_data := 0; { suspension forced, can do nothing more } jpeg_read_raw_data := 0; { suspension forced, can do nothing more }
exit; exit;
end; end;
{ OK, we processed one iMCU row. } { OK, we processed one iMCU row. }
Inc(cinfo^.output_scanline, lines_per_iMCU_row); Inc(cinfo^.output_scanline, lines_per_iMCU_row);
jpeg_read_raw_data := lines_per_iMCU_row; jpeg_read_raw_data := lines_per_iMCU_row;
end; end;
{ Additional entry points for buffered-image mode. } { Additional entry points for buffered-image mode. }
{$ifdef D_MULTISCAN_FILES_SUPPORTED} {$ifdef D_MULTISCAN_FILES_SUPPORTED}
{ Initialize for an output pass in buffered-image mode. } { Initialize for an output pass in buffered-image mode. }
{GLOBAL} {GLOBAL}
function jpeg_start_output (cinfo : j_decompress_ptr; function jpeg_start_output (cinfo : j_decompress_ptr;
scan_number : int) : boolean; scan_number : int) : boolean;
begin begin
if (cinfo^.global_state <> DSTATE_BUFIMAGE) and if (cinfo^.global_state <> DSTATE_BUFIMAGE) and
(cinfo^.global_state <> DSTATE_PRESCAN) then (cinfo^.global_state <> DSTATE_PRESCAN) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
{ Limit scan number to valid range } { Limit scan number to valid range }
if (scan_number <= 0) then if (scan_number <= 0) then
scan_number := 1; scan_number := 1;
if (cinfo^.inputctl^.eoi_reached) and if (cinfo^.inputctl^.eoi_reached) and
(scan_number > cinfo^.input_scan_number) then (scan_number > cinfo^.input_scan_number) then
scan_number := cinfo^.input_scan_number; scan_number := cinfo^.input_scan_number;
cinfo^.output_scan_number := scan_number; cinfo^.output_scan_number := scan_number;
{ Perform any dummy output passes, and set up for the real pass } { Perform any dummy output passes, and set up for the real pass }
jpeg_start_output := output_pass_setup(cinfo); jpeg_start_output := output_pass_setup(cinfo);
end; end;
{ Finish up after an output pass in buffered-image mode. { Finish up after an output pass in buffered-image mode.
Returns FALSE if suspended. The return value need be inspected only if Returns FALSE if suspended. The return value need be inspected only if
a suspending data source is used. } a suspending data source is used. }
{GLOBAL} {GLOBAL}
function jpeg_finish_output (cinfo : j_decompress_ptr) : boolean; function jpeg_finish_output (cinfo : j_decompress_ptr) : boolean;
begin begin
if ((cinfo^.global_state = DSTATE_SCANNING) or if ((cinfo^.global_state = DSTATE_SCANNING) or
(cinfo^.global_state = DSTATE_RAW_OK) and cinfo^.buffered_image) then (cinfo^.global_state = DSTATE_RAW_OK) and cinfo^.buffered_image) then
begin begin
{ Terminate this pass. } { Terminate this pass. }
{ We do not require the whole pass to have been completed. } { We do not require the whole pass to have been completed. }
cinfo^.master^.finish_output_pass (cinfo); cinfo^.master^.finish_output_pass (cinfo);
cinfo^.global_state := DSTATE_BUFPOST; cinfo^.global_state := DSTATE_BUFPOST;
end end
else else
if (cinfo^.global_state <> DSTATE_BUFPOST) then if (cinfo^.global_state <> DSTATE_BUFPOST) then
begin begin
{ BUFPOST := repeat call after a suspension, anything else is error } { BUFPOST := repeat call after a suspension, anything else is error }
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
end; end;
{ Read markers looking for SOS or EOI } { Read markers looking for SOS or EOI }
while (cinfo^.input_scan_number <= cinfo^.output_scan_number) and while (cinfo^.input_scan_number <= cinfo^.output_scan_number) and
(not cinfo^.inputctl^.eoi_reached) do (not cinfo^.inputctl^.eoi_reached) do
begin begin
if (cinfo^.inputctl^.consume_input (cinfo) = JPEG_SUSPENDED) then if (cinfo^.inputctl^.consume_input (cinfo) = JPEG_SUSPENDED) then
begin begin
jpeg_finish_output := FALSE; { Suspend, come back later } jpeg_finish_output := FALSE; { Suspend, come back later }
exit; exit;
end; end;
end; end;
cinfo^.global_state := DSTATE_BUFIMAGE; cinfo^.global_state := DSTATE_BUFIMAGE;
jpeg_finish_output := TRUE; jpeg_finish_output := TRUE;
end; end;
{$endif} { D_MULTISCAN_FILES_SUPPORTED } {$endif} { D_MULTISCAN_FILES_SUPPORTED }
end. end.

1790
Imaging/JpegLib/imjdcoefct.pas
View File

File diff suppressed because it is too large Load Diff

1002
Imaging/JpegLib/imjdcolor.pas
View File

File diff suppressed because it is too large Load Diff

218
Imaging/JpegLib/imjdct.pas
View File

@ -1,109 +1,109 @@
unit imjdct; unit imjdct;
{ Orignal: jdct.h; Copyright (C) 1994-1996, Thomas G. Lane. } { Orignal: jdct.h; Copyright (C) 1994-1996, Thomas G. Lane. }
{ This include file contains common declarations for the forward and { This include file contains common declarations for the forward and
inverse DCT modules. These declarations are private to the DCT managers inverse DCT modules. These declarations are private to the DCT managers
(jcdctmgr.c, jddctmgr.c) and the individual DCT algorithms. (jcdctmgr.c, jddctmgr.c) and the individual DCT algorithms.
The individual DCT algorithms are kept in separate files to ease The individual DCT algorithms are kept in separate files to ease
machine-dependent tuning (e.g., assembly coding). } machine-dependent tuning (e.g., assembly coding). }
interface interface
{$I imjconfig.inc} {$I imjconfig.inc}
uses uses
imjmorecfg; imjmorecfg;
{ A forward DCT routine is given a pointer to a work area of type DCTELEM[]; { A forward DCT routine is given a pointer to a work area of type DCTELEM[];
the DCT is to be performed in-place in that buffer. Type DCTELEM is int the DCT is to be performed in-place in that buffer. Type DCTELEM is int
for 8-bit samples, INT32 for 12-bit samples. (NOTE: Floating-point DCT for 8-bit samples, INT32 for 12-bit samples. (NOTE: Floating-point DCT
implementations use an array of type FAST_FLOAT, instead.) implementations use an array of type FAST_FLOAT, instead.)
The DCT inputs are expected to be signed (range +-CENTERJSAMPLE). The DCT inputs are expected to be signed (range +-CENTERJSAMPLE).
The DCT outputs are returned scaled up by a factor of 8; they therefore The DCT outputs are returned scaled up by a factor of 8; they therefore
have a range of +-8K for 8-bit data, +-128K for 12-bit data. This have a range of +-8K for 8-bit data, +-128K for 12-bit data. This
convention improves accuracy in integer implementations and saves some convention improves accuracy in integer implementations and saves some
work in floating-point ones. work in floating-point ones.
Quantization of the output coefficients is done by jcdctmgr.c. } Quantization of the output coefficients is done by jcdctmgr.c. }
{$ifdef BITS_IN_JSAMPLE_IS_8} {$ifdef BITS_IN_JSAMPLE_IS_8}
type type
DCTELEM = int; { 16 or 32 bits is fine } DCTELEM = int; { 16 or 32 bits is fine }
{$else} {$else}
type { must have 32 bits } type { must have 32 bits }
DCTELEM = INT32; DCTELEM = INT32;
{$endif} {$endif}
type type
jTDctElem = 0..(MaxInt div SizeOf(DCTELEM))-1; jTDctElem = 0..(MaxInt div SizeOf(DCTELEM))-1;
DCTELEM_FIELD = array[jTDctElem] of DCTELEM; DCTELEM_FIELD = array[jTDctElem] of DCTELEM;
DCTELEM_FIELD_PTR = ^DCTELEM_FIELD; DCTELEM_FIELD_PTR = ^DCTELEM_FIELD;
DCTELEMPTR = ^DCTELEM; DCTELEMPTR = ^DCTELEM;
type type
forward_DCT_method_ptr = procedure(var data : array of DCTELEM); forward_DCT_method_ptr = procedure(var data : array of DCTELEM);
float_DCT_method_ptr = procedure(var data : array of FAST_FLOAT); float_DCT_method_ptr = procedure(var data : array of FAST_FLOAT);
{ An inverse DCT routine is given a pointer to the input JBLOCK and a pointer { An inverse DCT routine is given a pointer to the input JBLOCK and a pointer
to an output sample array. The routine must dequantize the input data as to an output sample array. The routine must dequantize the input data as
well as perform the IDCT; for dequantization, it uses the multiplier table well as perform the IDCT; for dequantization, it uses the multiplier table
pointed to by compptr->dct_table. The output data is to be placed into the pointed to by compptr->dct_table. The output data is to be placed into the
sample array starting at a specified column. (Any row offset needed will sample array starting at a specified column. (Any row offset needed will
be applied to the array pointer before it is passed to the IDCT code.) be applied to the array pointer before it is passed to the IDCT code.)
Note that the number of samples emitted by the IDCT routine is Note that the number of samples emitted by the IDCT routine is
DCT_scaled_size * DCT_scaled_size. } DCT_scaled_size * DCT_scaled_size. }
{ typedef inverse_DCT_method_ptr is declared in jpegint.h } { typedef inverse_DCT_method_ptr is declared in jpegint.h }
{ Each IDCT routine has its own ideas about the best dct_table element type. } { Each IDCT routine has its own ideas about the best dct_table element type. }
type type
ISLOW_MULT_TYPE = MULTIPLIER; { short or int, whichever is faster } ISLOW_MULT_TYPE = MULTIPLIER; { short or int, whichever is faster }
{$ifdef BITS_IN_JSAMPLE_IS_8} {$ifdef BITS_IN_JSAMPLE_IS_8}
type type
IFAST_MULT_TYPE = MULTIPLIER; { 16 bits is OK, use short if faster } IFAST_MULT_TYPE = MULTIPLIER; { 16 bits is OK, use short if faster }
const const
IFAST_SCALE_BITS = 2; { fractional bits in scale factors } IFAST_SCALE_BITS = 2; { fractional bits in scale factors }
{$else} {$else}
type type
IFAST_MULT_TYPE = INT32; { need 32 bits for scaled quantizers } IFAST_MULT_TYPE = INT32; { need 32 bits for scaled quantizers }
const const
IFAST_SCALE_BITS = 13; { fractional bits in scale factors } IFAST_SCALE_BITS = 13; { fractional bits in scale factors }
{$endif} {$endif}
type type
FLOAT_MULT_TYPE = FAST_FLOAT; { preferred floating type } FLOAT_MULT_TYPE = FAST_FLOAT; { preferred floating type }
const const
RANGE_MASK = (MAXJSAMPLE * 4 + 3); { 2 bits wider than legal samples } RANGE_MASK = (MAXJSAMPLE * 4 + 3); { 2 bits wider than legal samples }
type type
jTMultType = 0..(MaxInt div SizeOf(ISLOW_MULT_TYPE))-1; jTMultType = 0..(MaxInt div SizeOf(ISLOW_MULT_TYPE))-1;
ISLOW_MULT_TYPE_FIELD = array[jTMultType] of ISLOW_MULT_TYPE; ISLOW_MULT_TYPE_FIELD = array[jTMultType] of ISLOW_MULT_TYPE;
ISLOW_MULT_TYPE_FIELD_PTR = ^ISLOW_MULT_TYPE_FIELD; ISLOW_MULT_TYPE_FIELD_PTR = ^ISLOW_MULT_TYPE_FIELD;
ISLOW_MULT_TYPE_PTR = ^ISLOW_MULT_TYPE; ISLOW_MULT_TYPE_PTR = ^ISLOW_MULT_TYPE;
jTFloatType = 0..(MaxInt div SizeOf(FLOAT_MULT_TYPE))-1; jTFloatType = 0..(MaxInt div SizeOf(FLOAT_MULT_TYPE))-1;
FLOAT_MULT_TYPE_FIELD = array[jTFloatType] of FLOAT_MULT_TYPE; FLOAT_MULT_TYPE_FIELD = array[jTFloatType] of FLOAT_MULT_TYPE;
FLOAT_MULT_TYPE_FIELD_PTR = ^FLOAT_MULT_TYPE_FIELD; FLOAT_MULT_TYPE_FIELD_PTR = ^FLOAT_MULT_TYPE_FIELD;
FLOAT_MULT_TYPE_PTR = ^FLOAT_MULT_TYPE; FLOAT_MULT_TYPE_PTR = ^FLOAT_MULT_TYPE;
jTFastType = 0..(MaxInt div SizeOf(IFAST_MULT_TYPE))-1; jTFastType = 0..(MaxInt div SizeOf(IFAST_MULT_TYPE))-1;
IFAST_MULT_TYPE_FIELD = array[jTFastType] of IFAST_MULT_TYPE; IFAST_MULT_TYPE_FIELD = array[jTFastType] of IFAST_MULT_TYPE;
IFAST_MULT_TYPE_FIELD_PTR = ^IFAST_MULT_TYPE_FIELD; IFAST_MULT_TYPE_FIELD_PTR = ^IFAST_MULT_TYPE_FIELD;
IFAST_MULT_TYPE_PTR = ^IFAST_MULT_TYPE; IFAST_MULT_TYPE_PTR = ^IFAST_MULT_TYPE;
type type
jTFastFloat = 0..(MaxInt div SizeOf(FAST_FLOAT))-1; jTFastFloat = 0..(MaxInt div SizeOf(FAST_FLOAT))-1;
FAST_FLOAT_FIELD = array[jTFastFloat] of FAST_FLOAT; FAST_FLOAT_FIELD = array[jTFastFloat] of FAST_FLOAT;
FAST_FLOAT_FIELD_PTR = ^FAST_FLOAT_FIELD; FAST_FLOAT_FIELD_PTR = ^FAST_FLOAT_FIELD;
FAST_FLOAT_PTR = ^FAST_FLOAT; FAST_FLOAT_PTR = ^FAST_FLOAT;
implementation implementation
end. end.

658
Imaging/JpegLib/imjddctmgr.pas
View File

@ -1,330 +1,328 @@
unit imjddctmgr; unit imjddctmgr;
{ Original : jddctmgr.c ; Copyright (C) 1994-1996, Thomas G. Lane. } { Original : jddctmgr.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
{ This file contains the inverse-DCT management logic. { This file contains the inverse-DCT management logic.
This code selects a particular IDCT implementation to be used, This code selects a particular IDCT implementation to be used,
and it performs related housekeeping chores. No code in this file and it performs related housekeeping chores. No code in this file
is executed per IDCT step, only during output pass setup. is executed per IDCT step, only during output pass setup.
Note that the IDCT routines are responsible for performing coefficient Note that the IDCT routines are responsible for performing coefficient
dequantization as well as the IDCT proper. This module sets up the dequantization as well as the IDCT proper. This module sets up the
dequantization multiplier table needed by the IDCT routine. } dequantization multiplier table needed by the IDCT routine. }
interface interface
{$I imjconfig.inc} {$I imjconfig.inc}
{$N+} uses
imjmorecfg,
uses imjinclude,
imjmorecfg, imjdeferr,
imjinclude, imjerror,
imjdeferr, imjpeglib,
imjerror, imjdct, { Private declarations for DCT subsystem }
imjpeglib, imjidctfst,
imjdct, { Private declarations for DCT subsystem } {$IFDEF BASM}
imjidctfst, imjidctasm,
{$IFDEF BASM} {$ELSE}
imjidctasm, imjidctint,
{$ELSE} {$ENDIF}
imjidctint, imjidctflt,
{$ENDIF} imjidctred;
imjidctflt,
imjidctred;
{ Initialize IDCT manager. }
{ Initialize IDCT manager. } {GLOBAL}
procedure jinit_inverse_dct (cinfo : j_decompress_ptr);
{GLOBAL}
procedure jinit_inverse_dct (cinfo : j_decompress_ptr);
implementation
implementation { The decompressor input side (jdinput.c) saves away the appropriate
quantization table for each component at the start of the first scan
{ The decompressor input side (jdinput.c) saves away the appropriate involving that component. (This is necessary in order to correctly
quantization table for each component at the start of the first scan decode files that reuse Q-table slots.)
involving that component. (This is necessary in order to correctly When we are ready to make an output pass, the saved Q-table is converted
decode files that reuse Q-table slots.) to a multiplier table that will actually be used by the IDCT routine.
When we are ready to make an output pass, the saved Q-table is converted The multiplier table contents are IDCT-method-dependent. To support
to a multiplier table that will actually be used by the IDCT routine. application changes in IDCT method between scans, we can remake the
The multiplier table contents are IDCT-method-dependent. To support multiplier tables if necessary.
application changes in IDCT method between scans, we can remake the In buffered-image mode, the first output pass may occur before any data
multiplier tables if necessary. has been seen for some components, and thus before their Q-tables have
In buffered-image mode, the first output pass may occur before any data been saved away. To handle this case, multiplier tables are preset
has been seen for some components, and thus before their Q-tables have to zeroes; the result of the IDCT will be a neutral gray level. }
been saved away. To handle this case, multiplier tables are preset
to zeroes; the result of the IDCT will be a neutral gray level. }
{ Private subobject for this module }
{ Private subobject for this module } type
my_idct_ptr = ^my_idct_controller;
type my_idct_controller = record
my_idct_ptr = ^my_idct_controller; pub : jpeg_inverse_dct; { public fields }
my_idct_controller = record
pub : jpeg_inverse_dct; { public fields } { This array contains the IDCT method code that each multiplier table
is currently set up for, or -1 if it's not yet set up.
{ This array contains the IDCT method code that each multiplier table The actual multiplier tables are pointed to by dct_table in the
is currently set up for, or -1 if it's not yet set up. per-component comp_info structures. }
The actual multiplier tables are pointed to by dct_table in the
per-component comp_info structures. } cur_method : array[0..MAX_COMPONENTS-1] of int;
end; {my_idct_controller;}
cur_method : array[0..MAX_COMPONENTS-1] of int;
end; {my_idct_controller;}
{ Allocated multiplier tables: big enough for any supported variant }
{ Allocated multiplier tables: big enough for any supported variant } type
multiplier_table = record
type case byte of
multiplier_table = record 0:(islow_array : array[0..DCTSIZE2-1] of ISLOW_MULT_TYPE);
case byte of {$ifdef DCT_IFAST_SUPPORTED}
0:(islow_array : array[0..DCTSIZE2-1] of ISLOW_MULT_TYPE); 1:(ifast_array : array[0..DCTSIZE2-1] of IFAST_MULT_TYPE);
{$ifdef DCT_IFAST_SUPPORTED} {$endif}
1:(ifast_array : array[0..DCTSIZE2-1] of IFAST_MULT_TYPE); {$ifdef DCT_FLOAT_SUPPORTED}
{$endif} 2:(float_array : array[0..DCTSIZE2-1] of FLOAT_MULT_TYPE);
{$ifdef DCT_FLOAT_SUPPORTED} {$endif}
2:(float_array : array[0..DCTSIZE2-1] of FLOAT_MULT_TYPE); end;
{$endif}
end;
{ The current scaled-IDCT routines require ISLOW-style multiplier tables,
so be sure to compile that code if either ISLOW or SCALING is requested. }
{ The current scaled-IDCT routines require ISLOW-style multiplier tables,
so be sure to compile that code if either ISLOW or SCALING is requested. } {$ifdef DCT_ISLOW_SUPPORTED}
{$define PROVIDE_ISLOW_TABLES}
{$ifdef DCT_ISLOW_SUPPORTED} {$else}
{$define PROVIDE_ISLOW_TABLES} {$ifdef IDCT_SCALING_SUPPORTED}
{$else} {$define PROVIDE_ISLOW_TABLES}
{$ifdef IDCT_SCALING_SUPPORTED} {$endif}
{$define PROVIDE_ISLOW_TABLES} {$endif}
{$endif}
{$endif}
{ Prepare for an output pass.
Here we select the proper IDCT routine for each component and build
{ Prepare for an output pass. a matching multiplier table. }
Here we select the proper IDCT routine for each component and build
a matching multiplier table. } {METHODDEF}
procedure start_pass (cinfo : j_decompress_ptr);
{METHODDEF} var
procedure start_pass (cinfo : j_decompress_ptr); idct : my_idct_ptr;
var ci, i : int;
idct : my_idct_ptr; compptr : jpeg_component_info_ptr;
ci, i : int; method : J_DCT_METHOD;
compptr : jpeg_component_info_ptr; method_ptr : inverse_DCT_method_ptr;
method : J_DCT_METHOD; qtbl : JQUANT_TBL_PTR;
method_ptr : inverse_DCT_method_ptr; {$ifdef PROVIDE_ISLOW_TABLES}
qtbl : JQUANT_TBL_PTR; var
{$ifdef PROVIDE_ISLOW_TABLES} ismtbl : ISLOW_MULT_TYPE_FIELD_PTR;
var {$endif}
ismtbl : ISLOW_MULT_TYPE_FIELD_PTR; {$ifdef DCT_IFAST_SUPPORTED}
{$endif} const
{$ifdef DCT_IFAST_SUPPORTED} CONST_BITS = 14;
const const
CONST_BITS = 14; aanscales : array[0..DCTSIZE2-1] of INT16 =
const ({ precomputed values scaled up by 14 bits }
aanscales : array[0..DCTSIZE2-1] of INT16 = 16384, 22725, 21407, 19266, 16384, 12873, 8867, 4520,
({ precomputed values scaled up by 14 bits } 22725, 31521, 29692, 26722, 22725, 17855, 12299, 6270,
16384, 22725, 21407, 19266, 16384, 12873, 8867, 4520, 21407, 29692, 27969, 25172, 21407, 16819, 11585, 5906,
22725, 31521, 29692, 26722, 22725, 17855, 12299, 6270, 19266, 26722, 25172, 22654, 19266, 15137, 10426, 5315,
21407, 29692, 27969, 25172, 21407, 16819, 11585, 5906, 16384, 22725, 21407, 19266, 16384, 12873, 8867, 4520,
19266, 26722, 25172, 22654, 19266, 15137, 10426, 5315, 12873, 17855, 16819, 15137, 12873, 10114, 6967, 3552,
16384, 22725, 21407, 19266, 16384, 12873, 8867, 4520, 8867, 12299, 11585, 10426, 8867, 6967, 4799, 2446,
12873, 17855, 16819, 15137, 12873, 10114, 6967, 3552, 4520, 6270, 5906, 5315, 4520, 3552, 2446, 1247);
8867, 12299, 11585, 10426, 8867, 6967, 4799, 2446, var
4520, 6270, 5906, 5315, 4520, 3552, 2446, 1247); ifmtbl : IFAST_MULT_TYPE_FIELD_PTR;
var {SHIFT_TEMPS}
ifmtbl : IFAST_MULT_TYPE_FIELD_PTR;
{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
{ Descale and correctly round an INT32 value that's scaled by N bits. the fudge factor is correct for either sign of X. }
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
function DESCALE(x : INT32; n : int) : INT32; shift_temp : INT32;
var begin
shift_temp : INT32; {$ifdef RIGHT_SHIFT_IS_UNSIGNED}
begin shift_temp := x + (INT32(1) shl (n-1));
{$ifdef RIGHT_SHIFT_IS_UNSIGNED} if shift_temp < 0 then
shift_temp := x + (INT32(1) shl (n-1)); Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n))
if shift_temp < 0 then else
Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n)) Descale := (shift_temp shr n);
else {$else}
Descale := (shift_temp shr n); Descale := (x + (INT32(1) shl (n-1)) shr n;
{$else} {$endif}
Descale := (x + (INT32(1) shl (n-1)) shr n; end;
{$endif}
end; {$endif}
{$ifdef DCT_FLOAT_SUPPORTED}
{$endif} const
{$ifdef DCT_FLOAT_SUPPORTED} aanscalefactor : array[0..DCTSIZE-1] of double =
const (1.0, 1.387039845, 1.306562965, 1.175875602,
aanscalefactor : array[0..DCTSIZE-1] of double = 1.0, 0.785694958, 0.541196100, 0.275899379);
(1.0, 1.387039845, 1.306562965, 1.175875602, var
1.0, 0.785694958, 0.541196100, 0.275899379); fmtbl : FLOAT_MULT_TYPE_FIELD_PTR;
var row, col : int;
fmtbl : FLOAT_MULT_TYPE_FIELD_PTR; {$endif}
row, col : int; begin
{$endif} idct := my_idct_ptr (cinfo^.idct);
begin method := J_DCT_METHOD(0);
idct := my_idct_ptr (cinfo^.idct); method_ptr := NIL;
method := J_DCT_METHOD(0); compptr := jpeg_component_info_ptr(cinfo^.comp_info);
method_ptr := NIL;
compptr := jpeg_component_info_ptr(cinfo^.comp_info); for ci := 0 to pred(cinfo^.num_components) do
begin
for ci := 0 to pred(cinfo^.num_components) do { Select the proper IDCT routine for this component's scaling }
begin case (compptr^.DCT_scaled_size) of
{ Select the proper IDCT routine for this component's scaling } {$ifdef IDCT_SCALING_SUPPORTED}
case (compptr^.DCT_scaled_size) of 1:begin
{$ifdef IDCT_SCALING_SUPPORTED} method_ptr := jpeg_idct_1x1;
1:begin method := JDCT_ISLOW; { jidctred uses islow-style table }
method_ptr := jpeg_idct_1x1; end;
method := JDCT_ISLOW; { jidctred uses islow-style table } 2:begin
end; method_ptr := jpeg_idct_2x2;
2:begin method := JDCT_ISLOW; { jidctred uses islow-style table }
method_ptr := jpeg_idct_2x2; end;
method := JDCT_ISLOW; { jidctred uses islow-style table } 4:begin
end; method_ptr := jpeg_idct_4x4;
4:begin method := JDCT_ISLOW; { jidctred uses islow-style table }
method_ptr := jpeg_idct_4x4; end;
method := JDCT_ISLOW; { jidctred uses islow-style table } {$endif}
end; DCTSIZE:
{$endif} case (cinfo^.dct_method) of
DCTSIZE: {$ifdef DCT_ISLOW_SUPPORTED}
case (cinfo^.dct_method) of JDCT_ISLOW:
{$ifdef DCT_ISLOW_SUPPORTED} begin
JDCT_ISLOW: method_ptr := @jpeg_idct_islow;
begin method := JDCT_ISLOW;
method_ptr := @jpeg_idct_islow; end;
method := JDCT_ISLOW; {$endif}
end; {$ifdef DCT_IFAST_SUPPORTED}
{$endif} JDCT_IFAST:
{$ifdef DCT_IFAST_SUPPORTED} begin
JDCT_IFAST: method_ptr := @jpeg_idct_ifast;
begin method := JDCT_IFAST;
method_ptr := @jpeg_idct_ifast; end;
method := JDCT_IFAST; {$endif}
end; {$ifdef DCT_FLOAT_SUPPORTED}
{$endif} JDCT_FLOAT:
{$ifdef DCT_FLOAT_SUPPORTED} begin
JDCT_FLOAT: method_ptr := @jpeg_idct_float;
begin method := JDCT_FLOAT;
method_ptr := @jpeg_idct_float; end;
method := JDCT_FLOAT; {$endif}
end; else
{$endif} ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
else end;
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); else
end; ERREXIT1(j_common_ptr(cinfo), JERR_BAD_DCTSIZE, compptr^.DCT_scaled_size);
else end;
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_DCTSIZE, compptr^.DCT_scaled_size); idct^.pub.inverse_DCT[ci] := method_ptr;
end; { Create multiplier table from quant table.
idct^.pub.inverse_DCT[ci] := method_ptr; However, we can skip this if the component is uninteresting
{ Create multiplier table from quant table. or if we already built the table. Also, if no quant table
However, we can skip this if the component is uninteresting has yet been saved for the component, we leave the
or if we already built the table. Also, if no quant table multiplier table all-zero; we'll be reading zeroes from the
has yet been saved for the component, we leave the coefficient controller's buffer anyway. }
multiplier table all-zero; we'll be reading zeroes from the
coefficient controller's buffer anyway. } if (not compptr^.component_needed) or (idct^.cur_method[ci] = int(method)) then
continue;
if (not compptr^.component_needed) or (idct^.cur_method[ci] = int(method)) then qtbl := compptr^.quant_table;
continue; if (qtbl = NIL) then { happens if no data yet for component }
qtbl := compptr^.quant_table; continue;
if (qtbl = NIL) then { happens if no data yet for component } idct^.cur_method[ci] := int(method);
continue; case (method) of
idct^.cur_method[ci] := int(method); {$ifdef PROVIDE_ISLOW_TABLES}
case (method) of JDCT_ISLOW:
{$ifdef PROVIDE_ISLOW_TABLES} begin
JDCT_ISLOW: { For LL&M IDCT method, multipliers are equal to raw quantization
begin coefficients, but are stored as ints to ensure access efficiency. }
{ For LL&M IDCT method, multipliers are equal to raw quantization
coefficients, but are stored as ints to ensure access efficiency. } ismtbl := ISLOW_MULT_TYPE_FIELD_PTR (compptr^.dct_table);
for i := 0 to pred(DCTSIZE2) do
ismtbl := ISLOW_MULT_TYPE_FIELD_PTR (compptr^.dct_table); begin
for i := 0 to pred(DCTSIZE2) do ismtbl^[i] := ISLOW_MULT_TYPE (qtbl^.quantval[i]);
begin end;
ismtbl^[i] := ISLOW_MULT_TYPE (qtbl^.quantval[i]); end;
end; {$endif}
end; {$ifdef DCT_IFAST_SUPPORTED}
{$endif} JDCT_IFAST:
{$ifdef DCT_IFAST_SUPPORTED} begin
JDCT_IFAST: { For AA&N IDCT method, multipliers are equal to quantization
begin coefficients scaled by scalefactor[row]*scalefactor[col], where
{ For AA&N IDCT method, multipliers are equal to quantization scalefactor[0] := 1
coefficients scaled by scalefactor[row]*scalefactor[col], where scalefactor[k] := cos(k*PI/16) * sqrt(2) for k=1..7
scalefactor[0] := 1 For integer operation, the multiplier table is to be scaled by
scalefactor[k] := cos(k*PI/16) * sqrt(2) for k=1..7 IFAST_SCALE_BITS. }
For integer operation, the multiplier table is to be scaled by
IFAST_SCALE_BITS. } ifmtbl := IFAST_MULT_TYPE_FIELD_PTR (compptr^.dct_table);
ifmtbl := IFAST_MULT_TYPE_FIELD_PTR (compptr^.dct_table); for i := 0 to pred(DCTSIZE2) do
begin
for i := 0 to pred(DCTSIZE2) do ifmtbl^[i] := IFAST_MULT_TYPE(
begin DESCALE( INT32 (qtbl^.quantval[i]) * INT32 (aanscales[i]),
ifmtbl^[i] := IFAST_MULT_TYPE( CONST_BITS-IFAST_SCALE_BITS) );
DESCALE( INT32 (qtbl^.quantval[i]) * INT32 (aanscales[i]), end;
CONST_BITS-IFAST_SCALE_BITS) ); end;
end; {$endif}
end; {$ifdef DCT_FLOAT_SUPPORTED}
{$endif} JDCT_FLOAT:
{$ifdef DCT_FLOAT_SUPPORTED} begin
JDCT_FLOAT: { For float AA&N IDCT method, multipliers are equal to quantization
begin coefficients scaled by scalefactor[row]*scalefactor[col], where
{ For float AA&N IDCT method, multipliers are equal to quantization scalefactor[0] := 1
coefficients scaled by scalefactor[row]*scalefactor[col], where scalefactor[k] := cos(k*PI/16) * sqrt(2) for k=1..7 }
scalefactor[0] := 1
scalefactor[k] := cos(k*PI/16) * sqrt(2) for k=1..7 } fmtbl := FLOAT_MULT_TYPE_FIELD_PTR(compptr^.dct_table);
fmtbl := FLOAT_MULT_TYPE_FIELD_PTR(compptr^.dct_table); i := 0;
for row := 0 to pred(DCTSIZE) do
i := 0; begin
for row := 0 to pred(DCTSIZE) do for col := 0 to pred(DCTSIZE) do
begin begin
for col := 0 to pred(DCTSIZE) do fmtbl^[i] := {FLOAT_MULT_TYPE} (
begin {double} qtbl^.quantval[i] *
fmtbl^[i] := {FLOAT_MULT_TYPE} ( aanscalefactor[row] * aanscalefactor[col] );
{double} qtbl^.quantval[i] * Inc(i);
aanscalefactor[row] * aanscalefactor[col] ); end;
Inc(i); end;
end; end;
end; {$endif}
end; else
{$endif} ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
else break;
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); end;
break; Inc(compptr);
end; end;
Inc(compptr); end;
end;
end;
{ Initialize IDCT manager. }
{ Initialize IDCT manager. } {GLOBAL}
procedure jinit_inverse_dct (cinfo : j_decompress_ptr);
{GLOBAL} var
procedure jinit_inverse_dct (cinfo : j_decompress_ptr); idct : my_idct_ptr;
var ci : int;
idct : my_idct_ptr; compptr : jpeg_component_info_ptr;
ci : int; begin
compptr : jpeg_component_info_ptr; idct := my_idct_ptr(
begin cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
idct := my_idct_ptr( SIZEOF(my_idct_controller)) );
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, cinfo^.idct := jpeg_inverse_dct_ptr (idct);
SIZEOF(my_idct_controller)) ); idct^.pub.start_pass := start_pass;
cinfo^.idct := jpeg_inverse_dct_ptr (idct);
idct^.pub.start_pass := start_pass; compptr := jpeg_component_info_ptr(cinfo^.comp_info);
for ci := 0 to pred(cinfo^.num_components) do
compptr := jpeg_component_info_ptr(cinfo^.comp_info); begin
for ci := 0 to pred(cinfo^.num_components) do { Allocate and pre-zero a multiplier table for each component }
begin compptr^.dct_table :=
{ Allocate and pre-zero a multiplier table for each component } cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
compptr^.dct_table := SIZEOF(multiplier_table));
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, MEMZERO(compptr^.dct_table, SIZEOF(multiplier_table));
SIZEOF(multiplier_table)); { Mark multiplier table not yet set up for any method }
MEMZERO(compptr^.dct_table, SIZEOF(multiplier_table)); idct^.cur_method[ci] := -1;
{ Mark multiplier table not yet set up for any method } Inc(compptr);
idct^.cur_method[ci] := -1; end;
Inc(compptr); end;
end;
end; end.
end.

994
Imaging/JpegLib/imjdeferr.pas
View File

@ -1,497 +1,497 @@
unit imjdeferr; unit imjdeferr;
{ This file defines the error and message codes for the cjpeg/djpeg { This file defines the error and message codes for the cjpeg/djpeg
applications. These strings are not needed as part of the JPEG library applications. These strings are not needed as part of the JPEG library
proper. proper.
Edit this file to add new codes, or to translate the message strings to Edit this file to add new codes, or to translate the message strings to
some other language. } some other language. }
{ Original cderror.h ; Copyright (C) 1994, Thomas G. Lane. } { Original cderror.h ; Copyright (C) 1994, Thomas G. Lane. }
interface interface
{$I imjconfig.inc} {$I imjconfig.inc}
{ To define the enum list of message codes, include this file without { To define the enum list of message codes, include this file without
defining macro JMESSAGE. To create a message string table, include it defining macro JMESSAGE. To create a message string table, include it
again with a suitable JMESSAGE definition (see jerror.c for an example). } again with a suitable JMESSAGE definition (see jerror.c for an example). }
{ Original: jversion.h ; Copyright (C) 1991-1996, Thomas G. Lane. } { Original: jversion.h ; Copyright (C) 1991-1996, Thomas G. Lane. }
{ This file contains software version identification. } { This file contains software version identification. }
const const
JVERSION = '6a 7-Feb-96'; JVERSION = '6a 7-Feb-96';
JCOPYRIGHT = 'Copyright (C) 1996, Thomas G. Lane'; JCOPYRIGHT = 'Copyright (C) 1996, Thomas G. Lane';
JNOTICE = 'Pascal Translation, Copyright (C) 1996, Jacques Nomssi Nzali'; JNOTICE = 'Pascal Translation, Copyright (C) 1996, Jacques Nomssi Nzali';
{ Create the message string table. { Create the message string table.
We do this from the master message list in jerror.h by re-reading We do this from the master message list in jerror.h by re-reading
jerror.h with a suitable definition for macro JMESSAGE. jerror.h with a suitable definition for macro JMESSAGE.
The message table is made an external symbol just in case any applications The message table is made an external symbol just in case any applications
want to refer to it directly. } want to refer to it directly. }
type type
J_MESSAGE_CODE =( J_MESSAGE_CODE =(
JMSG_NOMESSAGE, JMSG_NOMESSAGE,
JERR_ARITH_NOTIMPL, JERR_ARITH_NOTIMPL,
JERR_BAD_ALIGN_TYPE, JERR_BAD_ALIGN_TYPE,
JERR_BAD_ALLOC_CHUNK, JERR_BAD_ALLOC_CHUNK,
JERR_BAD_BUFFER_MODE, JERR_BAD_BUFFER_MODE,
JERR_BAD_COMPONENT_ID, JERR_BAD_COMPONENT_ID,
JERR_BAD_DCT_COEF, JERR_BAD_DCT_COEF,
JERR_BAD_DCTSIZE, JERR_BAD_DCTSIZE,
JERR_BAD_HUFF_TABLE, JERR_BAD_HUFF_TABLE,
JERR_BAD_IN_COLORSPACE, JERR_BAD_IN_COLORSPACE,
JERR_BAD_J_COLORSPACE, JERR_BAD_J_COLORSPACE,
JERR_BAD_LENGTH, JERR_BAD_LENGTH,
JERR_BAD_LIB_VERSION, JERR_BAD_LIB_VERSION,
JERR_BAD_MCU_SIZE, JERR_BAD_MCU_SIZE,
JERR_BAD_POOL_ID, JERR_BAD_POOL_ID,
JERR_BAD_PRECISION, JERR_BAD_PRECISION,
JERR_BAD_PROGRESSION, JERR_BAD_PROGRESSION,
JERR_BAD_PROG_SCRIPT, JERR_BAD_PROG_SCRIPT,
JERR_BAD_SAMPLING, JERR_BAD_SAMPLING,
JERR_BAD_SCAN_SCRIPT, JERR_BAD_SCAN_SCRIPT,
JERR_BAD_STATE, JERR_BAD_STATE,
JERR_BAD_STRUCT_SIZE, JERR_BAD_STRUCT_SIZE,
JERR_BAD_VIRTUAL_ACCESS, JERR_BAD_VIRTUAL_ACCESS,
JERR_BUFFER_SIZE, JERR_BUFFER_SIZE,
JERR_CANT_SUSPEND, JERR_CANT_SUSPEND,
JERR_CCIR601_NOTIMPL, JERR_CCIR601_NOTIMPL,
JERR_COMPONENT_COUNT, JERR_COMPONENT_COUNT,
JERR_CONVERSION_NOTIMPL, JERR_CONVERSION_NOTIMPL,
JERR_DAC_INDEX, JERR_DAC_INDEX,
JERR_DAC_VALUE, JERR_DAC_VALUE,
JERR_DHT_COUNTS, JERR_DHT_COUNTS,
JERR_DHT_INDEX, JERR_DHT_INDEX,
JERR_DQT_INDEX, JERR_DQT_INDEX,
JERR_EMPTY_IMAGE, JERR_EMPTY_IMAGE,
JERR_EMS_READ, JERR_EMS_READ,
JERR_EMS_WRITE, JERR_EMS_WRITE,
JERR_EOI_EXPECTED, JERR_EOI_EXPECTED,
JERR_FILE_READ, JERR_FILE_READ,
JERR_FILE_WRITE, JERR_FILE_WRITE,
JERR_FRACT_SAMPLE_NOTIMPL, JERR_FRACT_SAMPLE_NOTIMPL,
JERR_HUFF_CLEN_OVERFLOW, JERR_HUFF_CLEN_OVERFLOW,
JERR_HUFF_MISSING_CODE, JERR_HUFF_MISSING_CODE,
JERR_IMAGE_TOO_BIG, JERR_IMAGE_TOO_BIG,
JERR_INPUT_EMPTY, JERR_INPUT_EMPTY,
JERR_INPUT_EOF, JERR_INPUT_EOF,
JERR_MISMATCHED_QUANT_TABLE, JERR_MISMATCHED_QUANT_TABLE,
JERR_MISSING_DATA, JERR_MISSING_DATA,
JERR_MODE_CHANGE, JERR_MODE_CHANGE,
JERR_NOTIMPL, JERR_NOTIMPL,
JERR_NOT_COMPILED, JERR_NOT_COMPILED,
JERR_NO_BACKING_STORE, JERR_NO_BACKING_STORE,
JERR_NO_HUFF_TABLE, JERR_NO_HUFF_TABLE,
JERR_NO_IMAGE, JERR_NO_IMAGE,
JERR_NO_QUANT_TABLE, JERR_NO_QUANT_TABLE,
JERR_NO_SOI, JERR_NO_SOI,
JERR_OUT_OF_MEMORY, JERR_OUT_OF_MEMORY,
JERR_QUANT_COMPONENTS, JERR_QUANT_COMPONENTS,
JERR_QUANT_FEW_COLORS, JERR_QUANT_FEW_COLORS,
JERR_QUANT_MANY_COLORS, JERR_QUANT_MANY_COLORS,
JERR_SOF_DUPLICATE, JERR_SOF_DUPLICATE,
JERR_SOF_NO_SOS, JERR_SOF_NO_SOS,
JERR_SOF_UNSUPPORTED, JERR_SOF_UNSUPPORTED,
JERR_SOI_DUPLICATE, JERR_SOI_DUPLICATE,
JERR_SOS_NO_SOF, JERR_SOS_NO_SOF,
JERR_TFILE_CREATE, JERR_TFILE_CREATE,
JERR_TFILE_READ, JERR_TFILE_READ,
JERR_TFILE_SEEK, JERR_TFILE_SEEK,
JERR_TFILE_WRITE, JERR_TFILE_WRITE,
JERR_TOO_LITTLE_DATA, JERR_TOO_LITTLE_DATA,
JERR_UNKNOWN_MARKER, JERR_UNKNOWN_MARKER,
JERR_VIRTUAL_BUG, JERR_VIRTUAL_BUG,
JERR_WIDTH_OVERFLOW, JERR_WIDTH_OVERFLOW,
JERR_XMS_READ, JERR_XMS_READ,
JERR_XMS_WRITE, JERR_XMS_WRITE,
JMSG_COPYRIGHT, JMSG_COPYRIGHT,
JMSG_VERSION, JMSG_VERSION,
JTRC_16BIT_TABLES, JTRC_16BIT_TABLES,
JTRC_ADOBE, JTRC_ADOBE,
JTRC_APP0, JTRC_APP0,
JTRC_APP14, JTRC_APP14,
JTRC_DAC, JTRC_DAC,
JTRC_DHT, JTRC_DHT,
JTRC_DQT, JTRC_DQT,
JTRC_DRI, JTRC_DRI,
JTRC_EMS_CLOSE, JTRC_EMS_CLOSE,
JTRC_EMS_OPEN, JTRC_EMS_OPEN,
JTRC_EOI, JTRC_EOI,
JTRC_HUFFBITS, JTRC_HUFFBITS,
JTRC_JFIF, JTRC_JFIF,
JTRC_JFIF_BADTHUMBNAILSIZE, JTRC_JFIF_BADTHUMBNAILSIZE,
JTRC_JFIF_EXTENSION, JTRC_JFIF_EXTENSION,
JTRC_JFIF_THUMBNAIL, JTRC_JFIF_THUMBNAIL,
JTRC_MISC_MARKER, JTRC_MISC_MARKER,
JTRC_PARMLESS_MARKER, JTRC_PARMLESS_MARKER,
JTRC_QUANTVALS, JTRC_QUANTVALS,
JTRC_QUANT_3_NCOLORS, JTRC_QUANT_3_NCOLORS,
JTRC_QUANT_NCOLORS, JTRC_QUANT_NCOLORS,
JTRC_QUANT_SELECTED, JTRC_QUANT_SELECTED,
JTRC_RECOVERY_ACTION, JTRC_RECOVERY_ACTION,
JTRC_RST, JTRC_RST,
JTRC_SMOOTH_NOTIMPL, JTRC_SMOOTH_NOTIMPL,
JTRC_SOF, JTRC_SOF,
JTRC_SOF_COMPONENT, JTRC_SOF_COMPONENT,
JTRC_SOI, JTRC_SOI,
JTRC_SOS, JTRC_SOS,
JTRC_SOS_COMPONENT, JTRC_SOS_COMPONENT,
JTRC_SOS_PARAMS, JTRC_SOS_PARAMS,
JTRC_TFILE_CLOSE, JTRC_TFILE_CLOSE,
JTRC_TFILE_OPEN, JTRC_TFILE_OPEN,
JTRC_THUMB_JPEG, JTRC_THUMB_JPEG,
JTRC_THUMB_PALETTE, JTRC_THUMB_PALETTE,
JTRC_THUMB_RGB, JTRC_THUMB_RGB,
JTRC_UNKNOWN_IDS, JTRC_UNKNOWN_IDS,
JTRC_XMS_CLOSE, JTRC_XMS_CLOSE,
JTRC_XMS_OPEN, JTRC_XMS_OPEN,
JWRN_ADOBE_XFORM, JWRN_ADOBE_XFORM,
JWRN_BOGUS_PROGRESSION, JWRN_BOGUS_PROGRESSION,
JWRN_EXTRANEOUS_DATA, JWRN_EXTRANEOUS_DATA,
JWRN_HIT_MARKER, JWRN_HIT_MARKER,
JWRN_HUFF_BAD_CODE, JWRN_HUFF_BAD_CODE,
JWRN_JFIF_MAJOR, JWRN_JFIF_MAJOR,
JWRN_JPEG_EOF, JWRN_JPEG_EOF,
JWRN_MUST_RESYNC, JWRN_MUST_RESYNC,
JWRN_NOT_SEQUENTIAL, JWRN_NOT_SEQUENTIAL,
JWRN_TOO_MUCH_DATA, JWRN_TOO_MUCH_DATA,
JMSG_FIRSTADDONCODE, { Must be first entry! } JMSG_FIRSTADDONCODE, { Must be first entry! }
{$ifdef BMP_SUPPORTED} {$ifdef BMP_SUPPORTED}
JERR_BMP_BADCMAP, { Unsupported BMP colormap format } JERR_BMP_BADCMAP, { Unsupported BMP colormap format }
JERR_BMP_BADDEPTH, { Only 8- and 24-bit BMP files are supported } JERR_BMP_BADDEPTH, { Only 8- and 24-bit BMP files are supported }
JERR_BMP_BADHEADER, { Invalid BMP file: bad header length } JERR_BMP_BADHEADER, { Invalid BMP file: bad header length }
JERR_BMP_BADPLANES, { Invalid BMP file: biPlanes not equal to 1 } JERR_BMP_BADPLANES, { Invalid BMP file: biPlanes not equal to 1 }
JERR_BMP_COLORSPACE, { BMP output must be grayscale or RGB } JERR_BMP_COLORSPACE, { BMP output must be grayscale or RGB }
JERR_BMP_COMPRESSED, { Sorry, compressed BMPs not yet supported } JERR_BMP_COMPRESSED, { Sorry, compressed BMPs not yet supported }
JERR_BMP_NOT, { Not a BMP file - does not start with BM } JERR_BMP_NOT, { Not a BMP file - does not start with BM }
JTRC_BMP, { %dx%d 24-bit BMP image } JTRC_BMP, { %dx%d 24-bit BMP image }
JTRC_BMP_MAPPED, { %dx%d 8-bit colormapped BMP image } JTRC_BMP_MAPPED, { %dx%d 8-bit colormapped BMP image }
JTRC_BMP_OS2, { %dx%d 24-bit OS2 BMP image } JTRC_BMP_OS2, { %dx%d 24-bit OS2 BMP image }
JTRC_BMP_OS2_MAPPED, { %dx%d 8-bit colormapped OS2 BMP image } JTRC_BMP_OS2_MAPPED, { %dx%d 8-bit colormapped OS2 BMP image }
{$endif} { BMP_SUPPORTED } {$endif} { BMP_SUPPORTED }
{$ifdef GIF_SUPPORTED} {$ifdef GIF_SUPPORTED}
JERR_GIF_BUG, { GIF output got confused } JERR_GIF_BUG, { GIF output got confused }
JERR_GIF_CODESIZE, { Bogus GIF codesize %d } JERR_GIF_CODESIZE, { Bogus GIF codesize %d }
JERR_GIF_COLORSPACE, { GIF output must be grayscale or RGB } JERR_GIF_COLORSPACE, { GIF output must be grayscale or RGB }
JERR_GIF_IMAGENOTFOUND, { Too few images in GIF file } JERR_GIF_IMAGENOTFOUND, { Too few images in GIF file }
JERR_GIF_NOT, { Not a GIF file } JERR_GIF_NOT, { Not a GIF file }
JTRC_GIF, { %dx%dx%d GIF image } JTRC_GIF, { %dx%dx%d GIF image }
JTRC_GIF_BADVERSION, JTRC_GIF_BADVERSION,
{ Warning: unexpected GIF version number '%c%c%c' } { Warning: unexpected GIF version number '%c%c%c' }
JTRC_GIF_EXTENSION, { Ignoring GIF extension block of type 0x%02x } JTRC_GIF_EXTENSION, { Ignoring GIF extension block of type 0x%02x }
JTRC_GIF_NONSQUARE, { Caution: nonsquare pixels in input } JTRC_GIF_NONSQUARE, { Caution: nonsquare pixels in input }
JWRN_GIF_BADDATA, { Corrupt data in GIF file } JWRN_GIF_BADDATA, { Corrupt data in GIF file }
JWRN_GIF_CHAR, { Bogus char 0x%02x in GIF file, ignoring } JWRN_GIF_CHAR, { Bogus char 0x%02x in GIF file, ignoring }
JWRN_GIF_ENDCODE, { Premature end of GIF image } JWRN_GIF_ENDCODE, { Premature end of GIF image }
JWRN_GIF_NOMOREDATA, { Ran out of GIF bits } JWRN_GIF_NOMOREDATA, { Ran out of GIF bits }
{$endif} { GIF_SUPPORTED } {$endif} { GIF_SUPPORTED }
{$ifdef PPM_SUPPORTED} {$ifdef PPM_SUPPORTED}
JERR_PPM_COLORSPACE, { PPM output must be grayscale or RGB } JERR_PPM_COLORSPACE, { PPM output must be grayscale or RGB }
JERR_PPM_NONNUMERIC, { Nonnumeric data in PPM file } JERR_PPM_NONNUMERIC, { Nonnumeric data in PPM file }
JERR_PPM_NOT, { Not a PPM file } JERR_PPM_NOT, { Not a PPM file }
JTRC_PGM, { %dx%d PGM image } JTRC_PGM, { %dx%d PGM image }
JTRC_PGM_TEXT, { %dx%d text PGM image } JTRC_PGM_TEXT, { %dx%d text PGM image }
JTRC_PPM, { %dx%d PPM image } JTRC_PPM, { %dx%d PPM image }
JTRC_PPM_TEXT, { %dx%d text PPM image } JTRC_PPM_TEXT, { %dx%d text PPM image }
{$endif} { PPM_SUPPORTED } {$endif} { PPM_SUPPORTED }
{$ifdef RLE_SUPPORTED} {$ifdef RLE_SUPPORTED}
JERR_RLE_BADERROR, { Bogus error code from RLE library } JERR_RLE_BADERROR, { Bogus error code from RLE library }
JERR_RLE_COLORSPACE, { RLE output must be grayscale or RGB } JERR_RLE_COLORSPACE, { RLE output must be grayscale or RGB }
JERR_RLE_DIMENSIONS, { Image dimensions (%dx%d) too large for RLE } JERR_RLE_DIMENSIONS, { Image dimensions (%dx%d) too large for RLE }
JERR_RLE_EMPTY, { Empty RLE file } JERR_RLE_EMPTY, { Empty RLE file }
JERR_RLE_EOF, { Premature EOF in RLE header } JERR_RLE_EOF, { Premature EOF in RLE header }
JERR_RLE_MEM, { Insufficient memory for RLE header } JERR_RLE_MEM, { Insufficient memory for RLE header }
JERR_RLE_NOT, { Not an RLE file } JERR_RLE_NOT, { Not an RLE file }
JERR_RLE_TOOMANYCHANNELS, { Cannot handle %d output channels for RLE } JERR_RLE_TOOMANYCHANNELS, { Cannot handle %d output channels for RLE }
JERR_RLE_UNSUPPORTED, { Cannot handle this RLE setup } JERR_RLE_UNSUPPORTED, { Cannot handle this RLE setup }
JTRC_RLE, { %dx%d full-color RLE file } JTRC_RLE, { %dx%d full-color RLE file }
JTRC_RLE_FULLMAP, { %dx%d full-color RLE file with map of length %d } JTRC_RLE_FULLMAP, { %dx%d full-color RLE file with map of length %d }
JTRC_RLE_GRAY, { %dx%d grayscale RLE file } JTRC_RLE_GRAY, { %dx%d grayscale RLE file }
JTRC_RLE_MAPGRAY, { %dx%d grayscale RLE file with map of length %d } JTRC_RLE_MAPGRAY, { %dx%d grayscale RLE file with map of length %d }
JTRC_RLE_MAPPED, { %dx%d colormapped RLE file with map of length %d } JTRC_RLE_MAPPED, { %dx%d colormapped RLE file with map of length %d }
{$endif} { RLE_SUPPORTED } {$endif} { RLE_SUPPORTED }
{$ifdef TARGA_SUPPORTED} {$ifdef TARGA_SUPPORTED}
JERR_TGA_BADCMAP, { Unsupported Targa colormap format } JERR_TGA_BADCMAP, { Unsupported Targa colormap format }
JERR_TGA_BADPARMS, { Invalid or unsupported Targa file } JERR_TGA_BADPARMS, { Invalid or unsupported Targa file }
JERR_TGA_COLORSPACE, { Targa output must be grayscale or RGB } JERR_TGA_COLORSPACE, { Targa output must be grayscale or RGB }
JTRC_TGA, { %dx%d RGB Targa image } JTRC_TGA, { %dx%d RGB Targa image }
JTRC_TGA_GRAY, { %dx%d grayscale Targa image } JTRC_TGA_GRAY, { %dx%d grayscale Targa image }
JTRC_TGA_MAPPED, { %dx%d colormapped Targa image } JTRC_TGA_MAPPED, { %dx%d colormapped Targa image }
{$else} {$else}
JERR_TGA_NOTCOMP, { Targa support was not compiled } JERR_TGA_NOTCOMP, { Targa support was not compiled }
{$endif} { TARGA_SUPPORTED } {$endif} { TARGA_SUPPORTED }
JERR_BAD_CMAP_FILE, JERR_BAD_CMAP_FILE,
{ Color map file is invalid or of unsupported format } { Color map file is invalid or of unsupported format }
JERR_TOO_MANY_COLORS, JERR_TOO_MANY_COLORS,
{ Output file format cannot handle %d colormap entries } { Output file format cannot handle %d colormap entries }
JERR_UNGETC_FAILED, { ungetc failed } JERR_UNGETC_FAILED, { ungetc failed }
{$ifdef TARGA_SUPPORTED} {$ifdef TARGA_SUPPORTED}
JERR_UNKNOWN_FORMAT, JERR_UNKNOWN_FORMAT,
{ Unrecognized input file format --- perhaps you need -targa } { Unrecognized input file format --- perhaps you need -targa }
{$else} {$else}
JERR_UNKNOWN_FORMAT, { Unrecognized input file format } JERR_UNKNOWN_FORMAT, { Unrecognized input file format }
{$endif} {$endif}
JERR_UNSUPPORTED_FORMAT, { Unsupported output file format } JERR_UNSUPPORTED_FORMAT, { Unsupported output file format }
JMSG_LASTADDONCODE JMSG_LASTADDONCODE
); );
const const
JMSG_LASTMSGCODE : J_MESSAGE_CODE = JMSG_LASTADDONCODE; JMSG_LASTMSGCODE : J_MESSAGE_CODE = JMSG_LASTADDONCODE;
type type
msg_table = Array[J_MESSAGE_CODE] of string[80]; msg_table = Array[J_MESSAGE_CODE] of string[80];
const const
jpeg_std_message_table : msg_table = ( jpeg_std_message_table : msg_table = (
{ JMSG_NOMESSAGE } 'Bogus message code %d', { Must be first entry! } { JMSG_NOMESSAGE } 'Bogus message code %d', { Must be first entry! }
{ For maintenance convenience, list is alphabetical by message code name } { For maintenance convenience, list is alphabetical by message code name }
{ JERR_ARITH_NOTIMPL } { JERR_ARITH_NOTIMPL }
'Sorry, there are legal restrictions on arithmetic coding', 'Sorry, there are legal restrictions on arithmetic coding',
{ JERR_BAD_ALIGN_TYPE } 'ALIGN_TYPE is wrong, please fix', { JERR_BAD_ALIGN_TYPE } 'ALIGN_TYPE is wrong, please fix',
{ JERR_BAD_ALLOC_CHUNK } 'MAX_ALLOC_CHUNK is wrong, please fix', { JERR_BAD_ALLOC_CHUNK } 'MAX_ALLOC_CHUNK is wrong, please fix',
{ JERR_BAD_BUFFER_MODE } 'Bogus buffer control mode', { JERR_BAD_BUFFER_MODE } 'Bogus buffer control mode',
{ JERR_BAD_COMPONENT_ID } 'Invalid component ID %d in SOS', { JERR_BAD_COMPONENT_ID } 'Invalid component ID %d in SOS',
{ JERR_BAD_DCT_COEF } 'DCT coefficient out of range', { JERR_BAD_DCT_COEF } 'DCT coefficient out of range',
{ JERR_BAD_DCTSIZE } 'IDCT output block size %d not supported', { JERR_BAD_DCTSIZE } 'IDCT output block size %d not supported',
{ JERR_BAD_HUFF_TABLE } 'Bogus Huffman table definition', { JERR_BAD_HUFF_TABLE } 'Bogus Huffman table definition',
{ JERR_BAD_IN_COLORSPACE } 'Bogus input colorspace', { JERR_BAD_IN_COLORSPACE } 'Bogus input colorspace',
{ JERR_BAD_J_COLORSPACE } 'Bogus JPEG colorspace', { JERR_BAD_J_COLORSPACE } 'Bogus JPEG colorspace',
{ JERR_BAD_LENGTH } 'Bogus marker length', { JERR_BAD_LENGTH } 'Bogus marker length',
{ JERR_BAD_LIB_VERSION } { JERR_BAD_LIB_VERSION }
'Wrong JPEG library version: library is %d, caller expects %d', 'Wrong JPEG library version: library is %d, caller expects %d',
{ JERR_BAD_MCU_SIZE } 'Sampling factors too large for interleaved scan', { JERR_BAD_MCU_SIZE } 'Sampling factors too large for interleaved scan',
{ JERR_BAD_POOL_ID } 'Invalid memory pool code %d', { JERR_BAD_POOL_ID } 'Invalid memory pool code %d',
{ JERR_BAD_PRECISION } 'Unsupported JPEG data precision %d', { JERR_BAD_PRECISION } 'Unsupported JPEG data precision %d',
{ JERR_BAD_PROGRESSION } { JERR_BAD_PROGRESSION }
'Invalid progressive parameters Ss=%d Se=%d Ah=%d Al=%d', 'Invalid progressive parameters Ss=%d Se=%d Ah=%d Al=%d',
{ JERR_BAD_PROG_SCRIPT } { JERR_BAD_PROG_SCRIPT }
'Invalid progressive parameters at scan script entry %d', 'Invalid progressive parameters at scan script entry %d',
{ JERR_BAD_SAMPLING } 'Bogus sampling factors', { JERR_BAD_SAMPLING } 'Bogus sampling factors',
{ JERR_BAD_SCAN_SCRIPT } 'Invalid scan script at entry %d', { JERR_BAD_SCAN_SCRIPT } 'Invalid scan script at entry %d',
{ JERR_BAD_STATE } 'Improper call to JPEG library in state %d', { JERR_BAD_STATE } 'Improper call to JPEG library in state %d',
{ JERR_BAD_STRUCT_SIZE } { JERR_BAD_STRUCT_SIZE }
'JPEG parameter struct mismatch: library thinks size is %d, caller expects %d', 'JPEG parameter struct mismatch: library thinks size is %d, caller expects %d',
{ JERR_BAD_VIRTUAL_ACCESS } 'Bogus virtual array access', { JERR_BAD_VIRTUAL_ACCESS } 'Bogus virtual array access',
{ JERR_BUFFER_SIZE } 'Buffer passed to JPEG library is too small', { JERR_BUFFER_SIZE } 'Buffer passed to JPEG library is too small',
{ JERR_CANT_SUSPEND } 'Suspension not allowed here', { JERR_CANT_SUSPEND } 'Suspension not allowed here',
{ JERR_CCIR601_NOTIMPL } 'CCIR601 sampling not implemented yet', { JERR_CCIR601_NOTIMPL } 'CCIR601 sampling not implemented yet',
{ JERR_COMPONENT_COUNT } 'Too many color components: %d, max %d', { JERR_COMPONENT_COUNT } 'Too many color components: %d, max %d',
{ JERR_CONVERSION_NOTIMPL } 'Unsupported color conversion request', { JERR_CONVERSION_NOTIMPL } 'Unsupported color conversion request',
{ JERR_DAC_INDEX } 'Bogus DAC index %d', { JERR_DAC_INDEX } 'Bogus DAC index %d',
{ JERR_DAC_VALUE } 'Bogus DAC value $%x', { JERR_DAC_VALUE } 'Bogus DAC value $%x',
{ JERR_DHT_COUNTS } 'Bogus DHT counts', { JERR_DHT_COUNTS } 'Bogus DHT counts',
{ JERR_DHT_INDEX } 'Bogus DHT index %d', { JERR_DHT_INDEX } 'Bogus DHT index %d',
{ JERR_DQT_INDEX } 'Bogus DQT index %d', { JERR_DQT_INDEX } 'Bogus DQT index %d',
{ JERR_EMPTY_IMAGE } 'Empty JPEG image (DNL not supported)', { JERR_EMPTY_IMAGE } 'Empty JPEG image (DNL not supported)',
{ JERR_EMS_READ } 'Read from EMS failed', { JERR_EMS_READ } 'Read from EMS failed',
{ JERR_EMS_WRITE } 'Write to EMS failed', { JERR_EMS_WRITE } 'Write to EMS failed',
{ JERR_EOI_EXPECTED } 'Didn''t expect more than one scan', { JERR_EOI_EXPECTED } 'Didn''t expect more than one scan',
{ JERR_FILE_READ } 'Input file read error', { JERR_FILE_READ } 'Input file read error',
{ JERR_FILE_WRITE } 'Output file write error --- out of disk space?', { JERR_FILE_WRITE } 'Output file write error --- out of disk space?',
{ JERR_FRACT_SAMPLE_NOTIMPL } 'Fractional sampling not implemented yet', { JERR_FRACT_SAMPLE_NOTIMPL } 'Fractional sampling not implemented yet',
{ JERR_HUFF_CLEN_OVERFLOW } 'Huffman code size table overflow', { JERR_HUFF_CLEN_OVERFLOW } 'Huffman code size table overflow',
{ JERR_HUFF_MISSING_CODE } 'Missing Huffman code table entry', { JERR_HUFF_MISSING_CODE } 'Missing Huffman code table entry',
{ JERR_IMAGE_TOO_BIG } 'Maximum supported image dimension is %d pixels', { JERR_IMAGE_TOO_BIG } 'Maximum supported image dimension is %d pixels',
{ JERR_INPUT_EMPTY } 'Empty input file', { JERR_INPUT_EMPTY } 'Empty input file',
{ JERR_INPUT_EOF } 'Premature end of input file', { JERR_INPUT_EOF } 'Premature end of input file',
{ JERR_MISMATCHED_QUANT_TABLE } { JERR_MISMATCHED_QUANT_TABLE }
'Cannot transcode due to multiple use of quantization table %d', 'Cannot transcode due to multiple use of quantization table %d',
{ JERR_MISSING_DATA } 'Scan script does not transmit all data', { JERR_MISSING_DATA } 'Scan script does not transmit all data',
{ JERR_MODE_CHANGE } 'Invalid color quantization mode change', { JERR_MODE_CHANGE } 'Invalid color quantization mode change',
{ JERR_NOTIMPL } 'Not implemented yet', { JERR_NOTIMPL } 'Not implemented yet',
{ JERR_NOT_COMPILED } 'Requested feature was omitted at compile time', { JERR_NOT_COMPILED } 'Requested feature was omitted at compile time',
{ JERR_NO_BACKING_STORE } 'Backing store not supported', { JERR_NO_BACKING_STORE } 'Backing store not supported',
{ JERR_NO_HUFF_TABLE } 'Huffman table $%02x was not defined', { JERR_NO_HUFF_TABLE } 'Huffman table $%02x was not defined',
{ JERR_NO_IMAGE } 'JPEG datastream contains no image', { JERR_NO_IMAGE } 'JPEG datastream contains no image',
{ JERR_NO_QUANT_TABLE } 'Quantization table $%02x was not defined', { JERR_NO_QUANT_TABLE } 'Quantization table $%02x was not defined',
{ JERR_NO_SOI } 'Not a JPEG file: starts with $%02x $%02x', { JERR_NO_SOI } 'Not a JPEG file: starts with $%02x $%02x',
{ JERR_OUT_OF_MEMORY } 'Insufficient memory (case %d)', { JERR_OUT_OF_MEMORY } 'Insufficient memory (case %d)',
{ JERR_QUANT_COMPONENTS } { JERR_QUANT_COMPONENTS }
'Cannot quantize more than %d color components', 'Cannot quantize more than %d color components',
{ JERR_QUANT_FEW_COLORS } 'Cannot quantize to fewer than %d colors', { JERR_QUANT_FEW_COLORS } 'Cannot quantize to fewer than %d colors',
{ JERR_QUANT_MANY_COLORS } 'Cannot quantize to more than %d colors', { JERR_QUANT_MANY_COLORS } 'Cannot quantize to more than %d colors',
{ JERR_SOF_DUPLICATE } 'Invalid JPEG file structure: two SOF markers', { JERR_SOF_DUPLICATE } 'Invalid JPEG file structure: two SOF markers',
{ JERR_SOF_NO_SOS } 'Invalid JPEG file structure: missing SOS marker', { JERR_SOF_NO_SOS } 'Invalid JPEG file structure: missing SOS marker',
{ JERR_SOF_UNSUPPORTED } 'Unsupported JPEG process: SOF type $%02x', { JERR_SOF_UNSUPPORTED } 'Unsupported JPEG process: SOF type $%02x',
{ JERR_SOI_DUPLICATE } 'Invalid JPEG file structure: two SOI markers', { JERR_SOI_DUPLICATE } 'Invalid JPEG file structure: two SOI markers',
{ JERR_SOS_NO_SOF } 'Invalid JPEG file structure: SOS before SOF', { JERR_SOS_NO_SOF } 'Invalid JPEG file structure: SOS before SOF',
{ JERR_TFILE_CREATE } 'Failed to create temporary file %s', { JERR_TFILE_CREATE } 'Failed to create temporary file %s',
{ JERR_TFILE_READ } 'Read failed on temporary file', { JERR_TFILE_READ } 'Read failed on temporary file',
{ JERR_TFILE_SEEK } 'Seek failed on temporary file', { JERR_TFILE_SEEK } 'Seek failed on temporary file',
{ JERR_TFILE_WRITE } { JERR_TFILE_WRITE }
'Write failed on temporary file --- out of disk space?', 'Write failed on temporary file --- out of disk space?',
{ JERR_TOO_LITTLE_DATA } 'Application transferred too few scanlines', { JERR_TOO_LITTLE_DATA } 'Application transferred too few scanlines',
{ JERR_UNKNOWN_MARKER } 'Unsupported marker type $%02x', { JERR_UNKNOWN_MARKER } 'Unsupported marker type $%02x',
{ JERR_VIRTUAL_BUG } 'Virtual array controller messed up', { JERR_VIRTUAL_BUG } 'Virtual array controller messed up',
{ JERR_WIDTH_OVERFLOW } 'Image too wide for this implementation', { JERR_WIDTH_OVERFLOW } 'Image too wide for this implementation',
{ JERR_XMS_READ } 'Read from XMS failed', { JERR_XMS_READ } 'Read from XMS failed',
{ JERR_XMS_WRITE } 'Write to XMS failed', { JERR_XMS_WRITE } 'Write to XMS failed',
{ JMSG_COPYRIGHT } JCOPYRIGHT, { JMSG_COPYRIGHT } JCOPYRIGHT,
{ JMSG_VERSION } JVERSION, { JMSG_VERSION } JVERSION,
{ JTRC_16BIT_TABLES } { JTRC_16BIT_TABLES }
'Caution: quantization tables are too coarse for baseline JPEG', 'Caution: quantization tables are too coarse for baseline JPEG',
{ JTRC_ADOBE } { JTRC_ADOBE }
'Adobe APP14 marker: version %d, flags $%04x $%04x, transform %d', 'Adobe APP14 marker: version %d, flags $%04x $%04x, transform %d',
{ JTRC_APP0 } 'Unknown APP0 marker (not JFIF), length %d', { JTRC_APP0 } 'Unknown APP0 marker (not JFIF), length %d',
{ JTRC_APP14 } 'Unknown APP14 marker (not Adobe), length %d', { JTRC_APP14 } 'Unknown APP14 marker (not Adobe), length %d',
{ JTRC_DAC } 'Define Arithmetic Table $%02x: $%02x', { JTRC_DAC } 'Define Arithmetic Table $%02x: $%02x',
{ JTRC_DHT } 'Define Huffman Table $%02x', { JTRC_DHT } 'Define Huffman Table $%02x',
{ JTRC_DQT } 'Define Quantization Table %d precision %d', { JTRC_DQT } 'Define Quantization Table %d precision %d',
{ JTRC_DRI } 'Define Restart Interval %d', { JTRC_DRI } 'Define Restart Interval %d',
{ JTRC_EMS_CLOSE } 'Freed EMS handle %d', { JTRC_EMS_CLOSE } 'Freed EMS handle %d',
{ JTRC_EMS_OPEN } 'Obtained EMS handle %d', { JTRC_EMS_OPEN } 'Obtained EMS handle %d',
{ JTRC_EOI } 'End Of Image', { JTRC_EOI } 'End Of Image',
{ JTRC_HUFFBITS } ' %3d %3d %3d %3d %3d %3d %3d %3d', { JTRC_HUFFBITS } ' %3d %3d %3d %3d %3d %3d %3d %3d',
{ JTRC_JFIF } 'JFIF APP0 marker, density %dx%d %d', { JTRC_JFIF } 'JFIF APP0 marker, density %dx%d %d',
{ JTRC_JFIF_BADTHUMBNAILSIZE } { JTRC_JFIF_BADTHUMBNAILSIZE }
'Warning: thumbnail image size does not match data length %d', 'Warning: thumbnail image size does not match data length %d',
{ JTRC_JFIF_EXTENSION } 'JFIF extension marker: type 0x%02x, length %u', { JTRC_JFIF_EXTENSION } 'JFIF extension marker: type 0x%02x, length %u',
{ JTRC_JFIF_THUMBNAIL } ' with %d x %d thumbnail image', { JTRC_JFIF_THUMBNAIL } ' with %d x %d thumbnail image',
{ JTRC_MISC_MARKER } 'Skipping marker $%02x, length %d', { JTRC_MISC_MARKER } 'Skipping marker $%02x, length %d',
{ JTRC_PARMLESS_MARKER } 'Unexpected marker $%02x', { JTRC_PARMLESS_MARKER } 'Unexpected marker $%02x',
{ JTRC_QUANTVALS } ' %4d %4d %4d %4d %4d %4d %4d %4d', { JTRC_QUANTVALS } ' %4d %4d %4d %4d %4d %4d %4d %4d',
{ JTRC_QUANT_3_NCOLORS } 'Quantizing to %d = %d*%d*%d colors', { JTRC_QUANT_3_NCOLORS } 'Quantizing to %d = %d*%d*%d colors',
{ JTRC_QUANT_NCOLORS } 'Quantizing to %d colors', { JTRC_QUANT_NCOLORS } 'Quantizing to %d colors',
{ JTRC_QUANT_SELECTED } 'Selected %d colors for quantization', { JTRC_QUANT_SELECTED } 'Selected %d colors for quantization',
{ JTRC_RECOVERY_ACTION } 'At marker $%02x, recovery action %d', { JTRC_RECOVERY_ACTION } 'At marker $%02x, recovery action %d',
{ JTRC_RST } 'RST%d', { JTRC_RST } 'RST%d',
{ JTRC_SMOOTH_NOTIMPL } { JTRC_SMOOTH_NOTIMPL }
'Smoothing not supported with nonstandard sampling ratios', 'Smoothing not supported with nonstandard sampling ratios',
{ JTRC_SOF } 'Start Of Frame $%02x: width=%d, height=%d, components=%d', { JTRC_SOF } 'Start Of Frame $%02x: width=%d, height=%d, components=%d',
{ JTRC_SOF_COMPONENT } ' Component %d: %dhx%dv q=%d', { JTRC_SOF_COMPONENT } ' Component %d: %dhx%dv q=%d',
{ JTRC_SOI } 'Start of Image', { JTRC_SOI } 'Start of Image',
{ JTRC_SOS } 'Start Of Scan: %d components', { JTRC_SOS } 'Start Of Scan: %d components',
{ JTRC_SOS_COMPONENT } ' Component %d: dc=%d ac=%d', { JTRC_SOS_COMPONENT } ' Component %d: dc=%d ac=%d',
{ JTRC_SOS_PARAMS } ' Ss=%d, Se=%d, Ah=%d, Al=%d', { JTRC_SOS_PARAMS } ' Ss=%d, Se=%d, Ah=%d, Al=%d',
{ JTRC_TFILE_CLOSE } 'Closed temporary file %s', { JTRC_TFILE_CLOSE } 'Closed temporary file %s',
{ JTRC_TFILE_OPEN } 'Opened temporary file %s', { JTRC_TFILE_OPEN } 'Opened temporary file %s',
{ JTRC_THUMB_JPEG } { JTRC_THUMB_JPEG }
'JFIF extension marker: JPEG-compressed thumbnail image, length %u', 'JFIF extension marker: JPEG-compressed thumbnail image, length %u',
{ JMESSAGE(JTRC_THUMB_PALETTE } { JMESSAGE(JTRC_THUMB_PALETTE }
'JFIF extension marker: palette thumbnail image, length %u', 'JFIF extension marker: palette thumbnail image, length %u',
{ JMESSAGE(JTRC_THUMB_RGB } { JMESSAGE(JTRC_THUMB_RGB }
'JFIF extension marker: RGB thumbnail image, length %u', 'JFIF extension marker: RGB thumbnail image, length %u',
{ JTRC_UNKNOWN_IDS } { JTRC_UNKNOWN_IDS }
'Unrecognized component IDs %d %d %d, assuming YCbCr', 'Unrecognized component IDs %d %d %d, assuming YCbCr',
{ JTRC_XMS_CLOSE } 'Freed XMS handle %d', { JTRC_XMS_CLOSE } 'Freed XMS handle %d',
{ JTRC_XMS_OPEN } 'Obtained XMS handle %d', { JTRC_XMS_OPEN } 'Obtained XMS handle %d',
{ JWRN_ADOBE_XFORM } 'Unknown Adobe color transform code %d', { JWRN_ADOBE_XFORM } 'Unknown Adobe color transform code %d',
{ JWRN_BOGUS_PROGRESSION } { JWRN_BOGUS_PROGRESSION }
'Inconsistent progression sequence for component %d coefficient %d', 'Inconsistent progression sequence for component %d coefficient %d',
{ JWRN_EXTRANEOUS_DATA } { JWRN_EXTRANEOUS_DATA }
'Corrupt JPEG data: %d extraneous bytes before marker $%02x', 'Corrupt JPEG data: %d extraneous bytes before marker $%02x',
{ JWRN_HIT_MARKER } 'Corrupt JPEG data: premature end of data segment', { JWRN_HIT_MARKER } 'Corrupt JPEG data: premature end of data segment',
{ JWRN_HUFF_BAD_CODE } 'Corrupt JPEG data: bad Huffman code', { JWRN_HUFF_BAD_CODE } 'Corrupt JPEG data: bad Huffman code',
{ JWRN_JFIF_MAJOR } 'Warning: unknown JFIF revision number %d.%02d', { JWRN_JFIF_MAJOR } 'Warning: unknown JFIF revision number %d.%02d',
{ JWRN_JPEG_EOF } 'Premature end of JPEG file', { JWRN_JPEG_EOF } 'Premature end of JPEG file',
{ JWRN_MUST_RESYNC } { JWRN_MUST_RESYNC }
'Corrupt JPEG data: found marker $%02x instead of RST%d', 'Corrupt JPEG data: found marker $%02x instead of RST%d',
{ JWRN_NOT_SEQUENTIAL } 'Invalid SOS parameters for sequential JPEG', { JWRN_NOT_SEQUENTIAL } 'Invalid SOS parameters for sequential JPEG',
{ JWRN_TOO_MUCH_DATA } 'Application transferred too many scanlines', { JWRN_TOO_MUCH_DATA } 'Application transferred too many scanlines',
{ JMSG_FIRSTADDONCODE } '', { Must be first entry! } { JMSG_FIRSTADDONCODE } '', { Must be first entry! }
{$ifdef BMP_SUPPORTED} {$ifdef BMP_SUPPORTED}
{ JERR_BMP_BADCMAP } 'Unsupported BMP colormap format', { JERR_BMP_BADCMAP } 'Unsupported BMP colormap format',
{ JERR_BMP_BADDEPTH } 'Only 8- and 24-bit BMP files are supported', { JERR_BMP_BADDEPTH } 'Only 8- and 24-bit BMP files are supported',
{ JERR_BMP_BADHEADER } 'Invalid BMP file: bad header length', { JERR_BMP_BADHEADER } 'Invalid BMP file: bad header length',
{ JERR_BMP_BADPLANES } 'Invalid BMP file: biPlanes not equal to 1', { JERR_BMP_BADPLANES } 'Invalid BMP file: biPlanes not equal to 1',
{ JERR_BMP_COLORSPACE } 'BMP output must be grayscale or RGB', { JERR_BMP_COLORSPACE } 'BMP output must be grayscale or RGB',
{ JERR_BMP_COMPRESSED } 'Sorry, compressed BMPs not yet supported', { JERR_BMP_COMPRESSED } 'Sorry, compressed BMPs not yet supported',
{ JERR_BMP_NOT } 'Not a BMP file - does not start with BM', { JERR_BMP_NOT } 'Not a BMP file - does not start with BM',
{ JTRC_BMP } '%dx%d 24-bit BMP image', { JTRC_BMP } '%dx%d 24-bit BMP image',
{ JTRC_BMP_MAPPED } '%dx%d 8-bit colormapped BMP image', { JTRC_BMP_MAPPED } '%dx%d 8-bit colormapped BMP image',
{ JTRC_BMP_OS2 } '%dx%d 24-bit OS2 BMP image', { JTRC_BMP_OS2 } '%dx%d 24-bit OS2 BMP image',
{ JTRC_BMP_OS2_MAPPED } '%dx%d 8-bit colormapped OS2 BMP image', { JTRC_BMP_OS2_MAPPED } '%dx%d 8-bit colormapped OS2 BMP image',
{$endif} { BMP_SUPPORTED } {$endif} { BMP_SUPPORTED }
{$ifdef GIF_SUPPORTED} {$ifdef GIF_SUPPORTED}
{ JERR_GIF_BUG } 'GIF output got confused', { JERR_GIF_BUG } 'GIF output got confused',
{ JERR_GIF_CODESIZE } 'Bogus GIF codesize %d', { JERR_GIF_CODESIZE } 'Bogus GIF codesize %d',
{ JERR_GIF_COLORSPACE } 'GIF output must be grayscale or RGB', { JERR_GIF_COLORSPACE } 'GIF output must be grayscale or RGB',
{ JERR_GIF_IMAGENOTFOUND } 'Too few images in GIF file', { JERR_GIF_IMAGENOTFOUND } 'Too few images in GIF file',
{ JERR_GIF_NOT } 'Not a GIF file', { JERR_GIF_NOT } 'Not a GIF file',
{ JTRC_GIF } '%dx%dx%d GIF image', { JTRC_GIF } '%dx%dx%d GIF image',
{ JTRC_GIF_BADVERSION } { JTRC_GIF_BADVERSION }
'Warning: unexpected GIF version number "%c%c%c"', 'Warning: unexpected GIF version number "%c%c%c"',
{ JTRC_GIF_EXTENSION } 'Ignoring GIF extension block of type 0x%02x', { JTRC_GIF_EXTENSION } 'Ignoring GIF extension block of type 0x%02x',
{ JTRC_GIF_NONSQUARE } 'Caution: nonsquare pixels in input', { JTRC_GIF_NONSQUARE } 'Caution: nonsquare pixels in input',
{ JWRN_GIF_BADDATA } 'Corrupt data in GIF file', { JWRN_GIF_BADDATA } 'Corrupt data in GIF file',
{ JWRN_GIF_CHAR } 'Bogus char 0x%02x in GIF file, ignoring', { JWRN_GIF_CHAR } 'Bogus char 0x%02x in GIF file, ignoring',
{ JWRN_GIF_ENDCODE } 'Premature end of GIF image', { JWRN_GIF_ENDCODE } 'Premature end of GIF image',
{ JWRN_GIF_NOMOREDATA } 'Ran out of GIF bits', { JWRN_GIF_NOMOREDATA } 'Ran out of GIF bits',
{$endif} { GIF_SUPPORTED } {$endif} { GIF_SUPPORTED }
{$ifdef PPM_SUPPORTED} {$ifdef PPM_SUPPORTED}
{ JERR_PPM_COLORSPACE } 'PPM output must be grayscale or RGB', { JERR_PPM_COLORSPACE } 'PPM output must be grayscale or RGB',
{ JERR_PPM_NONNUMERIC } 'Nonnumeric data in PPM file', { JERR_PPM_NONNUMERIC } 'Nonnumeric data in PPM file',
{ JERR_PPM_NOT } 'Not a PPM file', { JERR_PPM_NOT } 'Not a PPM file',
{ JTRC_PGM } '%dx%d PGM image', { JTRC_PGM } '%dx%d PGM image',
{ JTRC_PGM_TEXT } '%dx%d text PGM image', { JTRC_PGM_TEXT } '%dx%d text PGM image',
{ JTRC_PPM } '%dx%d PPM image', { JTRC_PPM } '%dx%d PPM image',
{ JTRC_PPM_TEXT } '%dx%d text PPM image', { JTRC_PPM_TEXT } '%dx%d text PPM image',
{$endif} { PPM_SUPPORTED } {$endif} { PPM_SUPPORTED }
{$ifdef RLE_SUPPORTED} {$ifdef RLE_SUPPORTED}
{ JERR_RLE_BADERROR } 'Bogus error code from RLE library', { JERR_RLE_BADERROR } 'Bogus error code from RLE library',
{ JERR_RLE_COLORSPACE } 'RLE output must be grayscale or RGB', { JERR_RLE_COLORSPACE } 'RLE output must be grayscale or RGB',
{ JERR_RLE_DIMENSIONS } 'Image dimensions (%dx%d) too large for RLE', { JERR_RLE_DIMENSIONS } 'Image dimensions (%dx%d) too large for RLE',
{ JERR_RLE_EMPTY } 'Empty RLE file', { JERR_RLE_EMPTY } 'Empty RLE file',
{ JERR_RLE_EOF } 'Premature EOF in RLE header', { JERR_RLE_EOF } 'Premature EOF in RLE header',
{ JERR_RLE_MEM } 'Insufficient memory for RLE header', { JERR_RLE_MEM } 'Insufficient memory for RLE header',
{ JERR_RLE_NOT } 'Not an RLE file', { JERR_RLE_NOT } 'Not an RLE file',
{ JERR_RLE_TOOMANYCHANNELS } 'Cannot handle %d output channels for RLE', { JERR_RLE_TOOMANYCHANNELS } 'Cannot handle %d output channels for RLE',
{ JERR_RLE_UNSUPPORTED } 'Cannot handle this RLE setup', { JERR_RLE_UNSUPPORTED } 'Cannot handle this RLE setup',
{ JTRC_RLE } '%dx%d full-color RLE file', { JTRC_RLE } '%dx%d full-color RLE file',
{ JTRC_RLE_FULLMAP } '%dx%d full-color RLE file with map of length %d', { JTRC_RLE_FULLMAP } '%dx%d full-color RLE file with map of length %d',
{ JTRC_RLE_GRAY } '%dx%d grayscale RLE file', { JTRC_RLE_GRAY } '%dx%d grayscale RLE file',
{ JTRC_RLE_MAPGRAY } '%dx%d grayscale RLE file with map of length %d', { JTRC_RLE_MAPGRAY } '%dx%d grayscale RLE file with map of length %d',
{ JTRC_RLE_MAPPED } '%dx%d colormapped RLE file with map of length %d', { JTRC_RLE_MAPPED } '%dx%d colormapped RLE file with map of length %d',
{$endif} { RLE_SUPPORTED } {$endif} { RLE_SUPPORTED }
{$ifdef TARGA_SUPPORTED} {$ifdef TARGA_SUPPORTED}
{ JERR_TGA_BADCMAP } 'Unsupported Targa colormap format', { JERR_TGA_BADCMAP } 'Unsupported Targa colormap format',
{ JERR_TGA_BADPARMS } 'Invalid or unsupported Targa file', { JERR_TGA_BADPARMS } 'Invalid or unsupported Targa file',
{ JERR_TGA_COLORSPACE } 'Targa output must be grayscale or RGB', { JERR_TGA_COLORSPACE } 'Targa output must be grayscale or RGB',
{ JTRC_TGA } '%dx%d RGB Targa image', { JTRC_TGA } '%dx%d RGB Targa image',
{ JTRC_TGA_GRAY } '%dx%d grayscale Targa image', { JTRC_TGA_GRAY } '%dx%d grayscale Targa image',
{ JTRC_TGA_MAPPED } '%dx%d colormapped Targa image', { JTRC_TGA_MAPPED } '%dx%d colormapped Targa image',
{$else} {$else}
{ JERR_TGA_NOTCOMP } 'Targa support was not compiled', { JERR_TGA_NOTCOMP } 'Targa support was not compiled',
{$endif} { TARGA_SUPPORTED } {$endif} { TARGA_SUPPORTED }
{ JERR_BAD_CMAP_FILE } { JERR_BAD_CMAP_FILE }
'Color map file is invalid or of unsupported format', 'Color map file is invalid or of unsupported format',
{ JERR_TOO_MANY_COLORS } { JERR_TOO_MANY_COLORS }
'Output file format cannot handle %d colormap entries', 'Output file format cannot handle %d colormap entries',
{ JERR_UNGETC_FAILED } 'ungetc failed', { JERR_UNGETC_FAILED } 'ungetc failed',
{$ifdef TARGA_SUPPORTED} {$ifdef TARGA_SUPPORTED}
{ JERR_UNKNOWN_FORMAT } { JERR_UNKNOWN_FORMAT }
'Unrecognized input file format --- perhaps you need -targa', 'Unrecognized input file format --- perhaps you need -targa',
{$else} {$else}
{ JERR_UNKNOWN_FORMAT } 'Unrecognized input file format', { JERR_UNKNOWN_FORMAT } 'Unrecognized input file format',
{$endif} {$endif}
{ JERR_UNSUPPORTED_FORMAT } 'Unsupported output file format', { JERR_UNSUPPORTED_FORMAT } 'Unsupported output file format',
{ JMSG_LASTADDONCODE } ''); { JMSG_LASTADDONCODE } '');
implementation implementation
end. end.

2409
Imaging/JpegLib/imjdhuff.pas
View File

File diff suppressed because it is too large Load Diff

832
Imaging/JpegLib/imjdinput.pas
View File

@ -1,416 +1,416 @@
unit imjdinput; unit imjdinput;
{ Original: jdinput.c ; Copyright (C) 1991-1997, Thomas G. Lane. } { Original: jdinput.c ; Copyright (C) 1991-1997, Thomas G. Lane. }
{ This file is part of the Independent JPEG Group's software. { This file is part of the Independent JPEG Group's software.
For conditions of distribution and use, see the accompanying README file. For conditions of distribution and use, see the accompanying README file.
This file contains input control logic for the JPEG decompressor. This file contains input control logic for the JPEG decompressor.
These routines are concerned with controlling the decompressor's input These routines are concerned with controlling the decompressor's input
processing (marker reading and coefficient decoding). The actual input processing (marker reading and coefficient decoding). The actual input
reading is done in jdmarker.c, jdhuff.c, and jdphuff.c. } reading is done in jdmarker.c, jdhuff.c, and jdphuff.c. }
interface interface
{$I imjconfig.inc} {$I imjconfig.inc}
uses uses
imjmorecfg, imjmorecfg,
imjpeglib, imjpeglib,
imjdeferr, imjdeferr,
imjerror, imjerror,
imjinclude, imjutils; imjinclude, imjutils;
{ Initialize the input controller module. { Initialize the input controller module.
This is called only once, when the decompression object is created. } This is called only once, when the decompression object is created. }
{GLOBAL} {GLOBAL}
procedure jinit_input_controller (cinfo : j_decompress_ptr); procedure jinit_input_controller (cinfo : j_decompress_ptr);
implementation implementation
{ Private state } { Private state }
type type
my_inputctl_ptr = ^my_input_controller; my_inputctl_ptr = ^my_input_controller;
my_input_controller = record my_input_controller = record
pub : jpeg_input_controller; { public fields } pub : jpeg_input_controller; { public fields }
inheaders : boolean; { TRUE until first SOS is reached } inheaders : boolean; { TRUE until first SOS is reached }
end; {my_input_controller;} end; {my_input_controller;}
{ Forward declarations } { Forward declarations }
{METHODDEF} {METHODDEF}
function consume_markers (cinfo : j_decompress_ptr) : int; forward; function consume_markers (cinfo : j_decompress_ptr) : int; forward;
{ Routines to calculate various quantities related to the size of the image. } { Routines to calculate various quantities related to the size of the image. }
{LOCAL} {LOCAL}
procedure initial_setup (cinfo : j_decompress_ptr); procedure initial_setup (cinfo : j_decompress_ptr);
{ Called once, when first SOS marker is reached } { Called once, when first SOS marker is reached }
var var
ci : int; ci : int;
compptr : jpeg_component_info_ptr; compptr : jpeg_component_info_ptr;
begin begin
{ Make sure image isn't bigger than I can handle } { Make sure image isn't bigger than I can handle }
if (long(cinfo^.image_height) > long (JPEG_MAX_DIMENSION)) or if (long(cinfo^.image_height) > long (JPEG_MAX_DIMENSION)) or
(long(cinfo^.image_width) > long(JPEG_MAX_DIMENSION)) then (long(cinfo^.image_width) > long(JPEG_MAX_DIMENSION)) then
ERREXIT1(j_common_ptr(cinfo), JERR_IMAGE_TOO_BIG, uInt(JPEG_MAX_DIMENSION)); ERREXIT1(j_common_ptr(cinfo), JERR_IMAGE_TOO_BIG, uInt(JPEG_MAX_DIMENSION));
{ For now, precision must match compiled-in value... } { For now, precision must match compiled-in value... }
if (cinfo^.data_precision <> BITS_IN_JSAMPLE) then if (cinfo^.data_precision <> BITS_IN_JSAMPLE) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PRECISION, cinfo^.data_precision); ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PRECISION, cinfo^.data_precision);
{ Check that number of components won't exceed internal array sizes } { Check that number of components won't exceed internal array sizes }
if (cinfo^.num_components > MAX_COMPONENTS) then if (cinfo^.num_components > MAX_COMPONENTS) then
ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, cinfo^.num_components, ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, cinfo^.num_components,
MAX_COMPONENTS); MAX_COMPONENTS);
{ Compute maximum sampling factors; check factor validity } { Compute maximum sampling factors; check factor validity }
cinfo^.max_h_samp_factor := 1; cinfo^.max_h_samp_factor := 1;
cinfo^.max_v_samp_factor := 1; cinfo^.max_v_samp_factor := 1;
compptr := jpeg_component_info_ptr(cinfo^.comp_info); compptr := jpeg_component_info_ptr(cinfo^.comp_info);
for ci := 0 to pred(cinfo^.num_components) do for ci := 0 to pred(cinfo^.num_components) do
begin begin
if (compptr^.h_samp_factor<=0) or (compptr^.h_samp_factor>MAX_SAMP_FACTOR) or if (compptr^.h_samp_factor<=0) or (compptr^.h_samp_factor>MAX_SAMP_FACTOR) or
(compptr^.v_samp_factor<=0) or (compptr^.v_samp_factor>MAX_SAMP_FACTOR) then (compptr^.v_samp_factor<=0) or (compptr^.v_samp_factor>MAX_SAMP_FACTOR) then
ERREXIT(j_common_ptr(cinfo), JERR_BAD_SAMPLING); ERREXIT(j_common_ptr(cinfo), JERR_BAD_SAMPLING);
{cinfo^.max_h_samp_factor := MAX(cinfo^.max_h_samp_factor, {cinfo^.max_h_samp_factor := MAX(cinfo^.max_h_samp_factor,
compptr^.h_samp_factor); compptr^.h_samp_factor);
cinfo^.max_v_samp_factor := MAX(cinfo^.max_v_samp_factor, cinfo^.max_v_samp_factor := MAX(cinfo^.max_v_samp_factor,
compptr^.v_samp_factor);} compptr^.v_samp_factor);}
if cinfo^.max_h_samp_factor < compptr^.h_samp_factor then if cinfo^.max_h_samp_factor < compptr^.h_samp_factor then
cinfo^.max_h_samp_factor := compptr^.h_samp_factor; cinfo^.max_h_samp_factor := compptr^.h_samp_factor;
if cinfo^.max_v_samp_factor < compptr^.v_samp_factor then if cinfo^.max_v_samp_factor < compptr^.v_samp_factor then
cinfo^.max_v_samp_factor := compptr^.v_samp_factor; cinfo^.max_v_samp_factor := compptr^.v_samp_factor;
Inc(compptr); Inc(compptr);
end; end;
{ We initialize DCT_scaled_size and min_DCT_scaled_size to DCTSIZE. { We initialize DCT_scaled_size and min_DCT_scaled_size to DCTSIZE.
In the full decompressor, this will be overridden by jdmaster.c; In the full decompressor, this will be overridden by jdmaster.c;
but in the transcoder, jdmaster.c is not used, so we must do it here. } but in the transcoder, jdmaster.c is not used, so we must do it here. }
cinfo^.min_DCT_scaled_size := DCTSIZE; cinfo^.min_DCT_scaled_size := DCTSIZE;
{ Compute dimensions of components } { Compute dimensions of components }
compptr := jpeg_component_info_ptr(cinfo^.comp_info); compptr := jpeg_component_info_ptr(cinfo^.comp_info);
for ci := 0 to pred(cinfo^.num_components) do for ci := 0 to pred(cinfo^.num_components) do
begin begin
compptr^.DCT_scaled_size := DCTSIZE; compptr^.DCT_scaled_size := DCTSIZE;
{ Size in DCT blocks } { Size in DCT blocks }
compptr^.width_in_blocks := JDIMENSION( compptr^.width_in_blocks := JDIMENSION(
jdiv_round_up( long(cinfo^.image_width) * long(compptr^.h_samp_factor), jdiv_round_up( long(cinfo^.image_width) * long(compptr^.h_samp_factor),
long(cinfo^.max_h_samp_factor * DCTSIZE)) ); long(cinfo^.max_h_samp_factor * DCTSIZE)) );
compptr^.height_in_blocks := JDIMENSION ( compptr^.height_in_blocks := JDIMENSION (
jdiv_round_up(long (cinfo^.image_height) * long(compptr^.v_samp_factor), jdiv_round_up(long (cinfo^.image_height) * long(compptr^.v_samp_factor),
long (cinfo^.max_v_samp_factor * DCTSIZE)) ); long (cinfo^.max_v_samp_factor * DCTSIZE)) );
{ downsampled_width and downsampled_height will also be overridden by { downsampled_width and downsampled_height will also be overridden by
jdmaster.c if we are doing full decompression. The transcoder library jdmaster.c if we are doing full decompression. The transcoder library
doesn't use these values, but the calling application might. } doesn't use these values, but the calling application might. }
{ Size in samples } { Size in samples }
compptr^.downsampled_width := JDIMENSION ( compptr^.downsampled_width := JDIMENSION (
jdiv_round_up(long (cinfo^.image_width) * long(compptr^.h_samp_factor), jdiv_round_up(long (cinfo^.image_width) * long(compptr^.h_samp_factor),
long (cinfo^.max_h_samp_factor)) ); long (cinfo^.max_h_samp_factor)) );
compptr^.downsampled_height := JDIMENSION ( compptr^.downsampled_height := JDIMENSION (
jdiv_round_up(long (cinfo^.image_height) * long(compptr^.v_samp_factor), jdiv_round_up(long (cinfo^.image_height) * long(compptr^.v_samp_factor),
long (cinfo^.max_v_samp_factor)) ); long (cinfo^.max_v_samp_factor)) );
{ Mark component needed, until color conversion says otherwise } { Mark component needed, until color conversion says otherwise }
compptr^.component_needed := TRUE; compptr^.component_needed := TRUE;
{ Mark no quantization table yet saved for component } { Mark no quantization table yet saved for component }
compptr^.quant_table := NIL; compptr^.quant_table := NIL;
Inc(compptr); Inc(compptr);
end; end;
{ Compute number of fully interleaved MCU rows. } { Compute number of fully interleaved MCU rows. }
cinfo^.total_iMCU_rows := JDIMENSION( cinfo^.total_iMCU_rows := JDIMENSION(
jdiv_round_up(long(cinfo^.image_height), jdiv_round_up(long(cinfo^.image_height),
long(cinfo^.max_v_samp_factor*DCTSIZE)) ); long(cinfo^.max_v_samp_factor*DCTSIZE)) );
{ Decide whether file contains multiple scans } { Decide whether file contains multiple scans }
if (cinfo^.comps_in_scan < cinfo^.num_components) or if (cinfo^.comps_in_scan < cinfo^.num_components) or
(cinfo^.progressive_mode) then (cinfo^.progressive_mode) then
cinfo^.inputctl^.has_multiple_scans := TRUE cinfo^.inputctl^.has_multiple_scans := TRUE
else else
cinfo^.inputctl^.has_multiple_scans := FALSE; cinfo^.inputctl^.has_multiple_scans := FALSE;
end; end;
{LOCAL} {LOCAL}
procedure per_scan_setup (cinfo : j_decompress_ptr); procedure per_scan_setup (cinfo : j_decompress_ptr);
{ Do computations that are needed before processing a JPEG scan } { Do computations that are needed before processing a JPEG scan }
{ cinfo^.comps_in_scan and cinfo^.cur_comp_info[] were set from SOS marker } { cinfo^.comps_in_scan and cinfo^.cur_comp_info[] were set from SOS marker }
var var
ci, mcublks, tmp : int; ci, mcublks, tmp : int;
compptr : jpeg_component_info_ptr; compptr : jpeg_component_info_ptr;
begin begin
if (cinfo^.comps_in_scan = 1) then if (cinfo^.comps_in_scan = 1) then
begin begin
{ Noninterleaved (single-component) scan } { Noninterleaved (single-component) scan }
compptr := cinfo^.cur_comp_info[0]; compptr := cinfo^.cur_comp_info[0];
{ Overall image size in MCUs } { Overall image size in MCUs }
cinfo^.MCUs_per_row := compptr^.width_in_blocks; cinfo^.MCUs_per_row := compptr^.width_in_blocks;
cinfo^.MCU_rows_in_scan := compptr^.height_in_blocks; cinfo^.MCU_rows_in_scan := compptr^.height_in_blocks;
{ For noninterleaved scan, always one block per MCU } { For noninterleaved scan, always one block per MCU }
compptr^.MCU_width := 1; compptr^.MCU_width := 1;
compptr^.MCU_height := 1; compptr^.MCU_height := 1;
compptr^.MCU_blocks := 1; compptr^.MCU_blocks := 1;
compptr^.MCU_sample_width := compptr^.DCT_scaled_size; compptr^.MCU_sample_width := compptr^.DCT_scaled_size;
compptr^.last_col_width := 1; compptr^.last_col_width := 1;
{ For noninterleaved scans, it is convenient to define last_row_height { For noninterleaved scans, it is convenient to define last_row_height
as the number of block rows present in the last iMCU row. } as the number of block rows present in the last iMCU row. }
tmp := int (LongInt(compptr^.height_in_blocks) mod compptr^.v_samp_factor); tmp := int (LongInt(compptr^.height_in_blocks) mod compptr^.v_samp_factor);
if (tmp = 0) then if (tmp = 0) then
tmp := compptr^.v_samp_factor; tmp := compptr^.v_samp_factor;
compptr^.last_row_height := tmp; compptr^.last_row_height := tmp;
{ Prepare array describing MCU composition } { Prepare array describing MCU composition }
cinfo^.blocks_in_MCU := 1; cinfo^.blocks_in_MCU := 1;
cinfo^.MCU_membership[0] := 0; cinfo^.MCU_membership[0] := 0;
end end
else else
begin begin
{ Interleaved (multi-component) scan } { Interleaved (multi-component) scan }
if (cinfo^.comps_in_scan <= 0) or (cinfo^.comps_in_scan > MAX_COMPS_IN_SCAN) then if (cinfo^.comps_in_scan <= 0) or (cinfo^.comps_in_scan > MAX_COMPS_IN_SCAN) then
ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, cinfo^.comps_in_scan, ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, cinfo^.comps_in_scan,
MAX_COMPS_IN_SCAN); MAX_COMPS_IN_SCAN);
{ Overall image size in MCUs } { Overall image size in MCUs }
cinfo^.MCUs_per_row := JDIMENSION ( cinfo^.MCUs_per_row := JDIMENSION (
jdiv_round_up(long (cinfo^.image_width), jdiv_round_up(long (cinfo^.image_width),
long (cinfo^.max_h_samp_factor*DCTSIZE)) ); long (cinfo^.max_h_samp_factor*DCTSIZE)) );
cinfo^.MCU_rows_in_scan := JDIMENSION ( cinfo^.MCU_rows_in_scan := JDIMENSION (
jdiv_round_up(long (cinfo^.image_height), jdiv_round_up(long (cinfo^.image_height),
long (cinfo^.max_v_samp_factor*DCTSIZE)) ); long (cinfo^.max_v_samp_factor*DCTSIZE)) );
cinfo^.blocks_in_MCU := 0; cinfo^.blocks_in_MCU := 0;
for ci := 0 to pred(cinfo^.comps_in_scan) do for ci := 0 to pred(cinfo^.comps_in_scan) do
begin begin
compptr := cinfo^.cur_comp_info[ci]; compptr := cinfo^.cur_comp_info[ci];
{ Sampling factors give # of blocks of component in each MCU } { Sampling factors give # of blocks of component in each MCU }
compptr^.MCU_width := compptr^.h_samp_factor; compptr^.MCU_width := compptr^.h_samp_factor;
compptr^.MCU_height := compptr^.v_samp_factor; compptr^.MCU_height := compptr^.v_samp_factor;
compptr^.MCU_blocks := compptr^.MCU_width * compptr^.MCU_height; compptr^.MCU_blocks := compptr^.MCU_width * compptr^.MCU_height;
compptr^.MCU_sample_width := compptr^.MCU_width * compptr^.DCT_scaled_size; compptr^.MCU_sample_width := compptr^.MCU_width * compptr^.DCT_scaled_size;
{ Figure number of non-dummy blocks in last MCU column & row } { Figure number of non-dummy blocks in last MCU column & row }
tmp := int (LongInt(compptr^.width_in_blocks) mod compptr^.MCU_width); tmp := int (LongInt(compptr^.width_in_blocks) mod compptr^.MCU_width);
if (tmp = 0) then if (tmp = 0) then
tmp := compptr^.MCU_width; tmp := compptr^.MCU_width;
compptr^.last_col_width := tmp; compptr^.last_col_width := tmp;
tmp := int (LongInt(compptr^.height_in_blocks) mod compptr^.MCU_height); tmp := int (LongInt(compptr^.height_in_blocks) mod compptr^.MCU_height);
if (tmp = 0) then if (tmp = 0) then
tmp := compptr^.MCU_height; tmp := compptr^.MCU_height;
compptr^.last_row_height := tmp; compptr^.last_row_height := tmp;
{ Prepare array describing MCU composition } { Prepare array describing MCU composition }
mcublks := compptr^.MCU_blocks; mcublks := compptr^.MCU_blocks;
if (LongInt(cinfo^.blocks_in_MCU) + mcublks > D_MAX_BLOCKS_IN_MCU) then if (LongInt(cinfo^.blocks_in_MCU) + mcublks > D_MAX_BLOCKS_IN_MCU) then
ERREXIT(j_common_ptr(cinfo), JERR_BAD_MCU_SIZE); ERREXIT(j_common_ptr(cinfo), JERR_BAD_MCU_SIZE);
while (mcublks > 0) do while (mcublks > 0) do
begin begin
Dec(mcublks); Dec(mcublks);
cinfo^.MCU_membership[cinfo^.blocks_in_MCU] := ci; cinfo^.MCU_membership[cinfo^.blocks_in_MCU] := ci;
Inc(cinfo^.blocks_in_MCU); Inc(cinfo^.blocks_in_MCU);
end; end;
end; end;
end; end;
end; end;
{ Save away a copy of the Q-table referenced by each component present { Save away a copy of the Q-table referenced by each component present
in the current scan, unless already saved during a prior scan. in the current scan, unless already saved during a prior scan.
In a multiple-scan JPEG file, the encoder could assign different components In a multiple-scan JPEG file, the encoder could assign different components
the same Q-table slot number, but change table definitions between scans the same Q-table slot number, but change table definitions between scans
so that each component uses a different Q-table. (The IJG encoder is not so that each component uses a different Q-table. (The IJG encoder is not
currently capable of doing this, but other encoders might.) Since we want currently capable of doing this, but other encoders might.) Since we want
to be able to dequantize all the components at the end of the file, this to be able to dequantize all the components at the end of the file, this
means that we have to save away the table actually used for each component. means that we have to save away the table actually used for each component.
We do this by copying the table at the start of the first scan containing We do this by copying the table at the start of the first scan containing
the component. the component.
The JPEG spec prohibits the encoder from changing the contents of a Q-table The JPEG spec prohibits the encoder from changing the contents of a Q-table
slot between scans of a component using that slot. If the encoder does so slot between scans of a component using that slot. If the encoder does so
anyway, this decoder will simply use the Q-table values that were current anyway, this decoder will simply use the Q-table values that were current
at the start of the first scan for the component. at the start of the first scan for the component.
The decompressor output side looks only at the saved quant tables, The decompressor output side looks only at the saved quant tables,
not at the current Q-table slots. } not at the current Q-table slots. }
{LOCAL} {LOCAL}
procedure latch_quant_tables (cinfo : j_decompress_ptr); procedure latch_quant_tables (cinfo : j_decompress_ptr);
var var
ci, qtblno : int; ci, qtblno : int;
compptr : jpeg_component_info_ptr; compptr : jpeg_component_info_ptr;
qtbl : JQUANT_TBL_PTR; qtbl : JQUANT_TBL_PTR;
begin begin
for ci := 0 to pred(cinfo^.comps_in_scan) do for ci := 0 to pred(cinfo^.comps_in_scan) do
begin begin
compptr := cinfo^.cur_comp_info[ci]; compptr := cinfo^.cur_comp_info[ci];
{ No work if we already saved Q-table for this component } { No work if we already saved Q-table for this component }
if (compptr^.quant_table <> NIL) then if (compptr^.quant_table <> NIL) then
continue; continue;
{ Make sure specified quantization table is present } { Make sure specified quantization table is present }
qtblno := compptr^.quant_tbl_no; qtblno := compptr^.quant_tbl_no;
if (qtblno < 0) or (qtblno >= NUM_QUANT_TBLS) or if (qtblno < 0) or (qtblno >= NUM_QUANT_TBLS) or
(cinfo^.quant_tbl_ptrs[qtblno] = NIL) then (cinfo^.quant_tbl_ptrs[qtblno] = NIL) then
ERREXIT1(j_common_ptr(cinfo), JERR_NO_QUANT_TABLE, qtblno); ERREXIT1(j_common_ptr(cinfo), JERR_NO_QUANT_TABLE, qtblno);
{ OK, save away the quantization table } { OK, save away the quantization table }
qtbl := JQUANT_TBL_PTR( qtbl := JQUANT_TBL_PTR(
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
SIZEOF(JQUANT_TBL)) ); SIZEOF(JQUANT_TBL)) );
MEMCOPY(qtbl, cinfo^.quant_tbl_ptrs[qtblno], SIZEOF(JQUANT_TBL)); MEMCOPY(qtbl, cinfo^.quant_tbl_ptrs[qtblno], SIZEOF(JQUANT_TBL));
compptr^.quant_table := qtbl; compptr^.quant_table := qtbl;
end; end;
end; end;
{ Initialize the input modules to read a scan of compressed data. { Initialize the input modules to read a scan of compressed data.
The first call to this is done by jdmaster.c after initializing The first call to this is done by jdmaster.c after initializing
the entire decompressor (during jpeg_start_decompress). the entire decompressor (during jpeg_start_decompress).
Subsequent calls come from consume_markers, below. } Subsequent calls come from consume_markers, below. }
{METHODDEF} {METHODDEF}
procedure start_input_pass (cinfo : j_decompress_ptr); procedure start_input_pass (cinfo : j_decompress_ptr);
begin begin
per_scan_setup(cinfo); per_scan_setup(cinfo);
latch_quant_tables(cinfo); latch_quant_tables(cinfo);
cinfo^.entropy^.start_pass (cinfo); cinfo^.entropy^.start_pass (cinfo);
cinfo^.coef^.start_input_pass (cinfo); cinfo^.coef^.start_input_pass (cinfo);
cinfo^.inputctl^.consume_input := cinfo^.coef^.consume_data; cinfo^.inputctl^.consume_input := cinfo^.coef^.consume_data;
end; end;
{ Finish up after inputting a compressed-data scan. { Finish up after inputting a compressed-data scan.
This is called by the coefficient controller after it's read all This is called by the coefficient controller after it's read all
the expected data of the scan. } the expected data of the scan. }
{METHODDEF} {METHODDEF}
procedure finish_input_pass (cinfo : j_decompress_ptr); procedure finish_input_pass (cinfo : j_decompress_ptr);
begin begin
cinfo^.inputctl^.consume_input := consume_markers; cinfo^.inputctl^.consume_input := consume_markers;
end; end;
{ Read JPEG markers before, between, or after compressed-data scans. { Read JPEG markers before, between, or after compressed-data scans.
Change state as necessary when a new scan is reached. Change state as necessary when a new scan is reached.
Return value is JPEG_SUSPENDED, JPEG_REACHED_SOS, or JPEG_REACHED_EOI. Return value is JPEG_SUSPENDED, JPEG_REACHED_SOS, or JPEG_REACHED_EOI.
The consume_input method pointer points either here or to the The consume_input method pointer points either here or to the
coefficient controller's consume_data routine, depending on whether coefficient controller's consume_data routine, depending on whether
we are reading a compressed data segment or inter-segment markers. } we are reading a compressed data segment or inter-segment markers. }
{METHODDEF} {METHODDEF}
function consume_markers (cinfo : j_decompress_ptr) : int; function consume_markers (cinfo : j_decompress_ptr) : int;
var var
val : int; val : int;
inputctl : my_inputctl_ptr; inputctl : my_inputctl_ptr;
begin begin
inputctl := my_inputctl_ptr (cinfo^.inputctl); inputctl := my_inputctl_ptr (cinfo^.inputctl);
if (inputctl^.pub.eoi_reached) then { After hitting EOI, read no further } if (inputctl^.pub.eoi_reached) then { After hitting EOI, read no further }
begin begin
consume_markers := JPEG_REACHED_EOI; consume_markers := JPEG_REACHED_EOI;
exit; exit;
end; end;
val := cinfo^.marker^.read_markers (cinfo); val := cinfo^.marker^.read_markers (cinfo);
case (val) of case (val) of
JPEG_REACHED_SOS: { Found SOS } JPEG_REACHED_SOS: { Found SOS }
begin begin
if (inputctl^.inheaders) then if (inputctl^.inheaders) then
begin { 1st SOS } begin { 1st SOS }
initial_setup(cinfo); initial_setup(cinfo);
inputctl^.inheaders := FALSE; inputctl^.inheaders := FALSE;
{ Note: start_input_pass must be called by jdmaster.c { Note: start_input_pass must be called by jdmaster.c
before any more input can be consumed. jdapimin.c is before any more input can be consumed. jdapimin.c is
responsible for enforcing this sequencing. } responsible for enforcing this sequencing. }
end end
else else
begin { 2nd or later SOS marker } begin { 2nd or later SOS marker }
if (not inputctl^.pub.has_multiple_scans) then if (not inputctl^.pub.has_multiple_scans) then
ERREXIT(j_common_ptr(cinfo), JERR_EOI_EXPECTED); { Oops, I wasn't expecting this! } ERREXIT(j_common_ptr(cinfo), JERR_EOI_EXPECTED); { Oops, I wasn't expecting this! }
start_input_pass(cinfo); start_input_pass(cinfo);
end; end;
end; end;
JPEG_REACHED_EOI: { Found EOI } JPEG_REACHED_EOI: { Found EOI }
begin begin
inputctl^.pub.eoi_reached := TRUE; inputctl^.pub.eoi_reached := TRUE;
if (inputctl^.inheaders) then if (inputctl^.inheaders) then
begin { Tables-only datastream, apparently } begin { Tables-only datastream, apparently }
if (cinfo^.marker^.saw_SOF) then if (cinfo^.marker^.saw_SOF) then
ERREXIT(j_common_ptr(cinfo), JERR_SOF_NO_SOS); ERREXIT(j_common_ptr(cinfo), JERR_SOF_NO_SOS);
end end
else else
begin begin
{ Prevent infinite loop in coef ctlr's decompress_data routine { Prevent infinite loop in coef ctlr's decompress_data routine
if user set output_scan_number larger than number of scans. } if user set output_scan_number larger than number of scans. }
if (cinfo^.output_scan_number > cinfo^.input_scan_number) then if (cinfo^.output_scan_number > cinfo^.input_scan_number) then
cinfo^.output_scan_number := cinfo^.input_scan_number; cinfo^.output_scan_number := cinfo^.input_scan_number;
end; end;
end; end;
JPEG_SUSPENDED:; JPEG_SUSPENDED:;
end; end;
consume_markers := val; consume_markers := val;
end; end;
{ Reset state to begin a fresh datastream. } { Reset state to begin a fresh datastream. }
{METHODDEF} {METHODDEF}
procedure reset_input_controller (cinfo : j_decompress_ptr); procedure reset_input_controller (cinfo : j_decompress_ptr);
var var
inputctl : my_inputctl_ptr; inputctl : my_inputctl_ptr;
begin begin
inputctl := my_inputctl_ptr (cinfo^.inputctl); inputctl := my_inputctl_ptr (cinfo^.inputctl);
inputctl^.pub.consume_input := consume_markers; inputctl^.pub.consume_input := consume_markers;
inputctl^.pub.has_multiple_scans := FALSE; { "unknown" would be better } inputctl^.pub.has_multiple_scans := FALSE; { "unknown" would be better }
inputctl^.pub.eoi_reached := FALSE; inputctl^.pub.eoi_reached := FALSE;
inputctl^.inheaders := TRUE; inputctl^.inheaders := TRUE;
{ Reset other modules } { Reset other modules }
cinfo^.err^.reset_error_mgr (j_common_ptr(cinfo)); cinfo^.err^.reset_error_mgr (j_common_ptr(cinfo));
cinfo^.marker^.reset_marker_reader (cinfo); cinfo^.marker^.reset_marker_reader (cinfo);
{ Reset progression state -- would be cleaner if entropy decoder did this } { Reset progression state -- would be cleaner if entropy decoder did this }
cinfo^.coef_bits := NIL; cinfo^.coef_bits := NIL;
end; end;
{ Initialize the input controller module. { Initialize the input controller module.
This is called only once, when the decompression object is created. } This is called only once, when the decompression object is created. }
{GLOBAL} {GLOBAL}
procedure jinit_input_controller (cinfo : j_decompress_ptr); procedure jinit_input_controller (cinfo : j_decompress_ptr);
var var
inputctl : my_inputctl_ptr; inputctl : my_inputctl_ptr;
begin begin
{ Create subobject in permanent pool } { Create subobject in permanent pool }
inputctl := my_inputctl_ptr( inputctl := my_inputctl_ptr(
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_PERMANENT, cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_PERMANENT,
SIZEOF(my_input_controller)) ); SIZEOF(my_input_controller)) );
cinfo^.inputctl := jpeg_input_controller_ptr(inputctl); cinfo^.inputctl := jpeg_input_controller_ptr(inputctl);
{ Initialize method pointers } { Initialize method pointers }
inputctl^.pub.consume_input := consume_markers; inputctl^.pub.consume_input := consume_markers;
inputctl^.pub.reset_input_controller := reset_input_controller; inputctl^.pub.reset_input_controller := reset_input_controller;
inputctl^.pub.start_input_pass := start_input_pass; inputctl^.pub.start_input_pass := start_input_pass;
inputctl^.pub.finish_input_pass := finish_input_pass; inputctl^.pub.finish_input_pass := finish_input_pass;
{ Initialize state: can't use reset_input_controller since we don't { Initialize state: can't use reset_input_controller since we don't
want to try to reset other modules yet. } want to try to reset other modules yet. }
inputctl^.pub.has_multiple_scans := FALSE; { "unknown" would be better } inputctl^.pub.has_multiple_scans := FALSE; { "unknown" would be better }
inputctl^.pub.eoi_reached := FALSE; inputctl^.pub.eoi_reached := FALSE;
inputctl^.inheaders := TRUE; inputctl^.inheaders := TRUE;
end; end;
end. end.

1220
Imaging/JpegLib/imjdmainct.pas
View File

File diff suppressed because it is too large Load Diff

5292
Imaging/JpegLib/imjdmarker.pas
View File

File diff suppressed because it is too large Load Diff

1358
Imaging/JpegLib/imjdmaster.pas
View File

File diff suppressed because it is too large Load Diff

1028
Imaging/JpegLib/imjdmerge.pas
View File

File diff suppressed because it is too large Load Diff

2122
Imaging/JpegLib/imjdphuff.pas
View File

File diff suppressed because it is too large Load Diff

682
Imaging/JpegLib/imjdpostct.pas
View File

@ -1,341 +1,341 @@
unit imjdpostct; unit imjdpostct;
{ Original: jdpostct.c ; Copyright (C) 1994-1996, Thomas G. Lane. } { Original: jdpostct.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
{ This file contains the decompression postprocessing controller. { This file contains the decompression postprocessing controller.
This controller manages the upsampling, color conversion, and color This controller manages the upsampling, color conversion, and color
quantization/reduction steps; specifically, it controls the buffering quantization/reduction steps; specifically, it controls the buffering
between upsample/color conversion and color quantization/reduction. between upsample/color conversion and color quantization/reduction.
If no color quantization/reduction is required, then this module has no If no color quantization/reduction is required, then this module has no
work to do, and it just hands off to the upsample/color conversion code. work to do, and it just hands off to the upsample/color conversion code.
An integrated upsample/convert/quantize process would replace this module An integrated upsample/convert/quantize process would replace this module
entirely. } entirely. }
interface interface
{$I imjconfig.inc} {$I imjconfig.inc}
uses uses
imjmorecfg, imjmorecfg,
imjinclude, imjinclude,
imjdeferr, imjdeferr,
imjerror, imjerror,
imjutils, imjutils,
imjpeglib; imjpeglib;
{ Initialize postprocessing controller. } { Initialize postprocessing controller. }
{GLOBAL} {GLOBAL}
procedure jinit_d_post_controller (cinfo : j_decompress_ptr; procedure jinit_d_post_controller (cinfo : j_decompress_ptr;
need_full_buffer : boolean); need_full_buffer : boolean);
implementation implementation
{ Private buffer controller object } { Private buffer controller object }
type type
my_post_ptr = ^my_post_controller; my_post_ptr = ^my_post_controller;
my_post_controller = record my_post_controller = record
pub : jpeg_d_post_controller; { public fields } pub : jpeg_d_post_controller; { public fields }
{ Color quantization source buffer: this holds output data from { Color quantization source buffer: this holds output data from
the upsample/color conversion step to be passed to the quantizer. the upsample/color conversion step to be passed to the quantizer.
For two-pass color quantization, we need a full-image buffer; For two-pass color quantization, we need a full-image buffer;
for one-pass operation, a strip buffer is sufficient. } for one-pass operation, a strip buffer is sufficient. }
whole_image : jvirt_sarray_ptr; { virtual array, or NIL if one-pass } whole_image : jvirt_sarray_ptr; { virtual array, or NIL if one-pass }
buffer : JSAMPARRAY; { strip buffer, or current strip of virtual } buffer : JSAMPARRAY; { strip buffer, or current strip of virtual }
strip_height : JDIMENSION; { buffer size in rows } strip_height : JDIMENSION; { buffer size in rows }
{ for two-pass mode only: } { for two-pass mode only: }
starting_row : JDIMENSION; { row # of first row in current strip } starting_row : JDIMENSION; { row # of first row in current strip }
next_row : JDIMENSION; { index of next row to fill/empty in strip } next_row : JDIMENSION; { index of next row to fill/empty in strip }
end; end;
{ Forward declarations } { Forward declarations }
{METHODDEF} {METHODDEF}
procedure post_process_1pass(cinfo : j_decompress_ptr; procedure post_process_1pass(cinfo : j_decompress_ptr;
input_buf : JSAMPIMAGE; input_buf : JSAMPIMAGE;
var in_row_group_ctr : JDIMENSION; var in_row_group_ctr : JDIMENSION;
in_row_groups_avail : JDIMENSION; in_row_groups_avail : JDIMENSION;
output_buf : JSAMPARRAY; output_buf : JSAMPARRAY;
var out_row_ctr : JDIMENSION; var out_row_ctr : JDIMENSION;
out_rows_avail : JDIMENSION); forward; out_rows_avail : JDIMENSION); forward;
{$ifdef QUANT_2PASS_SUPPORTED} {$ifdef QUANT_2PASS_SUPPORTED}
{METHODDEF} {METHODDEF}
procedure post_process_prepass(cinfo : j_decompress_ptr; procedure post_process_prepass(cinfo : j_decompress_ptr;
input_buf : JSAMPIMAGE; input_buf : JSAMPIMAGE;
var in_row_group_ctr : JDIMENSION; var in_row_group_ctr : JDIMENSION;
in_row_groups_avail : JDIMENSION; in_row_groups_avail : JDIMENSION;
output_buf : JSAMPARRAY; output_buf : JSAMPARRAY;
var out_row_ctr : JDIMENSION; var out_row_ctr : JDIMENSION;
out_rows_avail : JDIMENSION); forward; out_rows_avail : JDIMENSION); forward;
{METHODDEF} {METHODDEF}
procedure post_process_2pass(cinfo : j_decompress_ptr; procedure post_process_2pass(cinfo : j_decompress_ptr;
input_buf : JSAMPIMAGE; input_buf : JSAMPIMAGE;
var in_row_group_ctr : JDIMENSION; var in_row_group_ctr : JDIMENSION;
in_row_groups_avail : JDIMENSION; in_row_groups_avail : JDIMENSION;
output_buf : JSAMPARRAY; output_buf : JSAMPARRAY;
var out_row_ctr : JDIMENSION; var out_row_ctr : JDIMENSION;
out_rows_avail : JDIMENSION); forward; out_rows_avail : JDIMENSION); forward;
{$endif} {$endif}
{ Initialize for a processing pass. } { Initialize for a processing pass. }
{METHODDEF} {METHODDEF}
procedure start_pass_dpost (cinfo : j_decompress_ptr; procedure start_pass_dpost (cinfo : j_decompress_ptr;
pass_mode : J_BUF_MODE); pass_mode : J_BUF_MODE);
var var
post : my_post_ptr; post : my_post_ptr;
begin begin
post := my_post_ptr(cinfo^.post); post := my_post_ptr(cinfo^.post);
case (pass_mode) of case (pass_mode) of
JBUF_PASS_THRU: JBUF_PASS_THRU:
if (cinfo^.quantize_colors) then if (cinfo^.quantize_colors) then
begin begin
{ Single-pass processing with color quantization. } { Single-pass processing with color quantization. }
post^.pub.post_process_data := post_process_1pass; post^.pub.post_process_data := post_process_1pass;
{ We could be doing buffered-image output before starting a 2-pass { We could be doing buffered-image output before starting a 2-pass
color quantization; in that case, jinit_d_post_controller did not color quantization; in that case, jinit_d_post_controller did not
allocate a strip buffer. Use the virtual-array buffer as workspace. } allocate a strip buffer. Use the virtual-array buffer as workspace. }
if (post^.buffer = NIL) then if (post^.buffer = NIL) then
begin begin
post^.buffer := cinfo^.mem^.access_virt_sarray post^.buffer := cinfo^.mem^.access_virt_sarray
(j_common_ptr(cinfo), post^.whole_image, (j_common_ptr(cinfo), post^.whole_image,
JDIMENSION(0), post^.strip_height, TRUE); JDIMENSION(0), post^.strip_height, TRUE);
end; end;
end end
else else
begin begin
{ For single-pass processing without color quantization, { For single-pass processing without color quantization,
I have no work to do; just call the upsampler directly. } I have no work to do; just call the upsampler directly. }
post^.pub.post_process_data := cinfo^.upsample^.upsample; post^.pub.post_process_data := cinfo^.upsample^.upsample;
end; end;
{$ifdef QUANT_2PASS_SUPPORTED} {$ifdef QUANT_2PASS_SUPPORTED}
JBUF_SAVE_AND_PASS: JBUF_SAVE_AND_PASS:
begin begin
{ First pass of 2-pass quantization } { First pass of 2-pass quantization }
if (post^.whole_image = NIL) then if (post^.whole_image = NIL) then
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
post^.pub.post_process_data := post_process_prepass; post^.pub.post_process_data := post_process_prepass;
end; end;
JBUF_CRANK_DEST: JBUF_CRANK_DEST:
begin begin
{ Second pass of 2-pass quantization } { Second pass of 2-pass quantization }
if (post^.whole_image = NIL) then if (post^.whole_image = NIL) then
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
post^.pub.post_process_data := post_process_2pass; post^.pub.post_process_data := post_process_2pass;
end; end;
{$endif} { QUANT_2PASS_SUPPORTED } {$endif} { QUANT_2PASS_SUPPORTED }
else else
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
end; end;
post^.next_row := 0; post^.next_row := 0;
post^.starting_row := 0; post^.starting_row := 0;
end; end;
{ Process some data in the one-pass (strip buffer) case. { Process some data in the one-pass (strip buffer) case.
This is used for color precision reduction as well as one-pass quantization. } This is used for color precision reduction as well as one-pass quantization. }
{METHODDEF} {METHODDEF}
procedure post_process_1pass (cinfo : j_decompress_ptr; procedure post_process_1pass (cinfo : j_decompress_ptr;
input_buf : JSAMPIMAGE; input_buf : JSAMPIMAGE;
var in_row_group_ctr : JDIMENSION; var in_row_group_ctr : JDIMENSION;
in_row_groups_avail : JDIMENSION; in_row_groups_avail : JDIMENSION;
output_buf : JSAMPARRAY; output_buf : JSAMPARRAY;
var out_row_ctr : JDIMENSION; var out_row_ctr : JDIMENSION;
out_rows_avail : JDIMENSION); out_rows_avail : JDIMENSION);
var var
post : my_post_ptr; post : my_post_ptr;
num_rows, max_rows : JDIMENSION; num_rows, max_rows : JDIMENSION;
begin begin
post := my_post_ptr (cinfo^.post); post := my_post_ptr (cinfo^.post);
{ Fill the buffer, but not more than what we can dump out in one go. } { Fill the buffer, but not more than what we can dump out in one go. }
{ Note we rely on the upsampler to detect bottom of image. } { Note we rely on the upsampler to detect bottom of image. }
max_rows := out_rows_avail - out_row_ctr; max_rows := out_rows_avail - out_row_ctr;
if (max_rows > post^.strip_height) then if (max_rows > post^.strip_height) then
max_rows := post^.strip_height; max_rows := post^.strip_height;
num_rows := 0; num_rows := 0;
cinfo^.upsample^.upsample (cinfo, cinfo^.upsample^.upsample (cinfo,
input_buf, input_buf,
in_row_group_ctr, in_row_group_ctr,
in_row_groups_avail, in_row_groups_avail,
post^.buffer, post^.buffer,
num_rows, { var } num_rows, { var }
max_rows); max_rows);
{ Quantize and emit data. } { Quantize and emit data. }
cinfo^.cquantize^.color_quantize (cinfo, cinfo^.cquantize^.color_quantize (cinfo,
post^.buffer, post^.buffer,
JSAMPARRAY(@ output_buf^[out_row_ctr]), JSAMPARRAY(@ output_buf^[out_row_ctr]),
int(num_rows)); int(num_rows));
Inc(out_row_ctr, num_rows); Inc(out_row_ctr, num_rows);
end; end;
{$ifdef QUANT_2PASS_SUPPORTED} {$ifdef QUANT_2PASS_SUPPORTED}
{ Process some data in the first pass of 2-pass quantization. } { Process some data in the first pass of 2-pass quantization. }
{METHODDEF} {METHODDEF}
procedure post_process_prepass (cinfo : j_decompress_ptr; procedure post_process_prepass (cinfo : j_decompress_ptr;
input_buf : JSAMPIMAGE; input_buf : JSAMPIMAGE;
var in_row_group_ctr : JDIMENSION; var in_row_group_ctr : JDIMENSION;
in_row_groups_avail : JDIMENSION; in_row_groups_avail : JDIMENSION;
output_buf : JSAMPARRAY; output_buf : JSAMPARRAY;
var out_row_ctr : JDIMENSION; var out_row_ctr : JDIMENSION;
out_rows_avail:JDIMENSION); out_rows_avail:JDIMENSION);
var var
post : my_post_ptr; post : my_post_ptr;
old_next_row, num_rows : JDIMENSION; old_next_row, num_rows : JDIMENSION;
begin begin
post := my_post_ptr(cinfo^.post); post := my_post_ptr(cinfo^.post);
{ Reposition virtual buffer if at start of strip. } { Reposition virtual buffer if at start of strip. }
if (post^.next_row = 0) then if (post^.next_row = 0) then
begin begin
post^.buffer := cinfo^.mem^.access_virt_sarray post^.buffer := cinfo^.mem^.access_virt_sarray
(j_common_ptr(cinfo), post^.whole_image, (j_common_ptr(cinfo), post^.whole_image,
post^.starting_row, post^.strip_height, TRUE); post^.starting_row, post^.strip_height, TRUE);
end; end;
{ Upsample some data (up to a strip height's worth). } { Upsample some data (up to a strip height's worth). }
old_next_row := post^.next_row; old_next_row := post^.next_row;
cinfo^.upsample^.upsample (cinfo, cinfo^.upsample^.upsample (cinfo,
input_buf, in_row_group_ctr, in_row_groups_avail, input_buf, in_row_group_ctr, in_row_groups_avail,
post^.buffer, post^.next_row, post^.strip_height); post^.buffer, post^.next_row, post^.strip_height);
{ Allow quantizer to scan new data. No data is emitted, } { Allow quantizer to scan new data. No data is emitted, }
{ but we advance out_row_ctr so outer loop can tell when we're done. } { but we advance out_row_ctr so outer loop can tell when we're done. }
if (post^.next_row > old_next_row) then if (post^.next_row > old_next_row) then
begin begin
num_rows := post^.next_row - old_next_row; num_rows := post^.next_row - old_next_row;
cinfo^.cquantize^.color_quantize (cinfo, cinfo^.cquantize^.color_quantize (cinfo,
JSAMPARRAY(@ post^.buffer^[old_next_row]), JSAMPARRAY(@ post^.buffer^[old_next_row]),
JSAMPARRAY(NIL), JSAMPARRAY(NIL),
int(num_rows)); int(num_rows));
Inc(out_row_ctr, num_rows); Inc(out_row_ctr, num_rows);
end; end;
{ Advance if we filled the strip. } { Advance if we filled the strip. }
if (post^.next_row >= post^.strip_height) then if (post^.next_row >= post^.strip_height) then
begin begin
Inc(post^.starting_row, post^.strip_height); Inc(post^.starting_row, post^.strip_height);
post^.next_row := 0; post^.next_row := 0;
end; end;
end; end;
{ Process some data in the second pass of 2-pass quantization. } { Process some data in the second pass of 2-pass quantization. }
{METHODDEF} {METHODDEF}
procedure post_process_2pass (cinfo : j_decompress_ptr; procedure post_process_2pass (cinfo : j_decompress_ptr;
input_buf : JSAMPIMAGE; input_buf : JSAMPIMAGE;
var in_row_group_ctr : JDIMENSION; var in_row_group_ctr : JDIMENSION;
in_row_groups_avail : JDIMENSION; in_row_groups_avail : JDIMENSION;
output_buf : JSAMPARRAY; output_buf : JSAMPARRAY;
var out_row_ctr : JDIMENSION; var out_row_ctr : JDIMENSION;
out_rows_avail : JDIMENSION); out_rows_avail : JDIMENSION);
var var
post : my_post_ptr; post : my_post_ptr;
num_rows, max_rows : JDIMENSION; num_rows, max_rows : JDIMENSION;
begin begin
post := my_post_ptr(cinfo^.post); post := my_post_ptr(cinfo^.post);
{ Reposition virtual buffer if at start of strip. } { Reposition virtual buffer if at start of strip. }
if (post^.next_row = 0) then if (post^.next_row = 0) then
begin begin
post^.buffer := cinfo^.mem^.access_virt_sarray post^.buffer := cinfo^.mem^.access_virt_sarray
(j_common_ptr(cinfo), post^.whole_image, (j_common_ptr(cinfo), post^.whole_image,
post^.starting_row, post^.strip_height, FALSE); post^.starting_row, post^.strip_height, FALSE);
end; end;
{ Determine number of rows to emit. } { Determine number of rows to emit. }
num_rows := post^.strip_height - post^.next_row; { available in strip } num_rows := post^.strip_height - post^.next_row; { available in strip }
max_rows := out_rows_avail - out_row_ctr; { available in output area } max_rows := out_rows_avail - out_row_ctr; { available in output area }
if (num_rows > max_rows) then if (num_rows > max_rows) then
num_rows := max_rows; num_rows := max_rows;
{ We have to check bottom of image here, can't depend on upsampler. } { We have to check bottom of image here, can't depend on upsampler. }
max_rows := cinfo^.output_height - post^.starting_row; max_rows := cinfo^.output_height - post^.starting_row;
if (num_rows > max_rows) then if (num_rows > max_rows) then
num_rows := max_rows; num_rows := max_rows;
{ Quantize and emit data. } { Quantize and emit data. }
cinfo^.cquantize^.color_quantize (cinfo, cinfo^.cquantize^.color_quantize (cinfo,
JSAMPARRAY(@ post^.buffer^[post^.next_row]), JSAMPARRAY(@ post^.buffer^[post^.next_row]),
JSAMPARRAY(@ output_buf^[out_row_ctr]), JSAMPARRAY(@ output_buf^[out_row_ctr]),
int(num_rows)); int(num_rows));
Inc(out_row_ctr, num_rows); Inc(out_row_ctr, num_rows);
{ Advance if we filled the strip. } { Advance if we filled the strip. }
Inc(post^.next_row, num_rows); Inc(post^.next_row, num_rows);
if (post^.next_row >= post^.strip_height) then if (post^.next_row >= post^.strip_height) then
begin begin
Inc(post^.starting_row, post^.strip_height); Inc(post^.starting_row, post^.strip_height);
post^.next_row := 0; post^.next_row := 0;
end; end;
end; end;
{$endif} { QUANT_2PASS_SUPPORTED } {$endif} { QUANT_2PASS_SUPPORTED }
{ Initialize postprocessing controller. } { Initialize postprocessing controller. }
{GLOBAL} {GLOBAL}
procedure jinit_d_post_controller (cinfo : j_decompress_ptr; procedure jinit_d_post_controller (cinfo : j_decompress_ptr;
need_full_buffer : boolean); need_full_buffer : boolean);
var var
post : my_post_ptr; post : my_post_ptr;
begin begin
post := my_post_ptr( post := my_post_ptr(
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
SIZEOF(my_post_controller)) ); SIZEOF(my_post_controller)) );
cinfo^.post := jpeg_d_post_controller_ptr (post); cinfo^.post := jpeg_d_post_controller_ptr (post);
post^.pub.start_pass := start_pass_dpost; post^.pub.start_pass := start_pass_dpost;
post^.whole_image := NIL; { flag for no virtual arrays } post^.whole_image := NIL; { flag for no virtual arrays }
post^.buffer := NIL; { flag for no strip buffer } post^.buffer := NIL; { flag for no strip buffer }
{ Create the quantization buffer, if needed } { Create the quantization buffer, if needed }
if (cinfo^.quantize_colors) then if (cinfo^.quantize_colors) then
begin begin
{ The buffer strip height is max_v_samp_factor, which is typically { The buffer strip height is max_v_samp_factor, which is typically
an efficient number of rows for upsampling to return. an efficient number of rows for upsampling to return.
(In the presence of output rescaling, we might want to be smarter?) } (In the presence of output rescaling, we might want to be smarter?) }
post^.strip_height := JDIMENSION (cinfo^.max_v_samp_factor); post^.strip_height := JDIMENSION (cinfo^.max_v_samp_factor);
if (need_full_buffer) then if (need_full_buffer) then
begin begin
{ Two-pass color quantization: need full-image storage. } { Two-pass color quantization: need full-image storage. }
{ We round up the number of rows to a multiple of the strip height. } { We round up the number of rows to a multiple of the strip height. }
{$ifdef QUANT_2PASS_SUPPORTED} {$ifdef QUANT_2PASS_SUPPORTED}
post^.whole_image := cinfo^.mem^.request_virt_sarray post^.whole_image := cinfo^.mem^.request_virt_sarray
(j_common_ptr(cinfo), JPOOL_IMAGE, FALSE, (j_common_ptr(cinfo), JPOOL_IMAGE, FALSE,
LongInt(cinfo^.output_width) * cinfo^.out_color_components, LongInt(cinfo^.output_width) * cinfo^.out_color_components,
JDIMENSION (jround_up( long(cinfo^.output_height), JDIMENSION (jround_up( long(cinfo^.output_height),
long(post^.strip_height)) ), long(post^.strip_height)) ),
post^.strip_height); post^.strip_height);
{$else} {$else}
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
{$endif} { QUANT_2PASS_SUPPORTED } {$endif} { QUANT_2PASS_SUPPORTED }
end end
else else
begin begin
{ One-pass color quantization: just make a strip buffer. } { One-pass color quantization: just make a strip buffer. }
post^.buffer := cinfo^.mem^.alloc_sarray post^.buffer := cinfo^.mem^.alloc_sarray
(j_common_ptr (cinfo), JPOOL_IMAGE, (j_common_ptr (cinfo), JPOOL_IMAGE,
LongInt(cinfo^.output_width) * cinfo^.out_color_components, LongInt(cinfo^.output_width) * cinfo^.out_color_components,
post^.strip_height); post^.strip_height);
end; end;
end; end;
end; end;
end. end.

1184
Imaging/JpegLib/imjdsample.pas
View File

File diff suppressed because it is too large Load Diff

924
Imaging/JpegLib/imjerror.pas
View File

@ -1,462 +1,462 @@
unit imjerror; unit imjerror;
{ This file contains simple error-reporting and trace-message routines. { This file contains simple error-reporting and trace-message routines.
These are suitable for Unix-like systems and others where writing to These are suitable for Unix-like systems and others where writing to
stderr is the right thing to do. Many applications will want to replace stderr is the right thing to do. Many applications will want to replace
some or all of these routines. some or all of these routines.
These routines are used by both the compression and decompression code. } These routines are used by both the compression and decompression code. }
{ Source: jerror.c; Copyright (C) 1991-1996, Thomas G. Lane. } { Source: jerror.c; Copyright (C) 1991-1996, Thomas G. Lane. }
{ note: format_message still contains a hack } { note: format_message still contains a hack }
interface interface
{$I imjconfig.inc} {$I imjconfig.inc}
uses uses
imjmorecfg, imjmorecfg,
imjdeferr, imjdeferr,
imjpeglib; imjpeglib;
{ {
jversion; jversion;
} }
const const
EXIT_FAILURE = 1; { define halt() codes if not provided } EXIT_FAILURE = 1; { define halt() codes if not provided }
{GLOBAL} {GLOBAL}
function jpeg_std_error (var err : jpeg_error_mgr) : jpeg_error_mgr_ptr; function jpeg_std_error (var err : jpeg_error_mgr) : jpeg_error_mgr_ptr;
procedure ERREXIT(cinfo : j_common_ptr; code : J_MESSAGE_CODE); procedure ERREXIT(cinfo : j_common_ptr; code : J_MESSAGE_CODE);
procedure ERREXIT1(cinfo : j_common_ptr; code : J_MESSAGE_CODE; p1 : uInt); procedure ERREXIT1(cinfo : j_common_ptr; code : J_MESSAGE_CODE; p1 : uInt);
procedure ERREXIT2(cinfo : j_common_ptr; code : J_MESSAGE_CODE; p1 : int; p2 : int); procedure ERREXIT2(cinfo : j_common_ptr; code : J_MESSAGE_CODE; p1 : int; p2 : int);
procedure ERREXIT3(cinfo : j_common_ptr; code : J_MESSAGE_CODE; procedure ERREXIT3(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int); p1 : int; p2 : int; p3 : int);
procedure ERREXIT4(cinfo : j_common_ptr; code : J_MESSAGE_CODE; procedure ERREXIT4(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int); p1 : int; p2 : int; p3 : int; p4 : int);
procedure ERREXITS(cinfo : j_common_ptr;code : J_MESSAGE_CODE; procedure ERREXITS(cinfo : j_common_ptr;code : J_MESSAGE_CODE;
str : string); str : AnsiString);
{ Nonfatal errors (we can keep going, but the data is probably corrupt) } { Nonfatal errors (we can keep going, but the data is probably corrupt) }
procedure WARNMS(cinfo : j_common_ptr; code : J_MESSAGE_CODE); procedure WARNMS(cinfo : j_common_ptr; code : J_MESSAGE_CODE);
procedure WARNMS1(cinfo : j_common_ptr;code : J_MESSAGE_CODE; p1 : int); procedure WARNMS1(cinfo : j_common_ptr;code : J_MESSAGE_CODE; p1 : int);
procedure WARNMS2(cinfo : j_common_ptr; code : J_MESSAGE_CODE; procedure WARNMS2(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
p1 : int; p2 : int); p1 : int; p2 : int);
{ Informational/debugging messages } { Informational/debugging messages }
procedure TRACEMS(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE); procedure TRACEMS(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE);
procedure TRACEMS1(cinfo : j_common_ptr; lvl : int; procedure TRACEMS1(cinfo : j_common_ptr; lvl : int;
code : J_MESSAGE_CODE; p1 : long); code : J_MESSAGE_CODE; p1 : long);
procedure TRACEMS2(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE; procedure TRACEMS2(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int; p1 : int;
p2 : int); p2 : int);
procedure TRACEMS3(cinfo : j_common_ptr; procedure TRACEMS3(cinfo : j_common_ptr;
lvl : int; lvl : int;
code : J_MESSAGE_CODE; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int); p1 : int; p2 : int; p3 : int);
procedure TRACEMS4(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE; procedure TRACEMS4(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int); p1 : int; p2 : int; p3 : int; p4 : int);
procedure TRACEMS5(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE; procedure TRACEMS5(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int; p5 : int); p1 : int; p2 : int; p3 : int; p4 : int; p5 : int);
procedure TRACEMS8(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE; procedure TRACEMS8(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int; p1 : int; p2 : int; p3 : int; p4 : int;
p5 : int; p6 : int; p7 : int; p8 : int); p5 : int; p6 : int; p7 : int; p8 : int);
procedure TRACEMSS(cinfo : j_common_ptr; lvl : int; procedure TRACEMSS(cinfo : j_common_ptr; lvl : int;
code : J_MESSAGE_CODE; str : string); code : J_MESSAGE_CODE; str : AnsiString);
implementation implementation
{ How to format a message string, in format_message() ? } { How to format a message string, in format_message() ? }
{$IFDEF OS2} {$IFDEF OS2}
{$DEFINE NO_FORMAT} {$DEFINE NO_FORMAT}
{$ENDIF} {$ENDIF}
{$IFDEF FPC} {$IFDEF FPC}
{$DEFINE NO_FORMAT} {$DEFINE NO_FORMAT}
{$ENDIF} {$ENDIF}
uses uses
{$IFNDEF NO_FORMAT} {$IFNDEF NO_FORMAT}
{$IFDEF VER70} {$IFDEF VER70}
drivers, { Turbo Vision unit with FormatStr } drivers, { Turbo Vision unit with FormatStr }
{$ELSE} {$ELSE}
sysutils, { Delphi Unit with Format() } sysutils, { Delphi Unit with Format() }
{$ENDIF} {$ENDIF}
{$ENDIF} {$ENDIF}
imjcomapi; imjcomapi;
{ Error exit handler: must not return to caller. { Error exit handler: must not return to caller.
Applications may override this if they want to get control back after Applications may override this if they want to get control back after
an error. Typically one would longjmp somewhere instead of exiting. an error. Typically one would longjmp somewhere instead of exiting.
The setjmp buffer can be made a private field within an expanded error The setjmp buffer can be made a private field within an expanded error
handler object. Note that the info needed to generate an error message handler object. Note that the info needed to generate an error message
is stored in the error object, so you can generate the message now or is stored in the error object, so you can generate the message now or
later, at your convenience. later, at your convenience.
You should make sure that the JPEG object is cleaned up (with jpeg_abort You should make sure that the JPEG object is cleaned up (with jpeg_abort
or jpeg_destroy) at some point. } or jpeg_destroy) at some point. }
{METHODDEF} {METHODDEF}
procedure error_exit (cinfo : j_common_ptr); procedure error_exit (cinfo : j_common_ptr);
begin begin
{ Always display the message } { Always display the message }
cinfo^.err^.output_message(cinfo); cinfo^.err^.output_message(cinfo);
{ Let the memory manager delete any temp files before we die } { Let the memory manager delete any temp files before we die }
jpeg_destroy(cinfo); jpeg_destroy(cinfo);
halt(EXIT_FAILURE); halt(EXIT_FAILURE);
end; end;
{ Actual output of an error or trace message. { Actual output of an error or trace message.
Applications may override this method to send JPEG messages somewhere Applications may override this method to send JPEG messages somewhere
other than stderr. } other than stderr. }
{ Macros to simplify using the error and trace message stuff } { Macros to simplify using the error and trace message stuff }
{ The first parameter is either type of cinfo pointer } { The first parameter is either type of cinfo pointer }
{ Fatal errors (print message and exit) } { Fatal errors (print message and exit) }
procedure ERREXIT(cinfo : j_common_ptr; code : J_MESSAGE_CODE); procedure ERREXIT(cinfo : j_common_ptr; code : J_MESSAGE_CODE);
begin begin
cinfo^.err^.msg_code := ord(code); cinfo^.err^.msg_code := ord(code);
cinfo^.err^.error_exit(cinfo); cinfo^.err^.error_exit(cinfo);
end; end;
procedure ERREXIT1(cinfo : j_common_ptr; code : J_MESSAGE_CODE; p1 : uInt); procedure ERREXIT1(cinfo : j_common_ptr; code : J_MESSAGE_CODE; p1 : uInt);
begin begin
cinfo^.err^.msg_code := ord(code); cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1; cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.error_exit (cinfo); cinfo^.err^.error_exit (cinfo);
end; end;
procedure ERREXIT2(cinfo : j_common_ptr; code : J_MESSAGE_CODE; procedure ERREXIT2(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
p1 : int; p2 : int); p1 : int; p2 : int);
begin begin
cinfo^.err^.msg_code := ord(code); cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1; cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.msg_parm.i[1] := p2; cinfo^.err^.msg_parm.i[1] := p2;
cinfo^.err^.error_exit (cinfo); cinfo^.err^.error_exit (cinfo);
end; end;
procedure ERREXIT3(cinfo : j_common_ptr; code : J_MESSAGE_CODE; procedure ERREXIT3(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int); p1 : int; p2 : int; p3 : int);
begin begin
cinfo^.err^.msg_code := ord(code); cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1; cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.msg_parm.i[1] := p2; cinfo^.err^.msg_parm.i[1] := p2;
cinfo^.err^.msg_parm.i[2] := p3; cinfo^.err^.msg_parm.i[2] := p3;
cinfo^.err^.error_exit (cinfo); cinfo^.err^.error_exit (cinfo);
end; end;
procedure ERREXIT4(cinfo : j_common_ptr; code : J_MESSAGE_CODE; procedure ERREXIT4(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int); p1 : int; p2 : int; p3 : int; p4 : int);
begin begin
cinfo^.err^.msg_code := ord(code); cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1; cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.msg_parm.i[1] := p2; cinfo^.err^.msg_parm.i[1] := p2;
cinfo^.err^.msg_parm.i[2] := p3; cinfo^.err^.msg_parm.i[2] := p3;
cinfo^.err^.msg_parm.i[3] := p4; cinfo^.err^.msg_parm.i[3] := p4;
cinfo^.err^.error_exit (cinfo); cinfo^.err^.error_exit (cinfo);
end; end;
procedure ERREXITS(cinfo : j_common_ptr;code : J_MESSAGE_CODE; procedure ERREXITS(cinfo : j_common_ptr;code : J_MESSAGE_CODE;
str : string); str : AnsiString);
begin begin
cinfo^.err^.msg_code := ord(code); cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.s := str; { string[JMSG_STR_PARM_MAX] } cinfo^.err^.msg_parm.s := str; { string[JMSG_STR_PARM_MAX] }
cinfo^.err^.error_exit (cinfo); cinfo^.err^.error_exit (cinfo);
end; end;
{ Nonfatal errors (we can keep going, but the data is probably corrupt) } { Nonfatal errors (we can keep going, but the data is probably corrupt) }
procedure WARNMS(cinfo : j_common_ptr; code : J_MESSAGE_CODE); procedure WARNMS(cinfo : j_common_ptr; code : J_MESSAGE_CODE);
begin begin
cinfo^.err^.msg_code := ord(code); cinfo^.err^.msg_code := ord(code);
cinfo^.err^.emit_message(cinfo, -1); cinfo^.err^.emit_message(cinfo, -1);
end; end;
procedure WARNMS1(cinfo : j_common_ptr;code : J_MESSAGE_CODE; p1 : int); procedure WARNMS1(cinfo : j_common_ptr;code : J_MESSAGE_CODE; p1 : int);
begin begin
cinfo^.err^.msg_code := ord(code); cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1; cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.emit_message (cinfo, -1); cinfo^.err^.emit_message (cinfo, -1);
end; end;
procedure WARNMS2(cinfo : j_common_ptr; code : J_MESSAGE_CODE; procedure WARNMS2(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
p1 : int; p2 : int); p1 : int; p2 : int);
begin begin
cinfo^.err^.msg_code := ord(code); cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1; cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.msg_parm.i[1] := p2; cinfo^.err^.msg_parm.i[1] := p2;
cinfo^.err^.emit_message (cinfo, -1); cinfo^.err^.emit_message (cinfo, -1);
end; end;
{ Informational/debugging messages } { Informational/debugging messages }
procedure TRACEMS(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE); procedure TRACEMS(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE);
begin begin
cinfo^.err^.msg_code := ord(code); cinfo^.err^.msg_code := ord(code);
cinfo^.err^.emit_message(cinfo, lvl); cinfo^.err^.emit_message(cinfo, lvl);
end; end;
procedure TRACEMS1(cinfo : j_common_ptr; lvl : int; procedure TRACEMS1(cinfo : j_common_ptr; lvl : int;
code : J_MESSAGE_CODE; p1 : long); code : J_MESSAGE_CODE; p1 : long);
begin begin
cinfo^.err^.msg_code := ord(code); cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1; cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.emit_message (cinfo, lvl); cinfo^.err^.emit_message (cinfo, lvl);
end; end;
procedure TRACEMS2(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE; procedure TRACEMS2(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int; p1 : int;
p2 : int); p2 : int);
begin begin
cinfo^.err^.msg_code := ord(code); cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1; cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.msg_parm.i[1] := p2; cinfo^.err^.msg_parm.i[1] := p2;
cinfo^.err^.emit_message (cinfo, lvl); cinfo^.err^.emit_message (cinfo, lvl);
end; end;
procedure TRACEMS3(cinfo : j_common_ptr; procedure TRACEMS3(cinfo : j_common_ptr;
lvl : int; lvl : int;
code : J_MESSAGE_CODE; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int); p1 : int; p2 : int; p3 : int);
var var
_mp : int8array; _mp : int8array;
begin begin
_mp[0] := p1; _mp[1] := p2; _mp[2] := p3; _mp[0] := p1; _mp[1] := p2; _mp[2] := p3;
cinfo^.err^.msg_parm.i := _mp; cinfo^.err^.msg_parm.i := _mp;
cinfo^.err^.msg_code := ord(code); cinfo^.err^.msg_code := ord(code);
cinfo^.err^.emit_message (cinfo, lvl); cinfo^.err^.emit_message (cinfo, lvl);
end; end;
procedure TRACEMS4(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE; procedure TRACEMS4(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int); p1 : int; p2 : int; p3 : int; p4 : int);
var var
_mp : int8array; _mp : int8array;
begin begin
_mp[0] := p1; _mp[1] := p2; _mp[2] := p3; _mp[3] := p4; _mp[0] := p1; _mp[1] := p2; _mp[2] := p3; _mp[3] := p4;
cinfo^.err^.msg_parm.i := _mp; cinfo^.err^.msg_parm.i := _mp;
cinfo^.err^.msg_code := ord(code); cinfo^.err^.msg_code := ord(code);
cinfo^.err^.emit_message (cinfo, lvl); cinfo^.err^.emit_message (cinfo, lvl);
end; end;
procedure TRACEMS5(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE; procedure TRACEMS5(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int; p5 : int); p1 : int; p2 : int; p3 : int; p4 : int; p5 : int);
var var
_mp : ^int8array; _mp : ^int8array;
begin begin
_mp := @cinfo^.err^.msg_parm.i; _mp := @cinfo^.err^.msg_parm.i;
_mp^[0] := p1; _mp^[1] := p2; _mp^[2] := p3; _mp^[0] := p1; _mp^[1] := p2; _mp^[2] := p3;
_mp^[3] := p4; _mp^[5] := p5; _mp^[3] := p4; _mp^[5] := p5;
cinfo^.err^.msg_code := ord(code); cinfo^.err^.msg_code := ord(code);
cinfo^.err^.emit_message (cinfo, lvl); cinfo^.err^.emit_message (cinfo, lvl);
end; end;
procedure TRACEMS8(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE; procedure TRACEMS8(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int; p1 : int; p2 : int; p3 : int; p4 : int;
p5 : int; p6 : int; p7 : int; p8 : int); p5 : int; p6 : int; p7 : int; p8 : int);
var var
_mp : int8array; _mp : int8array;
begin begin
_mp[0] := p1; _mp[1] := p2; _mp[2] := p3; _mp[3] := p4; _mp[0] := p1; _mp[1] := p2; _mp[2] := p3; _mp[3] := p4;
_mp[4] := p5; _mp[5] := p6; _mp[6] := p7; _mp[7] := p8; _mp[4] := p5; _mp[5] := p6; _mp[6] := p7; _mp[7] := p8;
cinfo^.err^.msg_parm.i := _mp; cinfo^.err^.msg_parm.i := _mp;
cinfo^.err^.msg_code := ord(code); cinfo^.err^.msg_code := ord(code);
cinfo^.err^.emit_message (cinfo, lvl); cinfo^.err^.emit_message (cinfo, lvl);
end; end;
procedure TRACEMSS(cinfo : j_common_ptr; lvl : int; procedure TRACEMSS(cinfo : j_common_ptr; lvl : int;
code : J_MESSAGE_CODE; str : string); code : J_MESSAGE_CODE; str : AnsiString);
begin begin
cinfo^.err^.msg_code := ord(code); cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.s := str; { string JMSG_STR_PARM_MAX } cinfo^.err^.msg_parm.s := str; { string JMSG_STR_PARM_MAX }
cinfo^.err^.emit_message (cinfo, lvl); cinfo^.err^.emit_message (cinfo, lvl);
end; end;
{METHODDEF} {METHODDEF}
procedure output_message (cinfo : j_common_ptr); procedure output_message (cinfo : j_common_ptr);
var var
buffer : string; {[JMSG_LENGTH_MAX];} buffer : AnsiString; {[JMSG_LENGTH_MAX];}
begin begin
{ Create the message } { Create the message }
cinfo^.err^.format_message (cinfo, buffer); cinfo^.err^.format_message (cinfo, buffer);
{ Send it to stderr, adding a newline } { Send it to stderr, adding a newline }
WriteLn(output, buffer); WriteLn(output, buffer);
end; end;
{ Decide whether to emit a trace or warning message. { Decide whether to emit a trace or warning message.
msg_level is one of: msg_level is one of:
-1: recoverable corrupt-data warning, may want to abort. -1: recoverable corrupt-data warning, may want to abort.
0: important advisory messages (always display to user). 0: important advisory messages (always display to user).
1: first level of tracing detail. 1: first level of tracing detail.
2,3,...: successively more detailed tracing messages. 2,3,...: successively more detailed tracing messages.
An application might override this method if it wanted to abort on warnings An application might override this method if it wanted to abort on warnings
or change the policy about which messages to display. } or change the policy about which messages to display. }
{METHODDEF} {METHODDEF}
procedure emit_message (cinfo : j_common_ptr; msg_level : int); procedure emit_message (cinfo : j_common_ptr; msg_level : int);
var var
err : jpeg_error_mgr_ptr; err : jpeg_error_mgr_ptr;
begin begin
err := cinfo^.err; err := cinfo^.err;
if (msg_level < 0) then if (msg_level < 0) then
begin begin
{ It's a warning message. Since corrupt files may generate many warnings, { It's a warning message. Since corrupt files may generate many warnings,
the policy implemented here is to show only the first warning, the policy implemented here is to show only the first warning,
unless trace_level >= 3. } unless trace_level >= 3. }
if (err^.num_warnings = 0) or (err^.trace_level >= 3) then if (err^.num_warnings = 0) or (err^.trace_level >= 3) then
err^.output_message(cinfo); err^.output_message(cinfo);
{ Always count warnings in num_warnings. } { Always count warnings in num_warnings. }
Inc( err^.num_warnings ); Inc( err^.num_warnings );
end end
else else
begin begin
{ It's a trace message. Show it if trace_level >= msg_level. } { It's a trace message. Show it if trace_level >= msg_level. }
if (err^.trace_level >= msg_level) then if (err^.trace_level >= msg_level) then
err^.output_message (cinfo); err^.output_message (cinfo);
end; end;
end; end;
{ Format a message string for the most recent JPEG error or message. { Format a message string for the most recent JPEG error or message.
The message is stored into buffer, which should be at least JMSG_LENGTH_MAX The message is stored into buffer, which should be at least JMSG_LENGTH_MAX
characters. Note that no '\n' character is added to the string. characters. Note that no '\n' character is added to the string.
Few applications should need to override this method. } Few applications should need to override this method. }
{METHODDEF} {METHODDEF}
procedure format_message (cinfo : j_common_ptr; var buffer : string); procedure format_message (cinfo : j_common_ptr; var buffer : AnsiString);
var var
err : jpeg_error_mgr_ptr; err : jpeg_error_mgr_ptr;
msg_code : J_MESSAGE_CODE; msg_code : J_MESSAGE_CODE;
msgtext : string; msgtext : AnsiString;
isstring : boolean; isstring : boolean;
begin begin
err := cinfo^.err; err := cinfo^.err;
msg_code := J_MESSAGE_CODE(err^.msg_code); msg_code := J_MESSAGE_CODE(err^.msg_code);
msgtext := ''; msgtext := '';
{ Look up message string in proper table } { Look up message string in proper table }
if (msg_code > JMSG_NOMESSAGE) if (msg_code > JMSG_NOMESSAGE)
and (msg_code <= J_MESSAGE_CODE(err^.last_jpeg_message)) then and (msg_code <= J_MESSAGE_CODE(err^.last_jpeg_message)) then
begin begin
msgtext := err^.jpeg_message_table^[msg_code]; msgtext := err^.jpeg_message_table^[msg_code];
end end
else else
if (err^.addon_message_table <> NIL) and if (err^.addon_message_table <> NIL) and
(msg_code >= err^.first_addon_message) and (msg_code >= err^.first_addon_message) and
(msg_code <= err^.last_addon_message) then (msg_code <= err^.last_addon_message) then
begin begin
msgtext := err^.addon_message_table^[J_MESSAGE_CODE msgtext := err^.addon_message_table^[J_MESSAGE_CODE
(ord(msg_code) - ord(err^.first_addon_message))]; (ord(msg_code) - ord(err^.first_addon_message))];
end; end;
{ Defend against bogus message number } { Defend against bogus message number }
if (msgtext = '') then if (msgtext = '') then
begin begin
err^.msg_parm.i[0] := int(msg_code); err^.msg_parm.i[0] := int(msg_code);
msgtext := err^.jpeg_message_table^[JMSG_NOMESSAGE]; msgtext := err^.jpeg_message_table^[JMSG_NOMESSAGE];
end; end;
{ Check for string parameter, as indicated by %s in the message text } { Check for string parameter, as indicated by %s in the message text }
isstring := Pos('%s', msgtext) > 0; isstring := Pos('%s', msgtext) > 0;
{ Format the message into the passed buffer } { Format the message into the passed buffer }
if (isstring) then if (isstring) then
buffer := Concat(msgtext, err^.msg_parm.s) buffer := Concat(msgtext, err^.msg_parm.s)
else else
begin begin
{$IFDEF VER70} {$IFDEF VER70}
FormatStr(buffer, msgtext, err^.msg_parm.i); FormatStr(buffer, msgtext, err^.msg_parm.i);
{$ELSE} {$ELSE}
{$IFDEF NO_FORMAT} {$IFDEF NO_FORMAT}
buffer := msgtext; buffer := msgtext;
{$ELSE} {$ELSE}
buffer := Format(msgtext, [ buffer := Format(msgtext, [
err^.msg_parm.i[0], err^.msg_parm.i[1], err^.msg_parm.i[0], err^.msg_parm.i[1],
err^.msg_parm.i[2], err^.msg_parm.i[3], err^.msg_parm.i[2], err^.msg_parm.i[3],
err^.msg_parm.i[4], err^.msg_parm.i[5], err^.msg_parm.i[4], err^.msg_parm.i[5],
err^.msg_parm.i[6], err^.msg_parm.i[7] ]); err^.msg_parm.i[6], err^.msg_parm.i[7] ]);
{$ENDIF} {$ENDIF}
{$ENDIF} {$ENDIF}
end; end;
end; end;
{ Reset error state variables at start of a new image. { Reset error state variables at start of a new image.
This is called during compression startup to reset trace/error This is called during compression startup to reset trace/error
processing to default state, without losing any application-specific processing to default state, without losing any application-specific
method pointers. An application might possibly want to override method pointers. An application might possibly want to override
this method if it has additional error processing state. } this method if it has additional error processing state. }
{METHODDEF} {METHODDEF}
procedure reset_error_mgr (cinfo : j_common_ptr); procedure reset_error_mgr (cinfo : j_common_ptr);
begin begin
cinfo^.err^.num_warnings := 0; cinfo^.err^.num_warnings := 0;
{ trace_level is not reset since it is an application-supplied parameter } { trace_level is not reset since it is an application-supplied parameter }
cinfo^.err^.msg_code := 0; { may be useful as a flag for "no error" } cinfo^.err^.msg_code := 0; { may be useful as a flag for "no error" }
end; end;
{ Fill in the standard error-handling methods in a jpeg_error_mgr object. { Fill in the standard error-handling methods in a jpeg_error_mgr object.
Typical call is: Typical call is:
cinfo : jpeg_compress_struct; cinfo : jpeg_compress_struct;
err : jpeg_error_mgr; err : jpeg_error_mgr;
cinfo.err := jpeg_std_error(@err); cinfo.err := jpeg_std_error(@err);
after which the application may override some of the methods. } after which the application may override some of the methods. }
{GLOBAL} {GLOBAL}
function jpeg_std_error (var err : jpeg_error_mgr) : jpeg_error_mgr_ptr; function jpeg_std_error (var err : jpeg_error_mgr) : jpeg_error_mgr_ptr;
begin begin
err.error_exit := error_exit; err.error_exit := error_exit;
err.emit_message := emit_message; err.emit_message := emit_message;
err.output_message := output_message; err.output_message := output_message;
err.format_message := format_message; err.format_message := format_message;
err.reset_error_mgr := reset_error_mgr; err.reset_error_mgr := reset_error_mgr;
err.trace_level := 0; { default := no tracing } err.trace_level := 0; { default := no tracing }
err.num_warnings := 0; { no warnings emitted yet } err.num_warnings := 0; { no warnings emitted yet }
err.msg_code := 0; { may be useful as a flag for "no error" } err.msg_code := 0; { may be useful as a flag for "no error" }
{ Initialize message table pointers } { Initialize message table pointers }
err.jpeg_message_table := @jpeg_std_message_table; err.jpeg_message_table := @jpeg_std_message_table;
err.last_jpeg_message := pred(JMSG_LASTMSGCODE); err.last_jpeg_message := pred(JMSG_LASTMSGCODE);
err.addon_message_table := NIL; err.addon_message_table := NIL;
err.first_addon_message := JMSG_NOMESSAGE; { for safety } err.first_addon_message := JMSG_NOMESSAGE; { for safety }
err.last_addon_message := JMSG_NOMESSAGE; err.last_addon_message := JMSG_NOMESSAGE;
jpeg_std_error := @err; jpeg_std_error := @err;
end; end;
end. end.

351
Imaging/JpegLib/imjfdctflt.pas
View File

@ -1,176 +1,175 @@
unit imjfdctflt; unit imjfdctflt;
{$N+} { This file contains a floating-point implementation of the
{ This file contains a floating-point implementation of the forward DCT (Discrete Cosine Transform).
forward DCT (Discrete Cosine Transform).
This implementation should be more accurate than either of the integer
This implementation should be more accurate than either of the integer DCT implementations. However, it may not give the same results on all
DCT implementations. However, it may not give the same results on all machines because of differences in roundoff behavior. Speed will depend
machines because of differences in roundoff behavior. Speed will depend on the hardware's floating point capacity.
on the hardware's floating point capacity.
A 2-D DCT can be done by 1-D DCT on each row followed by 1-D DCT
A 2-D DCT can be done by 1-D DCT on each row followed by 1-D DCT on each column. Direct algorithms are also available, but they are
on each column. Direct algorithms are also available, but they are much more complex and seem not to be any faster when reduced to code.
much more complex and seem not to be any faster when reduced to code.
This implementation is based on Arai, Agui, and Nakajima's algorithm for
This implementation is based on Arai, Agui, and Nakajima's algorithm for scaled DCT. Their original paper (Trans. IEICE E-71(11):1095) is in
scaled DCT. Their original paper (Trans. IEICE E-71(11):1095) is in Japanese, but the algorithm is described in the Pennebaker & Mitchell
Japanese, but the algorithm is described in the Pennebaker & Mitchell JPEG textbook (see REFERENCES section in file README). The following code
JPEG textbook (see REFERENCES section in file README). The following code is based directly on figure 4-8 in P&M.
is based directly on figure 4-8 in P&M. While an 8-point DCT cannot be done in less than 11 multiplies, it is
While an 8-point DCT cannot be done in less than 11 multiplies, it is possible to arrange the computation so that many of the multiplies are
possible to arrange the computation so that many of the multiplies are simple scalings of the final outputs. These multiplies can then be
simple scalings of the final outputs. These multiplies can then be folded into the multiplications or divisions by the JPEG quantization
folded into the multiplications or divisions by the JPEG quantization table entries. The AA&N method leaves only 5 multiplies and 29 adds
table entries. The AA&N method leaves only 5 multiplies and 29 adds to be done in the DCT itself.
to be done in the DCT itself. The primary disadvantage of this method is that with a fixed-point
The primary disadvantage of this method is that with a fixed-point implementation, accuracy is lost due to imprecise representation of the
implementation, accuracy is lost due to imprecise representation of the scaled quantization values. However, that problem does not arise if
scaled quantization values. However, that problem does not arise if we use floating point arithmetic. }
we use floating point arithmetic. }
{ Original : jfdctflt.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
{ Original : jfdctflt.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
interface
interface
{$I imjconfig.inc}
{$I imjconfig.inc}
uses
uses imjmorecfg,
imjmorecfg, imjinclude,
imjinclude, imjpeglib,
imjpeglib, imjdct; { Private declarations for DCT subsystem }
imjdct; { Private declarations for DCT subsystem }
{ Perform the forward DCT on one block of samples.}
{ Perform the forward DCT on one block of samples.}
{GLOBAL}
{GLOBAL} procedure jpeg_fdct_float (var data : array of FAST_FLOAT);
procedure jpeg_fdct_float (var data : array of FAST_FLOAT);
implementation
implementation
{ This module is specialized to the case DCTSIZE = 8. }
{ This module is specialized to the case DCTSIZE = 8. }
{$ifndef DCTSIZE_IS_8}
{$ifndef DCTSIZE_IS_8} Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err }
Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err } {$endif}
{$endif}
{ Perform the forward DCT on one block of samples.}
{ Perform the forward DCT on one block of samples.}
{GLOBAL}
{GLOBAL} procedure jpeg_fdct_float (var data : array of FAST_FLOAT);
procedure jpeg_fdct_float (var data : array of FAST_FLOAT); type
type PWorkspace = ^TWorkspace;
PWorkspace = ^TWorkspace; TWorkspace = array [0..DCTSIZE2-1] of FAST_FLOAT;
TWorkspace = array [0..DCTSIZE2-1] of FAST_FLOAT; var
var tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7 : FAST_FLOAT;
tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7 : FAST_FLOAT; tmp10, tmp11, tmp12, tmp13 : FAST_FLOAT;
tmp10, tmp11, tmp12, tmp13 : FAST_FLOAT; z1, z2, z3, z4, z5, z11, z13 : FAST_FLOAT;
z1, z2, z3, z4, z5, z11, z13 : FAST_FLOAT; dataptr : PWorkspace;
dataptr : PWorkspace; ctr : int;
ctr : int; begin
begin { Pass 1: process rows. }
{ Pass 1: process rows. }
dataptr := PWorkspace(@data);
dataptr := PWorkspace(@data); for ctr := DCTSIZE-1 downto 0 do
for ctr := DCTSIZE-1 downto 0 do begin
begin tmp0 := dataptr^[0] + dataptr^[7];
tmp0 := dataptr^[0] + dataptr^[7]; tmp7 := dataptr^[0] - dataptr^[7];
tmp7 := dataptr^[0] - dataptr^[7]; tmp1 := dataptr^[1] + dataptr^[6];
tmp1 := dataptr^[1] + dataptr^[6]; tmp6 := dataptr^[1] - dataptr^[6];
tmp6 := dataptr^[1] - dataptr^[6]; tmp2 := dataptr^[2] + dataptr^[5];
tmp2 := dataptr^[2] + dataptr^[5]; tmp5 := dataptr^[2] - dataptr^[5];
tmp5 := dataptr^[2] - dataptr^[5]; tmp3 := dataptr^[3] + dataptr^[4];
tmp3 := dataptr^[3] + dataptr^[4]; tmp4 := dataptr^[3] - dataptr^[4];
tmp4 := dataptr^[3] - dataptr^[4];
{ Even part }
{ Even part }
tmp10 := tmp0 + tmp3; { phase 2 }
tmp10 := tmp0 + tmp3; { phase 2 } tmp13 := tmp0 - tmp3;
tmp13 := tmp0 - tmp3; tmp11 := tmp1 + tmp2;
tmp11 := tmp1 + tmp2; tmp12 := tmp1 - tmp2;
tmp12 := tmp1 - tmp2;
dataptr^[0] := tmp10 + tmp11; { phase 3 }
dataptr^[0] := tmp10 + tmp11; { phase 3 } dataptr^[4] := tmp10 - tmp11;
dataptr^[4] := tmp10 - tmp11;
z1 := (tmp12 + tmp13) * ({FAST_FLOAT}(0.707106781)); { c4 }
z1 := (tmp12 + tmp13) * ({FAST_FLOAT}(0.707106781)); { c4 } dataptr^[2] := tmp13 + z1; { phase 5 }
dataptr^[2] := tmp13 + z1; { phase 5 } dataptr^[6] := tmp13 - z1;
dataptr^[6] := tmp13 - z1;
{ Odd part }
{ Odd part }
tmp10 := tmp4 + tmp5; { phase 2 }
tmp10 := tmp4 + tmp5; { phase 2 } tmp11 := tmp5 + tmp6;
tmp11 := tmp5 + tmp6; tmp12 := tmp6 + tmp7;
tmp12 := tmp6 + tmp7;
{ The rotator is modified from fig 4-8 to avoid extra negations. }
{ The rotator is modified from fig 4-8 to avoid extra negations. } z5 := (tmp10 - tmp12) * ( {FAST_FLOAT}(0.382683433)); { c6 }
z5 := (tmp10 - tmp12) * ( {FAST_FLOAT}(0.382683433)); { c6 } z2 := {FAST_FLOAT}(0.541196100) * tmp10 + z5; { c2-c6 }
z2 := {FAST_FLOAT}(0.541196100) * tmp10 + z5; { c2-c6 } z4 := {FAST_FLOAT}(1.306562965) * tmp12 + z5; { c2+c6 }
z4 := {FAST_FLOAT}(1.306562965) * tmp12 + z5; { c2+c6 } z3 := tmp11 * {FAST_FLOAT} (0.707106781); { c4 }
z3 := tmp11 * {FAST_FLOAT} (0.707106781); { c4 }
z11 := tmp7 + z3; { phase 5 }
z11 := tmp7 + z3; { phase 5 } z13 := tmp7 - z3;
z13 := tmp7 - z3;
dataptr^[5] := z13 + z2; { phase 6 }
dataptr^[5] := z13 + z2; { phase 6 } dataptr^[3] := z13 - z2;
dataptr^[3] := z13 - z2; dataptr^[1] := z11 + z4;
dataptr^[1] := z11 + z4; dataptr^[7] := z11 - z4;
dataptr^[7] := z11 - z4;
Inc(FAST_FLOAT_PTR(dataptr), DCTSIZE); { advance pointer to next row }
Inc(FAST_FLOAT_PTR(dataptr), DCTSIZE); { advance pointer to next row } end;
end;
{ Pass 2: process columns. }
{ Pass 2: process columns. }
dataptr := PWorkspace(@data);
dataptr := PWorkspace(@data); for ctr := DCTSIZE-1 downto 0 do
for ctr := DCTSIZE-1 downto 0 do begin
begin tmp0 := dataptr^[DCTSIZE*0] + dataptr^[DCTSIZE*7];
tmp0 := dataptr^[DCTSIZE*0] + dataptr^[DCTSIZE*7]; tmp7 := dataptr^[DCTSIZE*0] - dataptr^[DCTSIZE*7];
tmp7 := dataptr^[DCTSIZE*0] - dataptr^[DCTSIZE*7]; tmp1 := dataptr^[DCTSIZE*1] + dataptr^[DCTSIZE*6];
tmp1 := dataptr^[DCTSIZE*1] + dataptr^[DCTSIZE*6]; tmp6 := dataptr^[DCTSIZE*1] - dataptr^[DCTSIZE*6];
tmp6 := dataptr^[DCTSIZE*1] - dataptr^[DCTSIZE*6]; tmp2 := dataptr^[DCTSIZE*2] + dataptr^[DCTSIZE*5];
tmp2 := dataptr^[DCTSIZE*2] + dataptr^[DCTSIZE*5]; tmp5 := dataptr^[DCTSIZE*2] - dataptr^[DCTSIZE*5];
tmp5 := dataptr^[DCTSIZE*2] - dataptr^[DCTSIZE*5]; tmp3 := dataptr^[DCTSIZE*3] + dataptr^[DCTSIZE*4];
tmp3 := dataptr^[DCTSIZE*3] + dataptr^[DCTSIZE*4]; tmp4 := dataptr^[DCTSIZE*3] - dataptr^[DCTSIZE*4];
tmp4 := dataptr^[DCTSIZE*3] - dataptr^[DCTSIZE*4];
{ Even part }
{ Even part }
tmp10 := tmp0 + tmp3; { phase 2 }
tmp10 := tmp0 + tmp3; { phase 2 } tmp13 := tmp0 - tmp3;
tmp13 := tmp0 - tmp3; tmp11 := tmp1 + tmp2;
tmp11 := tmp1 + tmp2; tmp12 := tmp1 - tmp2;
tmp12 := tmp1 - tmp2;
dataptr^[DCTSIZE*0] := tmp10 + tmp11; { phase 3 }
dataptr^[DCTSIZE*0] := tmp10 + tmp11; { phase 3 } dataptr^[DCTSIZE*4] := tmp10 - tmp11;
dataptr^[DCTSIZE*4] := tmp10 - tmp11;
z1 := (tmp12 + tmp13) * {FAST_FLOAT} (0.707106781); { c4 }
z1 := (tmp12 + tmp13) * {FAST_FLOAT} (0.707106781); { c4 } dataptr^[DCTSIZE*2] := tmp13 + z1; { phase 5 }
dataptr^[DCTSIZE*2] := tmp13 + z1; { phase 5 } dataptr^[DCTSIZE*6] := tmp13 - z1;
dataptr^[DCTSIZE*6] := tmp13 - z1;
{ Odd part }
{ Odd part }
tmp10 := tmp4 + tmp5; { phase 2 }
tmp10 := tmp4 + tmp5; { phase 2 } tmp11 := tmp5 + tmp6;
tmp11 := tmp5 + tmp6; tmp12 := tmp6 + tmp7;
tmp12 := tmp6 + tmp7;
{ The rotator is modified from fig 4-8 to avoid extra negations. }
{ The rotator is modified from fig 4-8 to avoid extra negations. } z5 := (tmp10 - tmp12) * {FAST_FLOAT} (0.382683433); { c6 }
z5 := (tmp10 - tmp12) * {FAST_FLOAT} (0.382683433); { c6 } z2 := {FAST_FLOAT} (0.541196100) * tmp10 + z5; { c2-c6 }
z2 := {FAST_FLOAT} (0.541196100) * tmp10 + z5; { c2-c6 } z4 := {FAST_FLOAT} (1.306562965) * tmp12 + z5; { c2+c6 }
z4 := {FAST_FLOAT} (1.306562965) * tmp12 + z5; { c2+c6 } z3 := tmp11 * {FAST_FLOAT} (0.707106781); { c4 }
z3 := tmp11 * {FAST_FLOAT} (0.707106781); { c4 }
z11 := tmp7 + z3; { phase 5 }
z11 := tmp7 + z3; { phase 5 } z13 := tmp7 - z3;
z13 := tmp7 - z3;
dataptr^[DCTSIZE*5] := z13 + z2; { phase 6 }
dataptr^[DCTSIZE*5] := z13 + z2; { phase 6 } dataptr^[DCTSIZE*3] := z13 - z2;
dataptr^[DCTSIZE*3] := z13 - z2; dataptr^[DCTSIZE*1] := z11 + z4;
dataptr^[DCTSIZE*1] := z11 + z4; dataptr^[DCTSIZE*7] := z11 - z4;
dataptr^[DCTSIZE*7] := z11 - z4;
Inc(FAST_FLOAT_PTR(dataptr)); { advance pointer to next column }
Inc(FAST_FLOAT_PTR(dataptr)); { advance pointer to next column } end;
end; end;
end;
end.
end.

474
Imaging/JpegLib/imjfdctfst.pas
View File

@ -1,237 +1,237 @@
unit imjfdctfst; unit imjfdctfst;
{ This file contains a fast, not so accurate integer implementation of the { This file contains a fast, not so accurate integer implementation of the
forward DCT (Discrete Cosine Transform). forward DCT (Discrete Cosine Transform).
A 2-D DCT can be done by 1-D DCT on each row followed by 1-D DCT A 2-D DCT can be done by 1-D DCT on each row followed by 1-D DCT
on each column. Direct algorithms are also available, but they are on each column. Direct algorithms are also available, but they are
much more complex and seem not to be any faster when reduced to code. much more complex and seem not to be any faster when reduced to code.
This implementation is based on Arai, Agui, and Nakajima's algorithm for This implementation is based on Arai, Agui, and Nakajima's algorithm for
scaled DCT. Their original paper (Trans. IEICE E-71(11):1095) is in scaled DCT. Their original paper (Trans. IEICE E-71(11):1095) is in
Japanese, but the algorithm is described in the Pennebaker & Mitchell Japanese, but the algorithm is described in the Pennebaker & Mitchell
JPEG textbook (see REFERENCES section in file README). The following code JPEG textbook (see REFERENCES section in file README). The following code
is based directly on figure 4-8 in P&M. is based directly on figure 4-8 in P&M.
While an 8-point DCT cannot be done in less than 11 multiplies, it is While an 8-point DCT cannot be done in less than 11 multiplies, it is
possible to arrange the computation so that many of the multiplies are possible to arrange the computation so that many of the multiplies are
simple scalings of the final outputs. These multiplies can then be simple scalings of the final outputs. These multiplies can then be
folded into the multiplications or divisions by the JPEG quantization folded into the multiplications or divisions by the JPEG quantization
table entries. The AA&N method leaves only 5 multiplies and 29 adds table entries. The AA&N method leaves only 5 multiplies and 29 adds
to be done in the DCT itself. to be done in the DCT itself.
The primary disadvantage of this method is that with fixed-point math, The primary disadvantage of this method is that with fixed-point math,
accuracy is lost due to imprecise representation of the scaled accuracy is lost due to imprecise representation of the scaled
quantization values. The smaller the quantization table entry, the less quantization values. The smaller the quantization table entry, the less
precise the scaled value, so this implementation does worse with high- precise the scaled value, so this implementation does worse with high-
quality-setting files than with low-quality ones. } quality-setting files than with low-quality ones. }
{ Original: jfdctfst.c ; Copyright (C) 1994-1996, Thomas G. Lane. } { Original: jfdctfst.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
interface interface
{$I imjconfig.inc} {$I imjconfig.inc}
uses uses
imjmorecfg, imjmorecfg,
imjinclude, imjinclude,
imjpeglib, imjpeglib,
imjdct; { Private declarations for DCT subsystem } imjdct; { Private declarations for DCT subsystem }
{ Perform the forward DCT on one block of samples. } { Perform the forward DCT on one block of samples. }
{GLOBAL} {GLOBAL}
procedure jpeg_fdct_ifast (var data : array of DCTELEM); procedure jpeg_fdct_ifast (var data : array of DCTELEM);
implementation implementation
{ This module is specialized to the case DCTSIZE = 8. } { This module is specialized to the case DCTSIZE = 8. }
{$ifndef DCTSIZE_IS_8} {$ifndef DCTSIZE_IS_8}
Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err } Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err }
{$endif} {$endif}
{ Scaling decisions are generally the same as in the LL&M algorithm; { Scaling decisions are generally the same as in the LL&M algorithm;
see jfdctint.c for more details. However, we choose to descale see jfdctint.c for more details. However, we choose to descale
(right shift) multiplication products as soon as they are formed, (right shift) multiplication products as soon as they are formed,
rather than carrying additional fractional bits into subsequent additions. rather than carrying additional fractional bits into subsequent additions.
This compromises accuracy slightly, but it lets us save a few shifts. This compromises accuracy slightly, but it lets us save a few shifts.
More importantly, 16-bit arithmetic is then adequate (for 8-bit samples) More importantly, 16-bit arithmetic is then adequate (for 8-bit samples)
everywhere except in the multiplications proper; this saves a good deal everywhere except in the multiplications proper; this saves a good deal
of work on 16-bit-int machines. of work on 16-bit-int machines.
Again to save a few shifts, the intermediate results between pass 1 and Again to save a few shifts, the intermediate results between pass 1 and
pass 2 are not upscaled, but are represented only to integral precision. pass 2 are not upscaled, but are represented only to integral precision.
A final compromise is to represent the multiplicative constants to only A final compromise is to represent the multiplicative constants to only
8 fractional bits, rather than 13. This saves some shifting work on some 8 fractional bits, rather than 13. This saves some shifting work on some
machines, and may also reduce the cost of multiplication (since there machines, and may also reduce the cost of multiplication (since there
are fewer one-bits in the constants). } are fewer one-bits in the constants). }
const const
CONST_BITS = 8; CONST_BITS = 8;
const const
CONST_SCALE = (INT32(1) shl CONST_BITS); CONST_SCALE = (INT32(1) shl CONST_BITS);
const const
FIX_0_382683433 = INT32(Round(CONST_SCALE * 0.382683433)); {98} FIX_0_382683433 = INT32(Round(CONST_SCALE * 0.382683433)); {98}
FIX_0_541196100 = INT32(Round(CONST_SCALE * 0.541196100)); {139} FIX_0_541196100 = INT32(Round(CONST_SCALE * 0.541196100)); {139}
FIX_0_707106781 = INT32(Round(CONST_SCALE * 0.707106781)); {181} FIX_0_707106781 = INT32(Round(CONST_SCALE * 0.707106781)); {181}
FIX_1_306562965 = INT32(Round(CONST_SCALE * 1.306562965)); {334} FIX_1_306562965 = INT32(Round(CONST_SCALE * 1.306562965)); {334}
{ Descale and correctly round an INT32 value that's scaled by N bits. { Descale and correctly round an INT32 value that's scaled by N bits.
We assume RIGHT_SHIFT rounds towards minus infinity, so adding We assume RIGHT_SHIFT rounds towards minus infinity, so adding
the fudge factor is correct for either sign of X. } the fudge factor is correct for either sign of X. }
function DESCALE(x : INT32; n : int) : INT32; function DESCALE(x : INT32; n : int) : INT32;
var var
shift_temp : INT32; shift_temp : INT32;
begin begin
{ We can gain a little more speed, with a further compromise in accuracy, { We can gain a little more speed, with a further compromise in accuracy,
by omitting the addition in a descaling shift. This yields an incorrectly by omitting the addition in a descaling shift. This yields an incorrectly
rounded result half the time... } rounded result half the time... }
{$ifndef USE_ACCURATE_ROUNDING} {$ifndef USE_ACCURATE_ROUNDING}
shift_temp := x; shift_temp := x;
{$else} {$else}
shift_temp := x + (INT32(1) shl (n-1)); shift_temp := x + (INT32(1) shl (n-1));
{$endif} {$endif}
{$ifdef RIGHT_SHIFT_IS_UNSIGNED} {$ifdef RIGHT_SHIFT_IS_UNSIGNED}
if shift_temp < 0 then if shift_temp < 0 then
Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n)) Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n))
else else
{$endif} {$endif}
Descale := (shift_temp shr n); Descale := (shift_temp shr n);
end; end;
{ Multiply a DCTELEM variable by an INT32 constant, and immediately { Multiply a DCTELEM variable by an INT32 constant, and immediately
descale to yield a DCTELEM result. } descale to yield a DCTELEM result. }
function MULTIPLY(X : DCTELEM; Y: INT32): DCTELEM; function MULTIPLY(X : DCTELEM; Y: INT32): DCTELEM;
begin begin
Multiply := DeScale((X) * (Y), CONST_BITS); Multiply := DeScale((X) * (Y), CONST_BITS);
end; end;
{ Perform the forward DCT on one block of samples. } { Perform the forward DCT on one block of samples. }
{GLOBAL} {GLOBAL}
procedure jpeg_fdct_ifast (var data : array of DCTELEM); procedure jpeg_fdct_ifast (var data : array of DCTELEM);
type type
PWorkspace = ^TWorkspace; PWorkspace = ^TWorkspace;
TWorkspace = array [0..DCTSIZE2-1] of DCTELEM; TWorkspace = array [0..DCTSIZE2-1] of DCTELEM;
var var
tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7 : DCTELEM; tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7 : DCTELEM;
tmp10, tmp11, tmp12, tmp13 : DCTELEM; tmp10, tmp11, tmp12, tmp13 : DCTELEM;
z1, z2, z3, z4, z5, z11, z13 : DCTELEM; z1, z2, z3, z4, z5, z11, z13 : DCTELEM;
dataptr : PWorkspace; dataptr : PWorkspace;
ctr : int; ctr : int;
{SHIFT_TEMPS} {SHIFT_TEMPS}
begin begin
{ Pass 1: process rows. } { Pass 1: process rows. }
dataptr := PWorkspace(@data); dataptr := PWorkspace(@data);
for ctr := DCTSIZE-1 downto 0 do for ctr := DCTSIZE-1 downto 0 do
begin begin
tmp0 := dataptr^[0] + dataptr^[7]; tmp0 := dataptr^[0] + dataptr^[7];
tmp7 := dataptr^[0] - dataptr^[7]; tmp7 := dataptr^[0] - dataptr^[7];
tmp1 := dataptr^[1] + dataptr^[6]; tmp1 := dataptr^[1] + dataptr^[6];
tmp6 := dataptr^[1] - dataptr^[6]; tmp6 := dataptr^[1] - dataptr^[6];
tmp2 := dataptr^[2] + dataptr^[5]; tmp2 := dataptr^[2] + dataptr^[5];
tmp5 := dataptr^[2] - dataptr^[5]; tmp5 := dataptr^[2] - dataptr^[5];
tmp3 := dataptr^[3] + dataptr^[4]; tmp3 := dataptr^[3] + dataptr^[4];
tmp4 := dataptr^[3] - dataptr^[4]; tmp4 := dataptr^[3] - dataptr^[4];
{ Even part } { Even part }
tmp10 := tmp0 + tmp3; { phase 2 } tmp10 := tmp0 + tmp3; { phase 2 }
tmp13 := tmp0 - tmp3; tmp13 := tmp0 - tmp3;
tmp11 := tmp1 + tmp2; tmp11 := tmp1 + tmp2;
tmp12 := tmp1 - tmp2; tmp12 := tmp1 - tmp2;
dataptr^[0] := tmp10 + tmp11; { phase 3 } dataptr^[0] := tmp10 + tmp11; { phase 3 }
dataptr^[4] := tmp10 - tmp11; dataptr^[4] := tmp10 - tmp11;
z1 := MULTIPLY(tmp12 + tmp13, FIX_0_707106781); { c4 } z1 := MULTIPLY(tmp12 + tmp13, FIX_0_707106781); { c4 }
dataptr^[2] := tmp13 + z1; { phase 5 } dataptr^[2] := tmp13 + z1; { phase 5 }
dataptr^[6] := tmp13 - z1; dataptr^[6] := tmp13 - z1;
{ Odd part } { Odd part }
tmp10 := tmp4 + tmp5; { phase 2 } tmp10 := tmp4 + tmp5; { phase 2 }
tmp11 := tmp5 + tmp6; tmp11 := tmp5 + tmp6;
tmp12 := tmp6 + tmp7; tmp12 := tmp6 + tmp7;
{ The rotator is modified from fig 4-8 to avoid extra negations. } { The rotator is modified from fig 4-8 to avoid extra negations. }
z5 := MULTIPLY(tmp10 - tmp12, FIX_0_382683433); { c6 } z5 := MULTIPLY(tmp10 - tmp12, FIX_0_382683433); { c6 }
z2 := MULTIPLY(tmp10, FIX_0_541196100) + z5; { c2-c6 } z2 := MULTIPLY(tmp10, FIX_0_541196100) + z5; { c2-c6 }
z4 := MULTIPLY(tmp12, FIX_1_306562965) + z5; { c2+c6 } z4 := MULTIPLY(tmp12, FIX_1_306562965) + z5; { c2+c6 }
z3 := MULTIPLY(tmp11, FIX_0_707106781); { c4 } z3 := MULTIPLY(tmp11, FIX_0_707106781); { c4 }
z11 := tmp7 + z3; { phase 5 } z11 := tmp7 + z3; { phase 5 }
z13 := tmp7 - z3; z13 := tmp7 - z3;
dataptr^[5] := z13 + z2; { phase 6 } dataptr^[5] := z13 + z2; { phase 6 }
dataptr^[3] := z13 - z2; dataptr^[3] := z13 - z2;
dataptr^[1] := z11 + z4; dataptr^[1] := z11 + z4;
dataptr^[7] := z11 - z4; dataptr^[7] := z11 - z4;
Inc(DCTELEMPTR(dataptr), DCTSIZE); { advance pointer to next row } Inc(DCTELEMPTR(dataptr), DCTSIZE); { advance pointer to next row }
end; end;
{ Pass 2: process columns. } { Pass 2: process columns. }
dataptr := PWorkspace(@data); dataptr := PWorkspace(@data);
for ctr := DCTSIZE-1 downto 0 do for ctr := DCTSIZE-1 downto 0 do
begin begin
tmp0 := dataptr^[DCTSIZE*0] + dataptr^[DCTSIZE*7]; tmp0 := dataptr^[DCTSIZE*0] + dataptr^[DCTSIZE*7];
tmp7 := dataptr^[DCTSIZE*0] - dataptr^[DCTSIZE*7]; tmp7 := dataptr^[DCTSIZE*0] - dataptr^[DCTSIZE*7];
tmp1 := dataptr^[DCTSIZE*1] + dataptr^[DCTSIZE*6]; tmp1 := dataptr^[DCTSIZE*1] + dataptr^[DCTSIZE*6];
tmp6 := dataptr^[DCTSIZE*1] - dataptr^[DCTSIZE*6]; tmp6 := dataptr^[DCTSIZE*1] - dataptr^[DCTSIZE*6];
tmp2 := dataptr^[DCTSIZE*2] + dataptr^[DCTSIZE*5]; tmp2 := dataptr^[DCTSIZE*2] + dataptr^[DCTSIZE*5];
tmp5 := dataptr^[DCTSIZE*2] - dataptr^[DCTSIZE*5]; tmp5 := dataptr^[DCTSIZE*2] - dataptr^[DCTSIZE*5];
tmp3 := dataptr^[DCTSIZE*3] + dataptr^[DCTSIZE*4]; tmp3 := dataptr^[DCTSIZE*3] + dataptr^[DCTSIZE*4];
tmp4 := dataptr^[DCTSIZE*3] - dataptr^[DCTSIZE*4]; tmp4 := dataptr^[DCTSIZE*3] - dataptr^[DCTSIZE*4];
{ Even part } { Even part }
tmp10 := tmp0 + tmp3; { phase 2 } tmp10 := tmp0 + tmp3; { phase 2 }
tmp13 := tmp0 - tmp3; tmp13 := tmp0 - tmp3;
tmp11 := tmp1 + tmp2; tmp11 := tmp1 + tmp2;
tmp12 := tmp1 - tmp2; tmp12 := tmp1 - tmp2;
dataptr^[DCTSIZE*0] := tmp10 + tmp11; { phase 3 } dataptr^[DCTSIZE*0] := tmp10 + tmp11; { phase 3 }
dataptr^[DCTSIZE*4] := tmp10 - tmp11; dataptr^[DCTSIZE*4] := tmp10 - tmp11;
z1 := MULTIPLY(tmp12 + tmp13, FIX_0_707106781); { c4 } z1 := MULTIPLY(tmp12 + tmp13, FIX_0_707106781); { c4 }
dataptr^[DCTSIZE*2] := tmp13 + z1; { phase 5 } dataptr^[DCTSIZE*2] := tmp13 + z1; { phase 5 }
dataptr^[DCTSIZE*6] := tmp13 - z1; dataptr^[DCTSIZE*6] := tmp13 - z1;
{ Odd part } { Odd part }
tmp10 := tmp4 + tmp5; { phase 2 } tmp10 := tmp4 + tmp5; { phase 2 }
tmp11 := tmp5 + tmp6; tmp11 := tmp5 + tmp6;
tmp12 := tmp6 + tmp7; tmp12 := tmp6 + tmp7;
{ The rotator is modified from fig 4-8 to avoid extra negations. } { The rotator is modified from fig 4-8 to avoid extra negations. }
z5 := MULTIPLY(tmp10 - tmp12, FIX_0_382683433); { c6 } z5 := MULTIPLY(tmp10 - tmp12, FIX_0_382683433); { c6 }
z2 := MULTIPLY(tmp10, FIX_0_541196100) + z5; { c2-c6 } z2 := MULTIPLY(tmp10, FIX_0_541196100) + z5; { c2-c6 }
z4 := MULTIPLY(tmp12, FIX_1_306562965) + z5; { c2+c6 } z4 := MULTIPLY(tmp12, FIX_1_306562965) + z5; { c2+c6 }
z3 := MULTIPLY(tmp11, FIX_0_707106781); { c4 } z3 := MULTIPLY(tmp11, FIX_0_707106781); { c4 }
z11 := tmp7 + z3; { phase 5 } z11 := tmp7 + z3; { phase 5 }
z13 := tmp7 - z3; z13 := tmp7 - z3;
dataptr^[DCTSIZE*5] := z13 + z2; { phase 6 } dataptr^[DCTSIZE*5] := z13 + z2; { phase 6 }
dataptr^[DCTSIZE*3] := z13 - z2; dataptr^[DCTSIZE*3] := z13 - z2;
dataptr^[DCTSIZE*1] := z11 + z4; dataptr^[DCTSIZE*1] := z11 + z4;
dataptr^[DCTSIZE*7] := z11 - z4; dataptr^[DCTSIZE*7] := z11 - z4;
Inc(DCTELEMPTR(dataptr)); { advance pointer to next column } Inc(DCTELEMPTR(dataptr)); { advance pointer to next column }
end; end;
end; end;
end. end.

594
Imaging/JpegLib/imjfdctint.pas
View File

@ -1,297 +1,297 @@
unit imjfdctint; unit imjfdctint;
{ This file contains a slow-but-accurate integer implementation of the { This file contains a slow-but-accurate integer implementation of the
forward DCT (Discrete Cosine Transform). forward DCT (Discrete Cosine Transform).
A 2-D DCT can be done by 1-D DCT on each row followed by 1-D DCT A 2-D DCT can be done by 1-D DCT on each row followed by 1-D DCT
on each column. Direct algorithms are also available, but they are on each column. Direct algorithms are also available, but they are
much more complex and seem not to be any faster when reduced to code. much more complex and seem not to be any faster when reduced to code.
This implementation is based on an algorithm described in This implementation is based on an algorithm described in
C. Loeffler, A. Ligtenberg and G. Moschytz, "Practical Fast 1-D DCT C. Loeffler, A. Ligtenberg and G. Moschytz, "Practical Fast 1-D DCT
Algorithms with 11 Multiplications", Proc. Int'l. Conf. on Acoustics, Algorithms with 11 Multiplications", Proc. Int'l. Conf. on Acoustics,
Speech, and Signal Processing 1989 (ICASSP '89), pp. 988-991. Speech, and Signal Processing 1989 (ICASSP '89), pp. 988-991.
The primary algorithm described there uses 11 multiplies and 29 adds. The primary algorithm described there uses 11 multiplies and 29 adds.
We use their alternate method with 12 multiplies and 32 adds. We use their alternate method with 12 multiplies and 32 adds.
The advantage of this method is that no data path contains more than one The advantage of this method is that no data path contains more than one
multiplication; this allows a very simple and accurate implementation in multiplication; this allows a very simple and accurate implementation in
scaled fixed-point arithmetic, with a minimal number of shifts. } scaled fixed-point arithmetic, with a minimal number of shifts. }
{ Original : jfdctint.c ; Copyright (C) 1991-1996, Thomas G. Lane. } { Original : jfdctint.c ; Copyright (C) 1991-1996, Thomas G. Lane. }
interface interface
{$I imjconfig.inc} {$I imjconfig.inc}
uses uses
imjmorecfg, imjmorecfg,
imjinclude, imjinclude,
imjutils, imjutils,
imjpeglib, imjpeglib,
imjdct; { Private declarations for DCT subsystem } imjdct; { Private declarations for DCT subsystem }
{ Perform the forward DCT on one block of samples. } { Perform the forward DCT on one block of samples. }
{GLOBAL} {GLOBAL}
procedure jpeg_fdct_islow (var data : array of DCTELEM); procedure jpeg_fdct_islow (var data : array of DCTELEM);
implementation implementation
{ This module is specialized to the case DCTSIZE = 8. } { This module is specialized to the case DCTSIZE = 8. }
{$ifndef DCTSIZE_IS_8} {$ifndef DCTSIZE_IS_8}
Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err } Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err }
{$endif} {$endif}
{ The poop on this scaling stuff is as follows: { The poop on this scaling stuff is as follows:
Each 1-D DCT step produces outputs which are a factor of sqrt(N) Each 1-D DCT step produces outputs which are a factor of sqrt(N)
larger than the true DCT outputs. The final outputs are therefore larger than the true DCT outputs. The final outputs are therefore
a factor of N larger than desired; since N=8 this can be cured by a factor of N larger than desired; since N=8 this can be cured by
a simple right shift at the end of the algorithm. The advantage of a simple right shift at the end of the algorithm. The advantage of
this arrangement is that we save two multiplications per 1-D DCT, this arrangement is that we save two multiplications per 1-D DCT,
because the y0 and y4 outputs need not be divided by sqrt(N). because the y0 and y4 outputs need not be divided by sqrt(N).
In the IJG code, this factor of 8 is removed by the quantization step In the IJG code, this factor of 8 is removed by the quantization step
(in jcdctmgr.c), NOT in this module. (in jcdctmgr.c), NOT in this module.
We have to do addition and subtraction of the integer inputs, which We have to do addition and subtraction of the integer inputs, which
is no problem, and multiplication by fractional constants, which is is no problem, and multiplication by fractional constants, which is
a problem to do in integer arithmetic. We multiply all the constants a problem to do in integer arithmetic. We multiply all the constants
by CONST_SCALE and convert them to integer constants (thus retaining by CONST_SCALE and convert them to integer constants (thus retaining
CONST_BITS bits of precision in the constants). After doing a CONST_BITS bits of precision in the constants). After doing a
multiplication we have to divide the product by CONST_SCALE, with proper multiplication we have to divide the product by CONST_SCALE, with proper
rounding, to produce the correct output. This division can be done rounding, to produce the correct output. This division can be done
cheaply as a right shift of CONST_BITS bits. We postpone shifting cheaply as a right shift of CONST_BITS bits. We postpone shifting
as long as possible so that partial sums can be added together with as long as possible so that partial sums can be added together with
full fractional precision. full fractional precision.
The outputs of the first pass are scaled up by PASS1_BITS bits so that The outputs of the first pass are scaled up by PASS1_BITS bits so that
they are represented to better-than-integral precision. These outputs they are represented to better-than-integral precision. These outputs
require BITS_IN_JSAMPLE + PASS1_BITS + 3 bits; this fits in a 16-bit word require BITS_IN_JSAMPLE + PASS1_BITS + 3 bits; this fits in a 16-bit word
with the recommended scaling. (For 12-bit sample data, the intermediate with the recommended scaling. (For 12-bit sample data, the intermediate
array is INT32 anyway.) array is INT32 anyway.)
To avoid overflow of the 32-bit intermediate results in pass 2, we must To avoid overflow of the 32-bit intermediate results in pass 2, we must
have BITS_IN_JSAMPLE + CONST_BITS + PASS1_BITS <= 26. Error analysis have BITS_IN_JSAMPLE + CONST_BITS + PASS1_BITS <= 26. Error analysis
shows that the values given below are the most effective. } shows that the values given below are the most effective. }
{$ifdef BITS_IN_JSAMPLE_IS_8} {$ifdef BITS_IN_JSAMPLE_IS_8}
const const
CONST_BITS = 13; CONST_BITS = 13;
PASS1_BITS = 2; PASS1_BITS = 2;
{$else} {$else}
const const
CONST_BITS = 13; CONST_BITS = 13;
PASS1_BITS = 1; { lose a little precision to avoid overflow } PASS1_BITS = 1; { lose a little precision to avoid overflow }
{$endif} {$endif}
const const
CONST_SCALE = (INT32(1) shl CONST_BITS); CONST_SCALE = (INT32(1) shl CONST_BITS);
const const
FIX_0_298631336 = INT32(Round(CONST_SCALE * 0.298631336)); {2446} FIX_0_298631336 = INT32(Round(CONST_SCALE * 0.298631336)); {2446}
FIX_0_390180644 = INT32(Round(CONST_SCALE * 0.390180644)); {3196} FIX_0_390180644 = INT32(Round(CONST_SCALE * 0.390180644)); {3196}
FIX_0_541196100 = INT32(Round(CONST_SCALE * 0.541196100)); {4433} FIX_0_541196100 = INT32(Round(CONST_SCALE * 0.541196100)); {4433}
FIX_0_765366865 = INT32(Round(CONST_SCALE * 0.765366865)); {6270} FIX_0_765366865 = INT32(Round(CONST_SCALE * 0.765366865)); {6270}
FIX_0_899976223 = INT32(Round(CONST_SCALE * 0.899976223)); {7373} FIX_0_899976223 = INT32(Round(CONST_SCALE * 0.899976223)); {7373}
FIX_1_175875602 = INT32(Round(CONST_SCALE * 1.175875602)); {9633} FIX_1_175875602 = INT32(Round(CONST_SCALE * 1.175875602)); {9633}
FIX_1_501321110 = INT32(Round(CONST_SCALE * 1.501321110)); {12299} FIX_1_501321110 = INT32(Round(CONST_SCALE * 1.501321110)); {12299}
FIX_1_847759065 = INT32(Round(CONST_SCALE * 1.847759065)); {15137} FIX_1_847759065 = INT32(Round(CONST_SCALE * 1.847759065)); {15137}
FIX_1_961570560 = INT32(Round(CONST_SCALE * 1.961570560)); {16069} FIX_1_961570560 = INT32(Round(CONST_SCALE * 1.961570560)); {16069}
FIX_2_053119869 = INT32(Round(CONST_SCALE * 2.053119869)); {16819} FIX_2_053119869 = INT32(Round(CONST_SCALE * 2.053119869)); {16819}
FIX_2_562915447 = INT32(Round(CONST_SCALE * 2.562915447)); {20995} FIX_2_562915447 = INT32(Round(CONST_SCALE * 2.562915447)); {20995}
FIX_3_072711026 = INT32(Round(CONST_SCALE * 3.072711026)); {25172} FIX_3_072711026 = INT32(Round(CONST_SCALE * 3.072711026)); {25172}
{ Multiply an INT32 variable by an INT32 constant to yield an INT32 result. { Multiply an INT32 variable by an INT32 constant to yield an INT32 result.
For 8-bit samples with the recommended scaling, all the variable For 8-bit samples with the recommended scaling, all the variable
and constant values involved are no more than 16 bits wide, so a and constant values involved are no more than 16 bits wide, so a
16x16->32 bit multiply can be used instead of a full 32x32 multiply. 16x16->32 bit multiply can be used instead of a full 32x32 multiply.
For 12-bit samples, a full 32-bit multiplication will be needed. } For 12-bit samples, a full 32-bit multiplication will be needed. }
{$ifdef BITS_IN_JSAMPLE_IS_8} {$ifdef BITS_IN_JSAMPLE_IS_8}
{MULTIPLY16C16(var,const)} {MULTIPLY16C16(var,const)}
function Multiply(X, Y: int): INT32; function Multiply(X, Y: int): INT32;
begin begin
Multiply := int(X) * INT32(Y); Multiply := int(X) * INT32(Y);
end; end;
{$else} {$else}
function Multiply(X, Y: INT32): INT32; function Multiply(X, Y: INT32): INT32;
begin begin
Multiply := X * Y; Multiply := X * Y;
end; end;
{$endif} {$endif}
{ Descale and correctly round an INT32 value that's scaled by N bits. { Descale and correctly round an INT32 value that's scaled by N bits.
We assume RIGHT_SHIFT rounds towards minus infinity, so adding We assume RIGHT_SHIFT rounds towards minus infinity, so adding
the fudge factor is correct for either sign of X. } the fudge factor is correct for either sign of X. }
function DESCALE(x : INT32; n : int) : INT32; function DESCALE(x : INT32; n : int) : INT32;
var var
shift_temp : INT32; shift_temp : INT32;
begin begin
{$ifdef RIGHT_SHIFT_IS_UNSIGNED} {$ifdef RIGHT_SHIFT_IS_UNSIGNED}
shift_temp := x + (INT32(1) shl (n-1)); shift_temp := x + (INT32(1) shl (n-1));
if shift_temp < 0 then if shift_temp < 0 then
Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n)) Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n))
else else
Descale := (shift_temp shr n); Descale := (shift_temp shr n);
{$else} {$else}
Descale := (x + (INT32(1) shl (n-1)) shr n; Descale := (x + (INT32(1) shl (n-1)) shr n;
{$endif} {$endif}
end; end;
{ Perform the forward DCT on one block of samples. } { Perform the forward DCT on one block of samples. }
{GLOBAL} {GLOBAL}
procedure jpeg_fdct_islow (var data : array of DCTELEM); procedure jpeg_fdct_islow (var data : array of DCTELEM);
type type
PWorkspace = ^TWorkspace; PWorkspace = ^TWorkspace;
TWorkspace = array [0..DCTSIZE2-1] of DCTELEM; TWorkspace = array [0..DCTSIZE2-1] of DCTELEM;
var var
tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7 : INT32; tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7 : INT32;
tmp10, tmp11, tmp12, tmp13 : INT32; tmp10, tmp11, tmp12, tmp13 : INT32;
z1, z2, z3, z4, z5 : INT32; z1, z2, z3, z4, z5 : INT32;
dataptr : PWorkspace; dataptr : PWorkspace;
ctr : int; ctr : int;
{SHIFT_TEMPS} {SHIFT_TEMPS}
begin begin
{ Pass 1: process rows. } { Pass 1: process rows. }
{ Note results are scaled up by sqrt(8) compared to a true DCT; } { Note results are scaled up by sqrt(8) compared to a true DCT; }
{ furthermore, we scale the results by 2**PASS1_BITS. } { furthermore, we scale the results by 2**PASS1_BITS. }
dataptr := PWorkspace(@data); dataptr := PWorkspace(@data);
for ctr := DCTSIZE-1 downto 0 do for ctr := DCTSIZE-1 downto 0 do
begin begin
tmp0 := dataptr^[0] + dataptr^[7]; tmp0 := dataptr^[0] + dataptr^[7];
tmp7 := dataptr^[0] - dataptr^[7]; tmp7 := dataptr^[0] - dataptr^[7];
tmp1 := dataptr^[1] + dataptr^[6]; tmp1 := dataptr^[1] + dataptr^[6];
tmp6 := dataptr^[1] - dataptr^[6]; tmp6 := dataptr^[1] - dataptr^[6];
tmp2 := dataptr^[2] + dataptr^[5]; tmp2 := dataptr^[2] + dataptr^[5];
tmp5 := dataptr^[2] - dataptr^[5]; tmp5 := dataptr^[2] - dataptr^[5];
tmp3 := dataptr^[3] + dataptr^[4]; tmp3 := dataptr^[3] + dataptr^[4];
tmp4 := dataptr^[3] - dataptr^[4]; tmp4 := dataptr^[3] - dataptr^[4];
{ Even part per LL&M figure 1 --- note that published figure is faulty; { Even part per LL&M figure 1 --- note that published figure is faulty;
rotator "sqrt(2)*c1" should be "sqrt(2)*c6". } rotator "sqrt(2)*c1" should be "sqrt(2)*c6". }
tmp10 := tmp0 + tmp3; tmp10 := tmp0 + tmp3;
tmp13 := tmp0 - tmp3; tmp13 := tmp0 - tmp3;
tmp11 := tmp1 + tmp2; tmp11 := tmp1 + tmp2;
tmp12 := tmp1 - tmp2; tmp12 := tmp1 - tmp2;
dataptr^[0] := DCTELEM ((tmp10 + tmp11) shl PASS1_BITS); dataptr^[0] := DCTELEM ((tmp10 + tmp11) shl PASS1_BITS);
dataptr^[4] := DCTELEM ((tmp10 - tmp11) shl PASS1_BITS); dataptr^[4] := DCTELEM ((tmp10 - tmp11) shl PASS1_BITS);
z1 := MULTIPLY(tmp12 + tmp13, FIX_0_541196100); z1 := MULTIPLY(tmp12 + tmp13, FIX_0_541196100);
dataptr^[2] := DCTELEM (DESCALE(z1 + MULTIPLY(tmp13, FIX_0_765366865), dataptr^[2] := DCTELEM (DESCALE(z1 + MULTIPLY(tmp13, FIX_0_765366865),
CONST_BITS-PASS1_BITS)); CONST_BITS-PASS1_BITS));
dataptr^[6] := DCTELEM (DESCALE(z1 + MULTIPLY(tmp12, - FIX_1_847759065), dataptr^[6] := DCTELEM (DESCALE(z1 + MULTIPLY(tmp12, - FIX_1_847759065),
CONST_BITS-PASS1_BITS)); CONST_BITS-PASS1_BITS));
{ Odd part per figure 8 --- note paper omits factor of sqrt(2). { Odd part per figure 8 --- note paper omits factor of sqrt(2).
cK represents cos(K*pi/16). cK represents cos(K*pi/16).
i0..i3 in the paper are tmp4..tmp7 here. } i0..i3 in the paper are tmp4..tmp7 here. }
z1 := tmp4 + tmp7; z1 := tmp4 + tmp7;
z2 := tmp5 + tmp6; z2 := tmp5 + tmp6;
z3 := tmp4 + tmp6; z3 := tmp4 + tmp6;
z4 := tmp5 + tmp7; z4 := tmp5 + tmp7;
z5 := MULTIPLY(z3 + z4, FIX_1_175875602); { sqrt(2) * c3 } z5 := MULTIPLY(z3 + z4, FIX_1_175875602); { sqrt(2) * c3 }
tmp4 := MULTIPLY(tmp4, FIX_0_298631336); { sqrt(2) * (-c1+c3+c5-c7) } tmp4 := MULTIPLY(tmp4, FIX_0_298631336); { sqrt(2) * (-c1+c3+c5-c7) }
tmp5 := MULTIPLY(tmp5, FIX_2_053119869); { sqrt(2) * ( c1+c3-c5+c7) } tmp5 := MULTIPLY(tmp5, FIX_2_053119869); { sqrt(2) * ( c1+c3-c5+c7) }
tmp6 := MULTIPLY(tmp6, FIX_3_072711026); { sqrt(2) * ( c1+c3+c5-c7) } tmp6 := MULTIPLY(tmp6, FIX_3_072711026); { sqrt(2) * ( c1+c3+c5-c7) }
tmp7 := MULTIPLY(tmp7, FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) } tmp7 := MULTIPLY(tmp7, FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) }
z1 := MULTIPLY(z1, - FIX_0_899976223); { sqrt(2) * (c7-c3) } z1 := MULTIPLY(z1, - FIX_0_899976223); { sqrt(2) * (c7-c3) }
z2 := MULTIPLY(z2, - FIX_2_562915447); { sqrt(2) * (-c1-c3) } z2 := MULTIPLY(z2, - FIX_2_562915447); { sqrt(2) * (-c1-c3) }
z3 := MULTIPLY(z3, - FIX_1_961570560); { sqrt(2) * (-c3-c5) } z3 := MULTIPLY(z3, - FIX_1_961570560); { sqrt(2) * (-c3-c5) }
z4 := MULTIPLY(z4, - FIX_0_390180644); { sqrt(2) * (c5-c3) } z4 := MULTIPLY(z4, - FIX_0_390180644); { sqrt(2) * (c5-c3) }
Inc(z3, z5); Inc(z3, z5);
Inc(z4, z5); Inc(z4, z5);
dataptr^[7] := DCTELEM(DESCALE(tmp4 + z1 + z3, CONST_BITS-PASS1_BITS)); dataptr^[7] := DCTELEM(DESCALE(tmp4 + z1 + z3, CONST_BITS-PASS1_BITS));
dataptr^[5] := DCTELEM(DESCALE(tmp5 + z2 + z4, CONST_BITS-PASS1_BITS)); dataptr^[5] := DCTELEM(DESCALE(tmp5 + z2 + z4, CONST_BITS-PASS1_BITS));
dataptr^[3] := DCTELEM(DESCALE(tmp6 + z2 + z3, CONST_BITS-PASS1_BITS)); dataptr^[3] := DCTELEM(DESCALE(tmp6 + z2 + z3, CONST_BITS-PASS1_BITS));
dataptr^[1] := DCTELEM(DESCALE(tmp7 + z1 + z4, CONST_BITS-PASS1_BITS)); dataptr^[1] := DCTELEM(DESCALE(tmp7 + z1 + z4, CONST_BITS-PASS1_BITS));
Inc(DCTELEMPTR(dataptr), DCTSIZE); { advance pointer to next row } Inc(DCTELEMPTR(dataptr), DCTSIZE); { advance pointer to next row }
end; end;
{ Pass 2: process columns. { Pass 2: process columns.
We remove the PASS1_BITS scaling, but leave the results scaled up We remove the PASS1_BITS scaling, but leave the results scaled up
by an overall factor of 8. } by an overall factor of 8. }
dataptr := PWorkspace(@data); dataptr := PWorkspace(@data);
for ctr := DCTSIZE-1 downto 0 do for ctr := DCTSIZE-1 downto 0 do
begin begin
tmp0 := dataptr^[DCTSIZE*0] + dataptr^[DCTSIZE*7]; tmp0 := dataptr^[DCTSIZE*0] + dataptr^[DCTSIZE*7];
tmp7 := dataptr^[DCTSIZE*0] - dataptr^[DCTSIZE*7]; tmp7 := dataptr^[DCTSIZE*0] - dataptr^[DCTSIZE*7];
tmp1 := dataptr^[DCTSIZE*1] + dataptr^[DCTSIZE*6]; tmp1 := dataptr^[DCTSIZE*1] + dataptr^[DCTSIZE*6];
tmp6 := dataptr^[DCTSIZE*1] - dataptr^[DCTSIZE*6]; tmp6 := dataptr^[DCTSIZE*1] - dataptr^[DCTSIZE*6];
tmp2 := dataptr^[DCTSIZE*2] + dataptr^[DCTSIZE*5]; tmp2 := dataptr^[DCTSIZE*2] + dataptr^[DCTSIZE*5];
tmp5 := dataptr^[DCTSIZE*2] - dataptr^[DCTSIZE*5]; tmp5 := dataptr^[DCTSIZE*2] - dataptr^[DCTSIZE*5];
tmp3 := dataptr^[DCTSIZE*3] + dataptr^[DCTSIZE*4]; tmp3 := dataptr^[DCTSIZE*3] + dataptr^[DCTSIZE*4];
tmp4 := dataptr^[DCTSIZE*3] - dataptr^[DCTSIZE*4]; tmp4 := dataptr^[DCTSIZE*3] - dataptr^[DCTSIZE*4];
{ Even part per LL&M figure 1 --- note that published figure is faulty; { Even part per LL&M figure 1 --- note that published figure is faulty;
rotator "sqrt(2)*c1" should be "sqrt(2)*c6". } rotator "sqrt(2)*c1" should be "sqrt(2)*c6". }
tmp10 := tmp0 + tmp3; tmp10 := tmp0 + tmp3;
tmp13 := tmp0 - tmp3; tmp13 := tmp0 - tmp3;
tmp11 := tmp1 + tmp2; tmp11 := tmp1 + tmp2;
tmp12 := tmp1 - tmp2; tmp12 := tmp1 - tmp2;
dataptr^[DCTSIZE*0] := DCTELEM (DESCALE(tmp10 + tmp11, PASS1_BITS)); dataptr^[DCTSIZE*0] := DCTELEM (DESCALE(tmp10 + tmp11, PASS1_BITS));
dataptr^[DCTSIZE*4] := DCTELEM (DESCALE(tmp10 - tmp11, PASS1_BITS)); dataptr^[DCTSIZE*4] := DCTELEM (DESCALE(tmp10 - tmp11, PASS1_BITS));
z1 := MULTIPLY(tmp12 + tmp13, FIX_0_541196100); z1 := MULTIPLY(tmp12 + tmp13, FIX_0_541196100);
dataptr^[DCTSIZE*2] := DCTELEM (DESCALE(z1 + MULTIPLY(tmp13, FIX_0_765366865), dataptr^[DCTSIZE*2] := DCTELEM (DESCALE(z1 + MULTIPLY(tmp13, FIX_0_765366865),
CONST_BITS+PASS1_BITS)); CONST_BITS+PASS1_BITS));
dataptr^[DCTSIZE*6] := DCTELEM (DESCALE(z1 + MULTIPLY(tmp12, - FIX_1_847759065), dataptr^[DCTSIZE*6] := DCTELEM (DESCALE(z1 + MULTIPLY(tmp12, - FIX_1_847759065),
CONST_BITS+PASS1_BITS)); CONST_BITS+PASS1_BITS));
{ Odd part per figure 8 --- note paper omits factor of sqrt(2). { Odd part per figure 8 --- note paper omits factor of sqrt(2).
cK represents cos(K*pi/16). cK represents cos(K*pi/16).
i0..i3 in the paper are tmp4..tmp7 here. } i0..i3 in the paper are tmp4..tmp7 here. }
z1 := tmp4 + tmp7; z1 := tmp4 + tmp7;
z2 := tmp5 + tmp6; z2 := tmp5 + tmp6;
z3 := tmp4 + tmp6; z3 := tmp4 + tmp6;
z4 := tmp5 + tmp7; z4 := tmp5 + tmp7;
z5 := MULTIPLY(z3 + z4, FIX_1_175875602); { sqrt(2) * c3 } z5 := MULTIPLY(z3 + z4, FIX_1_175875602); { sqrt(2) * c3 }
tmp4 := MULTIPLY(tmp4, FIX_0_298631336); { sqrt(2) * (-c1+c3+c5-c7) } tmp4 := MULTIPLY(tmp4, FIX_0_298631336); { sqrt(2) * (-c1+c3+c5-c7) }
tmp5 := MULTIPLY(tmp5, FIX_2_053119869); { sqrt(2) * ( c1+c3-c5+c7) } tmp5 := MULTIPLY(tmp5, FIX_2_053119869); { sqrt(2) * ( c1+c3-c5+c7) }
tmp6 := MULTIPLY(tmp6, FIX_3_072711026); { sqrt(2) * ( c1+c3+c5-c7) } tmp6 := MULTIPLY(tmp6, FIX_3_072711026); { sqrt(2) * ( c1+c3+c5-c7) }
tmp7 := MULTIPLY(tmp7, FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) } tmp7 := MULTIPLY(tmp7, FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) }
z1 := MULTIPLY(z1, - FIX_0_899976223); { sqrt(2) * (c7-c3) } z1 := MULTIPLY(z1, - FIX_0_899976223); { sqrt(2) * (c7-c3) }
z2 := MULTIPLY(z2, - FIX_2_562915447); { sqrt(2) * (-c1-c3) } z2 := MULTIPLY(z2, - FIX_2_562915447); { sqrt(2) * (-c1-c3) }
z3 := MULTIPLY(z3, - FIX_1_961570560); { sqrt(2) * (-c3-c5) } z3 := MULTIPLY(z3, - FIX_1_961570560); { sqrt(2) * (-c3-c5) }
z4 := MULTIPLY(z4, - FIX_0_390180644); { sqrt(2) * (c5-c3) } z4 := MULTIPLY(z4, - FIX_0_390180644); { sqrt(2) * (c5-c3) }
Inc(z3, z5); Inc(z3, z5);
Inc(z4, z5); Inc(z4, z5);
dataptr^[DCTSIZE*7] := DCTELEM (DESCALE(tmp4 + z1 + z3, dataptr^[DCTSIZE*7] := DCTELEM (DESCALE(tmp4 + z1 + z3,
CONST_BITS+PASS1_BITS)); CONST_BITS+PASS1_BITS));
dataptr^[DCTSIZE*5] := DCTELEM (DESCALE(tmp5 + z2 + z4, dataptr^[DCTSIZE*5] := DCTELEM (DESCALE(tmp5 + z2 + z4,
CONST_BITS+PASS1_BITS)); CONST_BITS+PASS1_BITS));
dataptr^[DCTSIZE*3] := DCTELEM (DESCALE(tmp6 + z2 + z3, dataptr^[DCTSIZE*3] := DCTELEM (DESCALE(tmp6 + z2 + z3,
CONST_BITS+PASS1_BITS)); CONST_BITS+PASS1_BITS));
dataptr^[DCTSIZE*1] := DCTELEM (DESCALE(tmp7 + z1 + z4, dataptr^[DCTSIZE*1] := DCTELEM (DESCALE(tmp7 + z1 + z4,
CONST_BITS+PASS1_BITS)); CONST_BITS+PASS1_BITS));
Inc(DCTELEMPTR(dataptr)); { advance pointer to next column } Inc(DCTELEMPTR(dataptr)); { advance pointer to next column }
end; end;
end; end;
end. end.

1586
Imaging/JpegLib/imjidctasm.pas
View File

File diff suppressed because it is too large Load Diff

571
Imaging/JpegLib/imjidctflt.pas
View File

@ -1,286 +1,285 @@
unit imjidctflt; unit imjidctflt;
{$N+} { This file contains a floating-point implementation of the
{ This file contains a floating-point implementation of the inverse DCT (Discrete Cosine Transform). In the IJG code, this routine
inverse DCT (Discrete Cosine Transform). In the IJG code, this routine must also perform dequantization of the input coefficients.
must also perform dequantization of the input coefficients.
This implementation should be more accurate than either of the integer
This implementation should be more accurate than either of the integer IDCT implementations. However, it may not give the same results on all
IDCT implementations. However, it may not give the same results on all machines because of differences in roundoff behavior. Speed will depend
machines because of differences in roundoff behavior. Speed will depend on the hardware's floating point capacity.
on the hardware's floating point capacity.
A 2-D IDCT can be done by 1-D IDCT on each column followed by 1-D IDCT
A 2-D IDCT can be done by 1-D IDCT on each column followed by 1-D IDCT on each row (or vice versa, but it's more convenient to emit a row at
on each row (or vice versa, but it's more convenient to emit a row at a time). Direct algorithms are also available, but they are much more
a time). Direct algorithms are also available, but they are much more complex and seem not to be any faster when reduced to code.
complex and seem not to be any faster when reduced to code.
This implementation is based on Arai, Agui, and Nakajima's algorithm for
This implementation is based on Arai, Agui, and Nakajima's algorithm for scaled DCT. Their original paper (Trans. IEICE E-71(11):1095) is in
scaled DCT. Their original paper (Trans. IEICE E-71(11):1095) is in Japanese, but the algorithm is described in the Pennebaker & Mitchell
Japanese, but the algorithm is described in the Pennebaker & Mitchell JPEG textbook (see REFERENCES section in file README). The following code
JPEG textbook (see REFERENCES section in file README). The following code is based directly on figure 4-8 in P&M.
is based directly on figure 4-8 in P&M. While an 8-point DCT cannot be done in less than 11 multiplies, it is
While an 8-point DCT cannot be done in less than 11 multiplies, it is possible to arrange the computation so that many of the multiplies are
possible to arrange the computation so that many of the multiplies are simple scalings of the final outputs. These multiplies can then be
simple scalings of the final outputs. These multiplies can then be folded into the multiplications or divisions by the JPEG quantization
folded into the multiplications or divisions by the JPEG quantization table entries. The AA&N method leaves only 5 multiplies and 29 adds
table entries. The AA&N method leaves only 5 multiplies and 29 adds to be done in the DCT itself.
to be done in the DCT itself. The primary disadvantage of this method is that with a fixed-point
The primary disadvantage of this method is that with a fixed-point implementation, accuracy is lost due to imprecise representation of the
implementation, accuracy is lost due to imprecise representation of the scaled quantization values. However, that problem does not arise if
scaled quantization values. However, that problem does not arise if we use floating point arithmetic. }
we use floating point arithmetic. }
{ Original: jidctflt.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
{ Original: jidctflt.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
interface
interface
{$I imjconfig.inc}
{$I imjconfig.inc}
uses
uses imjmorecfg,
imjmorecfg, imjinclude,
imjinclude, imjpeglib,
imjpeglib, imjdct; { Private declarations for DCT subsystem }
imjdct; { Private declarations for DCT subsystem }
{ Perform dequantization and inverse DCT on one block of coefficients. }
{ Perform dequantization and inverse DCT on one block of coefficients. }
{GLOBAL}
{GLOBAL} procedure jpeg_idct_float (cinfo : j_decompress_ptr;
procedure jpeg_idct_float (cinfo : j_decompress_ptr; compptr : jpeg_component_info_ptr;
compptr : jpeg_component_info_ptr; coef_block : JCOEFPTR;
coef_block : JCOEFPTR; output_buf : JSAMPARRAY;
output_buf : JSAMPARRAY; output_col : JDIMENSION);
output_col : JDIMENSION);
implementation
implementation
{ This module is specialized to the case DCTSIZE = 8. }
{ This module is specialized to the case DCTSIZE = 8. }
{$ifndef DCTSIZE_IS_8}
{$ifndef DCTSIZE_IS_8} Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err }
Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err } {$endif}
{$endif}
{ Dequantize a coefficient by multiplying it by the multiplier-table
{ Dequantize a coefficient by multiplying it by the multiplier-table entry; produce a float result. }
entry; produce a float result. }
function DEQUANTIZE(coef : int; quantval : FAST_FLOAT) : FAST_FLOAT;
function DEQUANTIZE(coef : int; quantval : FAST_FLOAT) : FAST_FLOAT; begin
begin Dequantize := ( (coef) * quantval);
Dequantize := ( (coef) * quantval); end;
end;
{ Descale and correctly round an INT32 value that's scaled by N bits.
{ Descale and correctly round an INT32 value that's scaled by N bits. We assume RIGHT_SHIFT rounds towards minus infinity, so adding
We assume RIGHT_SHIFT rounds towards minus infinity, so adding the fudge factor is correct for either sign of X. }
the fudge factor is correct for either sign of X. }
function DESCALE(x : INT32; n : int) : INT32;
function DESCALE(x : INT32; n : int) : INT32; var
var shift_temp : INT32;
shift_temp : INT32; begin
begin {$ifdef RIGHT_SHIFT_IS_UNSIGNED}
{$ifdef RIGHT_SHIFT_IS_UNSIGNED} shift_temp := x + (INT32(1) shl (n-1));
shift_temp := x + (INT32(1) shl (n-1)); if shift_temp < 0 then
if shift_temp < 0 then Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n))
Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n)) else
else Descale := (shift_temp shr n);
Descale := (shift_temp shr n); {$else}
{$else} Descale := (x + (INT32(1) shl (n-1)) shr n;
Descale := (x + (INT32(1) shl (n-1)) shr n; {$endif}
{$endif} end;
end;
{ Perform dequantization and inverse DCT on one block of coefficients. }
{ Perform dequantization and inverse DCT on one block of coefficients. }
{GLOBAL}
{GLOBAL} procedure jpeg_idct_float (cinfo : j_decompress_ptr;
procedure jpeg_idct_float (cinfo : j_decompress_ptr; compptr : jpeg_component_info_ptr;
compptr : jpeg_component_info_ptr; coef_block : JCOEFPTR;
coef_block : JCOEFPTR; output_buf : JSAMPARRAY;
output_buf : JSAMPARRAY; output_col : JDIMENSION);
output_col : JDIMENSION); type
type PWorkspace = ^TWorkspace;
PWorkspace = ^TWorkspace; TWorkspace = array[0..DCTSIZE2-1] of FAST_FLOAT;
TWorkspace = array[0..DCTSIZE2-1] of FAST_FLOAT; var
var tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7 : FAST_FLOAT;
tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7 : FAST_FLOAT; tmp10, tmp11, tmp12, tmp13 : FAST_FLOAT;
tmp10, tmp11, tmp12, tmp13 : FAST_FLOAT; z5, z10, z11, z12, z13 : FAST_FLOAT;
z5, z10, z11, z12, z13 : FAST_FLOAT; inptr : JCOEFPTR;
inptr : JCOEFPTR; quantptr : FLOAT_MULT_TYPE_FIELD_PTR;
quantptr : FLOAT_MULT_TYPE_FIELD_PTR; wsptr : PWorkSpace;
wsptr : PWorkSpace; outptr : JSAMPROW;
outptr : JSAMPROW; range_limit : JSAMPROW;
range_limit : JSAMPROW; ctr : int;
ctr : int; workspace : TWorkspace; { buffers data between passes }
workspace : TWorkspace; { buffers data between passes } {SHIFT_TEMPS}
{SHIFT_TEMPS} var
var dcval : FAST_FLOAT;
dcval : FAST_FLOAT; begin
begin { Each IDCT routine is responsible for range-limiting its results and
{ Each IDCT routine is responsible for range-limiting its results and converting them to unsigned form (0..MAXJSAMPLE). The raw outputs could
converting them to unsigned form (0..MAXJSAMPLE). The raw outputs could be quite far out of range if the input data is corrupt, so a bulletproof
be quite far out of range if the input data is corrupt, so a bulletproof range-limiting step is required. We use a mask-and-table-lookup method
range-limiting step is required. We use a mask-and-table-lookup method to do the combined operations quickly. See the comments with
to do the combined operations quickly. See the comments with prepare_range_limit_table (in jdmaster.c) for more info. }
prepare_range_limit_table (in jdmaster.c) for more info. }
range_limit := JSAMPROW(@(cinfo^.sample_range_limit^[CENTERJSAMPLE]));
range_limit := JSAMPROW(@(cinfo^.sample_range_limit^[CENTERJSAMPLE]));
{ Pass 1: process columns from input, store into work array. }
{ Pass 1: process columns from input, store into work array. }
inptr := coef_block;
inptr := coef_block; quantptr := FLOAT_MULT_TYPE_FIELD_PTR (compptr^.dct_table);
quantptr := FLOAT_MULT_TYPE_FIELD_PTR (compptr^.dct_table); wsptr := @workspace;
wsptr := @workspace; for ctr := pred(DCTSIZE) downto 0 do
for ctr := pred(DCTSIZE) downto 0 do begin
begin { Due to quantization, we will usually find that many of the input
{ Due to quantization, we will usually find that many of the input coefficients are zero, especially the AC terms. We can exploit this
coefficients are zero, especially the AC terms. We can exploit this by short-circuiting the IDCT calculation for any column in which all
by short-circuiting the IDCT calculation for any column in which all the AC terms are zero. In that case each output is equal to the
the AC terms are zero. In that case each output is equal to the DC coefficient (with scale factor as needed).
DC coefficient (with scale factor as needed). With typical images and quantization tables, half or more of the
With typical images and quantization tables, half or more of the column DCT calculations can be simplified this way. }
column DCT calculations can be simplified this way. }
if (inptr^[DCTSIZE*1]=0) and (inptr^[DCTSIZE*2]=0) and
if (inptr^[DCTSIZE*1]=0) and (inptr^[DCTSIZE*2]=0) and (inptr^[DCTSIZE*3]=0) and (inptr^[DCTSIZE*4]=0) and
(inptr^[DCTSIZE*3]=0) and (inptr^[DCTSIZE*4]=0) and (inptr^[DCTSIZE*5]=0) and (inptr^[DCTSIZE*6]=0) and
(inptr^[DCTSIZE*5]=0) and (inptr^[DCTSIZE*6]=0) and (inptr^[DCTSIZE*7]=0) then
(inptr^[DCTSIZE*7]=0) then begin
begin { AC terms all zero }
{ AC terms all zero } FAST_FLOAT(dcval) := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]);
FAST_FLOAT(dcval) := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]);
wsptr^[DCTSIZE*0] := dcval;
wsptr^[DCTSIZE*0] := dcval; wsptr^[DCTSIZE*1] := dcval;
wsptr^[DCTSIZE*1] := dcval; wsptr^[DCTSIZE*2] := dcval;
wsptr^[DCTSIZE*2] := dcval; wsptr^[DCTSIZE*3] := dcval;
wsptr^[DCTSIZE*3] := dcval; wsptr^[DCTSIZE*4] := dcval;
wsptr^[DCTSIZE*4] := dcval; wsptr^[DCTSIZE*5] := dcval;
wsptr^[DCTSIZE*5] := dcval; wsptr^[DCTSIZE*6] := dcval;
wsptr^[DCTSIZE*6] := dcval; wsptr^[DCTSIZE*7] := dcval;
wsptr^[DCTSIZE*7] := dcval;
Inc(JCOEF_PTR(inptr)); { advance pointers to next column }
Inc(JCOEF_PTR(inptr)); { advance pointers to next column } Inc(FLOAT_MULT_TYPE_PTR(quantptr));
Inc(FLOAT_MULT_TYPE_PTR(quantptr)); Inc(FAST_FLOAT_PTR(wsptr));
Inc(FAST_FLOAT_PTR(wsptr)); continue;
continue; end;
end;
{ Even part }
{ Even part }
tmp0 := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]);
tmp0 := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]); tmp1 := DEQUANTIZE(inptr^[DCTSIZE*2], quantptr^[DCTSIZE*2]);
tmp1 := DEQUANTIZE(inptr^[DCTSIZE*2], quantptr^[DCTSIZE*2]); tmp2 := DEQUANTIZE(inptr^[DCTSIZE*4], quantptr^[DCTSIZE*4]);
tmp2 := DEQUANTIZE(inptr^[DCTSIZE*4], quantptr^[DCTSIZE*4]); tmp3 := DEQUANTIZE(inptr^[DCTSIZE*6], quantptr^[DCTSIZE*6]);
tmp3 := DEQUANTIZE(inptr^[DCTSIZE*6], quantptr^[DCTSIZE*6]);
tmp10 := tmp0 + tmp2; { phase 3 }
tmp10 := tmp0 + tmp2; { phase 3 } tmp11 := tmp0 - tmp2;
tmp11 := tmp0 - tmp2;
tmp13 := tmp1 + tmp3; { phases 5-3 }
tmp13 := tmp1 + tmp3; { phases 5-3 } tmp12 := (tmp1 - tmp3) * ({FAST_FLOAT}(1.414213562)) - tmp13; { 2*c4 }
tmp12 := (tmp1 - tmp3) * ({FAST_FLOAT}(1.414213562)) - tmp13; { 2*c4 }
tmp0 := tmp10 + tmp13; { phase 2 }
tmp0 := tmp10 + tmp13; { phase 2 } tmp3 := tmp10 - tmp13;
tmp3 := tmp10 - tmp13; tmp1 := tmp11 + tmp12;
tmp1 := tmp11 + tmp12; tmp2 := tmp11 - tmp12;
tmp2 := tmp11 - tmp12;
{ Odd part }
{ Odd part }
tmp4 := DEQUANTIZE(inptr^[DCTSIZE*1], quantptr^[DCTSIZE*1]);
tmp4 := DEQUANTIZE(inptr^[DCTSIZE*1], quantptr^[DCTSIZE*1]); tmp5 := DEQUANTIZE(inptr^[DCTSIZE*3], quantptr^[DCTSIZE*3]);
tmp5 := DEQUANTIZE(inptr^[DCTSIZE*3], quantptr^[DCTSIZE*3]); tmp6 := DEQUANTIZE(inptr^[DCTSIZE*5], quantptr^[DCTSIZE*5]);
tmp6 := DEQUANTIZE(inptr^[DCTSIZE*5], quantptr^[DCTSIZE*5]); tmp7 := DEQUANTIZE(inptr^[DCTSIZE*7], quantptr^[DCTSIZE*7]);
tmp7 := DEQUANTIZE(inptr^[DCTSIZE*7], quantptr^[DCTSIZE*7]);
z13 := tmp6 + tmp5; { phase 6 }
z13 := tmp6 + tmp5; { phase 6 } z10 := tmp6 - tmp5;
z10 := tmp6 - tmp5; z11 := tmp4 + tmp7;
z11 := tmp4 + tmp7; z12 := tmp4 - tmp7;
z12 := tmp4 - tmp7;
tmp7 := z11 + z13; { phase 5 }
tmp7 := z11 + z13; { phase 5 } tmp11 := (z11 - z13) * ({FAST_FLOAT}(1.414213562)); { 2*c4 }
tmp11 := (z11 - z13) * ({FAST_FLOAT}(1.414213562)); { 2*c4 }
z5 := (z10 + z12) * ({FAST_FLOAT}(1.847759065)); { 2*c2 }
z5 := (z10 + z12) * ({FAST_FLOAT}(1.847759065)); { 2*c2 } tmp10 := ({FAST_FLOAT}(1.082392200)) * z12 - z5; { 2*(c2-c6) }
tmp10 := ({FAST_FLOAT}(1.082392200)) * z12 - z5; { 2*(c2-c6) } tmp12 := ({FAST_FLOAT}(-2.613125930)) * z10 + z5; { -2*(c2+c6) }
tmp12 := ({FAST_FLOAT}(-2.613125930)) * z10 + z5; { -2*(c2+c6) }
tmp6 := tmp12 - tmp7; { phase 2 }
tmp6 := tmp12 - tmp7; { phase 2 } tmp5 := tmp11 - tmp6;
tmp5 := tmp11 - tmp6; tmp4 := tmp10 + tmp5;
tmp4 := tmp10 + tmp5;
wsptr^[DCTSIZE*0] := tmp0 + tmp7;
wsptr^[DCTSIZE*0] := tmp0 + tmp7; wsptr^[DCTSIZE*7] := tmp0 - tmp7;
wsptr^[DCTSIZE*7] := tmp0 - tmp7; wsptr^[DCTSIZE*1] := tmp1 + tmp6;
wsptr^[DCTSIZE*1] := tmp1 + tmp6; wsptr^[DCTSIZE*6] := tmp1 - tmp6;
wsptr^[DCTSIZE*6] := tmp1 - tmp6; wsptr^[DCTSIZE*2] := tmp2 + tmp5;
wsptr^[DCTSIZE*2] := tmp2 + tmp5; wsptr^[DCTSIZE*5] := tmp2 - tmp5;
wsptr^[DCTSIZE*5] := tmp2 - tmp5; wsptr^[DCTSIZE*4] := tmp3 + tmp4;
wsptr^[DCTSIZE*4] := tmp3 + tmp4; wsptr^[DCTSIZE*3] := tmp3 - tmp4;
wsptr^[DCTSIZE*3] := tmp3 - tmp4;
Inc(JCOEF_PTR(inptr)); { advance pointers to next column }
Inc(JCOEF_PTR(inptr)); { advance pointers to next column } Inc(FLOAT_MULT_TYPE_PTR(quantptr));
Inc(FLOAT_MULT_TYPE_PTR(quantptr)); Inc(FAST_FLOAT_PTR(wsptr));
Inc(FAST_FLOAT_PTR(wsptr)); end;
end;
{ Pass 2: process rows from work array, store into output array. }
{ Pass 2: process rows from work array, store into output array. } { Note that we must descale the results by a factor of 8 = 2**3. }
{ Note that we must descale the results by a factor of 8 = 2**3. }
wsptr := @workspace;
wsptr := @workspace; for ctr := 0 to pred(DCTSIZE) do
for ctr := 0 to pred(DCTSIZE) do begin
begin outptr := JSAMPROW(@(output_buf^[ctr]^[output_col]));
outptr := JSAMPROW(@(output_buf^[ctr]^[output_col])); { Rows of zeroes can be exploited in the same way as we did with columns.
{ Rows of zeroes can be exploited in the same way as we did with columns. However, the column calculation has created many nonzero AC terms, so
However, the column calculation has created many nonzero AC terms, so the simplification applies less often (typically 5% to 10% of the time).
the simplification applies less often (typically 5% to 10% of the time). And testing floats for zero is relatively expensive, so we don't bother. }
And testing floats for zero is relatively expensive, so we don't bother. }
{ Even part }
{ Even part }
tmp10 := wsptr^[0] + wsptr^[4];
tmp10 := wsptr^[0] + wsptr^[4]; tmp11 := wsptr^[0] - wsptr^[4];
tmp11 := wsptr^[0] - wsptr^[4];
tmp13 := wsptr^[2] + wsptr^[6];
tmp13 := wsptr^[2] + wsptr^[6]; tmp12 := (wsptr^[2] - wsptr^[6]) * ({FAST_FLOAT}(1.414213562)) - tmp13;
tmp12 := (wsptr^[2] - wsptr^[6]) * ({FAST_FLOAT}(1.414213562)) - tmp13;
tmp0 := tmp10 + tmp13;
tmp0 := tmp10 + tmp13; tmp3 := tmp10 - tmp13;
tmp3 := tmp10 - tmp13; tmp1 := tmp11 + tmp12;
tmp1 := tmp11 + tmp12; tmp2 := tmp11 - tmp12;
tmp2 := tmp11 - tmp12;
{ Odd part }
{ Odd part }
z13 := wsptr^[5] + wsptr^[3];
z13 := wsptr^[5] + wsptr^[3]; z10 := wsptr^[5] - wsptr^[3];
z10 := wsptr^[5] - wsptr^[3]; z11 := wsptr^[1] + wsptr^[7];
z11 := wsptr^[1] + wsptr^[7]; z12 := wsptr^[1] - wsptr^[7];
z12 := wsptr^[1] - wsptr^[7];
tmp7 := z11 + z13;
tmp7 := z11 + z13; tmp11 := (z11 - z13) * ({FAST_FLOAT}(1.414213562));
tmp11 := (z11 - z13) * ({FAST_FLOAT}(1.414213562));
z5 := (z10 + z12) * ({FAST_FLOAT}(1.847759065)); { 2*c2 }
z5 := (z10 + z12) * ({FAST_FLOAT}(1.847759065)); { 2*c2 } tmp10 := ({FAST_FLOAT}(1.082392200)) * z12 - z5; { 2*(c2-c6) }
tmp10 := ({FAST_FLOAT}(1.082392200)) * z12 - z5; { 2*(c2-c6) } tmp12 := ({FAST_FLOAT}(-2.613125930)) * z10 + z5; { -2*(c2+c6) }
tmp12 := ({FAST_FLOAT}(-2.613125930)) * z10 + z5; { -2*(c2+c6) }
tmp6 := tmp12 - tmp7;
tmp6 := tmp12 - tmp7; tmp5 := tmp11 - tmp6;
tmp5 := tmp11 - tmp6; tmp4 := tmp10 + tmp5;
tmp4 := tmp10 + tmp5;
{ Final output stage: scale down by a factor of 8 and range-limit }
{ Final output stage: scale down by a factor of 8 and range-limit }
outptr^[0] := range_limit^[ int(DESCALE( INT32(Round((tmp0 + tmp7))), 3))
outptr^[0] := range_limit^[ int(DESCALE( INT32(Round((tmp0 + tmp7))), 3)) and RANGE_MASK];
and RANGE_MASK]; outptr^[7] := range_limit^[ int(DESCALE( INT32(Round((tmp0 - tmp7))), 3))
outptr^[7] := range_limit^[ int(DESCALE( INT32(Round((tmp0 - tmp7))), 3)) and RANGE_MASK];
and RANGE_MASK]; outptr^[1] := range_limit^[ int(DESCALE( INT32(Round((tmp1 + tmp6))), 3))
outptr^[1] := range_limit^[ int(DESCALE( INT32(Round((tmp1 + tmp6))), 3)) and RANGE_MASK];
and RANGE_MASK]; outptr^[6] := range_limit^[ int(DESCALE( INT32(Round((tmp1 - tmp6))), 3))
outptr^[6] := range_limit^[ int(DESCALE( INT32(Round((tmp1 - tmp6))), 3)) and RANGE_MASK];
and RANGE_MASK]; outptr^[2] := range_limit^[ int(DESCALE( INT32(Round((tmp2 + tmp5))), 3))
outptr^[2] := range_limit^[ int(DESCALE( INT32(Round((tmp2 + tmp5))), 3)) and RANGE_MASK];
and RANGE_MASK]; outptr^[5] := range_limit^[ int(DESCALE( INT32(Round((tmp2 - tmp5))), 3))
outptr^[5] := range_limit^[ int(DESCALE( INT32(Round((tmp2 - tmp5))), 3)) and RANGE_MASK];
and RANGE_MASK]; outptr^[4] := range_limit^[ int(DESCALE( INT32(Round((tmp3 + tmp4))), 3))
outptr^[4] := range_limit^[ int(DESCALE( INT32(Round((tmp3 + tmp4))), 3)) and RANGE_MASK];
and RANGE_MASK]; outptr^[3] := range_limit^[ int(DESCALE( INT32(Round((tmp3 - tmp4))), 3))
outptr^[3] := range_limit^[ int(DESCALE( INT32(Round((tmp3 - tmp4))), 3)) and RANGE_MASK];
and RANGE_MASK];
Inc(FAST_FLOAT_PTR(wsptr), DCTSIZE); { advance pointer to next row }
Inc(FAST_FLOAT_PTR(wsptr), DCTSIZE); { advance pointer to next row } end;
end; end;
end;
end.
end.

820
Imaging/JpegLib/imjidctfst.pas
View File

@ -1,410 +1,410 @@
unit imjidctfst; unit imjidctfst;
{ This file contains a fast, not so accurate integer implementation of the { This file contains a fast, not so accurate integer implementation of the
inverse DCT (Discrete Cosine Transform). In the IJG code, this routine inverse DCT (Discrete Cosine Transform). In the IJG code, this routine
must also perform dequantization of the input coefficients. must also perform dequantization of the input coefficients.
A 2-D IDCT can be done by 1-D IDCT on each column followed by 1-D IDCT A 2-D IDCT can be done by 1-D IDCT on each column followed by 1-D IDCT
on each row (or vice versa, but it's more convenient to emit a row at on each row (or vice versa, but it's more convenient to emit a row at
a time). Direct algorithms are also available, but they are much more a time). Direct algorithms are also available, but they are much more
complex and seem not to be any faster when reduced to code. complex and seem not to be any faster when reduced to code.
This implementation is based on Arai, Agui, and Nakajima's algorithm for This implementation is based on Arai, Agui, and Nakajima's algorithm for
scaled DCT. Their original paper (Trans. IEICE E-71(11):1095) is in scaled DCT. Their original paper (Trans. IEICE E-71(11):1095) is in
Japanese, but the algorithm is described in the Pennebaker & Mitchell Japanese, but the algorithm is described in the Pennebaker & Mitchell
JPEG textbook (see REFERENCES section in file README). The following code JPEG textbook (see REFERENCES section in file README). The following code
is based directly on figure 4-8 in P&M. is based directly on figure 4-8 in P&M.
While an 8-point DCT cannot be done in less than 11 multiplies, it is While an 8-point DCT cannot be done in less than 11 multiplies, it is
possible to arrange the computation so that many of the multiplies are possible to arrange the computation so that many of the multiplies are
simple scalings of the final outputs. These multiplies can then be simple scalings of the final outputs. These multiplies can then be
folded into the multiplications or divisions by the JPEG quantization folded into the multiplications or divisions by the JPEG quantization
table entries. The AA&N method leaves only 5 multiplies and 29 adds table entries. The AA&N method leaves only 5 multiplies and 29 adds
to be done in the DCT itself. to be done in the DCT itself.
The primary disadvantage of this method is that with fixed-point math, The primary disadvantage of this method is that with fixed-point math,
accuracy is lost due to imprecise representation of the scaled accuracy is lost due to imprecise representation of the scaled
quantization values. The smaller the quantization table entry, the less quantization values. The smaller the quantization table entry, the less
precise the scaled value, so this implementation does worse with high- precise the scaled value, so this implementation does worse with high-
quality-setting files than with low-quality ones. } quality-setting files than with low-quality ones. }
{ Original : jidctfst.c ; Copyright (C) 1994-1996, Thomas G. Lane. } { Original : jidctfst.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
interface interface
{$I imjconfig.inc} {$I imjconfig.inc}
uses uses
imjmorecfg, imjmorecfg,
imjinclude, imjinclude,
imjpeglib, imjpeglib,
imjdct; { Private declarations for DCT subsystem } imjdct; { Private declarations for DCT subsystem }
{ Perform dequantization and inverse DCT on one block of coefficients. } { Perform dequantization and inverse DCT on one block of coefficients. }
{GLOBAL} {GLOBAL}
procedure jpeg_idct_ifast (cinfo : j_decompress_ptr; procedure jpeg_idct_ifast (cinfo : j_decompress_ptr;
compptr : jpeg_component_info_ptr; compptr : jpeg_component_info_ptr;
coef_block : JCOEFPTR; coef_block : JCOEFPTR;
output_buf : JSAMPARRAY; output_buf : JSAMPARRAY;
output_col : JDIMENSION); output_col : JDIMENSION);
implementation implementation
{ This module is specialized to the case DCTSIZE = 8. } { This module is specialized to the case DCTSIZE = 8. }
{$ifndef DCTSIZE_IS_8} {$ifndef DCTSIZE_IS_8}
Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err } Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err }
{$endif} {$endif}
{ Scaling decisions are generally the same as in the LL&M algorithm; { Scaling decisions are generally the same as in the LL&M algorithm;
see jidctint.c for more details. However, we choose to descale see jidctint.c for more details. However, we choose to descale
(right shift) multiplication products as soon as they are formed, (right shift) multiplication products as soon as they are formed,
rather than carrying additional fractional bits into subsequent additions. rather than carrying additional fractional bits into subsequent additions.
This compromises accuracy slightly, but it lets us save a few shifts. This compromises accuracy slightly, but it lets us save a few shifts.
More importantly, 16-bit arithmetic is then adequate (for 8-bit samples) More importantly, 16-bit arithmetic is then adequate (for 8-bit samples)
everywhere except in the multiplications proper; this saves a good deal everywhere except in the multiplications proper; this saves a good deal
of work on 16-bit-int machines. of work on 16-bit-int machines.
The dequantized coefficients are not integers because the AA&N scaling The dequantized coefficients are not integers because the AA&N scaling
factors have been incorporated. We represent them scaled up by PASS1_BITS, factors have been incorporated. We represent them scaled up by PASS1_BITS,
so that the first and second IDCT rounds have the same input scaling. so that the first and second IDCT rounds have the same input scaling.
For 8-bit JSAMPLEs, we choose IFAST_SCALE_BITS = PASS1_BITS so as to For 8-bit JSAMPLEs, we choose IFAST_SCALE_BITS = PASS1_BITS so as to
avoid a descaling shift; this compromises accuracy rather drastically avoid a descaling shift; this compromises accuracy rather drastically
for small quantization table entries, but it saves a lot of shifts. for small quantization table entries, but it saves a lot of shifts.
For 12-bit JSAMPLEs, there's no hope of using 16x16 multiplies anyway, For 12-bit JSAMPLEs, there's no hope of using 16x16 multiplies anyway,
so we use a much larger scaling factor to preserve accuracy. so we use a much larger scaling factor to preserve accuracy.
A final compromise is to represent the multiplicative constants to only A final compromise is to represent the multiplicative constants to only
8 fractional bits, rather than 13. This saves some shifting work on some 8 fractional bits, rather than 13. This saves some shifting work on some
machines, and may also reduce the cost of multiplication (since there machines, and may also reduce the cost of multiplication (since there
are fewer one-bits in the constants). } are fewer one-bits in the constants). }
{$ifdef BITS_IN_JSAMPLE_IS_8} {$ifdef BITS_IN_JSAMPLE_IS_8}
const const
CONST_BITS = 8; CONST_BITS = 8;
PASS1_BITS = 2; PASS1_BITS = 2;
{$else} {$else}
const const
CONST_BITS = 8; CONST_BITS = 8;
PASS1_BITS = 1; { lose a little precision to avoid overflow } PASS1_BITS = 1; { lose a little precision to avoid overflow }
{$endif} {$endif}
const const
FIX_1_082392200 = INT32(Round((INT32(1) shl CONST_BITS)*1.082392200)); {277} FIX_1_082392200 = INT32(Round((INT32(1) shl CONST_BITS)*1.082392200)); {277}
FIX_1_414213562 = INT32(Round((INT32(1) shl CONST_BITS)*1.414213562)); {362} FIX_1_414213562 = INT32(Round((INT32(1) shl CONST_BITS)*1.414213562)); {362}
FIX_1_847759065 = INT32(Round((INT32(1) shl CONST_BITS)*1.847759065)); {473} FIX_1_847759065 = INT32(Round((INT32(1) shl CONST_BITS)*1.847759065)); {473}
FIX_2_613125930 = INT32(Round((INT32(1) shl CONST_BITS)*2.613125930)); {669} FIX_2_613125930 = INT32(Round((INT32(1) shl CONST_BITS)*2.613125930)); {669}
{ Descale and correctly round an INT32 value that's scaled by N bits. { Descale and correctly round an INT32 value that's scaled by N bits.
We assume RIGHT_SHIFT rounds towards minus infinity, so adding We assume RIGHT_SHIFT rounds towards minus infinity, so adding
the fudge factor is correct for either sign of X. } the fudge factor is correct for either sign of X. }
function DESCALE(x : INT32; n : int) : INT32; function DESCALE(x : INT32; n : int) : INT32;
var var
shift_temp : INT32; shift_temp : INT32;
begin begin
{$ifdef USE_ACCURATE_ROUNDING} {$ifdef USE_ACCURATE_ROUNDING}
shift_temp := x + (INT32(1) shl (n-1)); shift_temp := x + (INT32(1) shl (n-1));
{$else} {$else}
{ We can gain a little more speed, with a further compromise in accuracy, { We can gain a little more speed, with a further compromise in accuracy,
by omitting the addition in a descaling shift. This yields an incorrectly by omitting the addition in a descaling shift. This yields an incorrectly
rounded result half the time... } rounded result half the time... }
shift_temp := x; shift_temp := x;
{$endif} {$endif}
{$ifdef RIGHT_SHIFT_IS_UNSIGNED} {$ifdef RIGHT_SHIFT_IS_UNSIGNED}
if shift_temp < 0 then if shift_temp < 0 then
Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n)) Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n))
else else
{$endif} {$endif}
Descale := (shift_temp shr n); Descale := (shift_temp shr n);
end; end;
{ Multiply a DCTELEM variable by an INT32 constant, and immediately { Multiply a DCTELEM variable by an INT32 constant, and immediately
descale to yield a DCTELEM result. } descale to yield a DCTELEM result. }
{(DCTELEM( DESCALE((var) * (const), CONST_BITS))} {(DCTELEM( DESCALE((var) * (const), CONST_BITS))}
function Multiply(Avar, Aconst: Integer): DCTELEM; function Multiply(Avar, Aconst: Integer): DCTELEM;
begin begin
Multiply := DCTELEM( Avar*INT32(Aconst) div (INT32(1) shl CONST_BITS)); Multiply := DCTELEM( Avar*INT32(Aconst) div (INT32(1) shl CONST_BITS));
end; end;
{ Dequantize a coefficient by multiplying it by the multiplier-table { Dequantize a coefficient by multiplying it by the multiplier-table
entry; produce a DCTELEM result. For 8-bit data a 16x16->16 entry; produce a DCTELEM result. For 8-bit data a 16x16->16
multiplication will do. For 12-bit data, the multiplier table is multiplication will do. For 12-bit data, the multiplier table is
declared INT32, so a 32-bit multiply will be used. } declared INT32, so a 32-bit multiply will be used. }
{$ifdef BITS_IN_JSAMPLE_IS_8} {$ifdef BITS_IN_JSAMPLE_IS_8}
function DEQUANTIZE(coef,quantval : int) : int; function DEQUANTIZE(coef,quantval : int) : int;
begin begin
Dequantize := ( IFAST_MULT_TYPE(coef) * quantval); Dequantize := ( IFAST_MULT_TYPE(coef) * quantval);
end; end;
{$else} {$else}
function DEQUANTIZE(coef,quantval : INT32) : int; function DEQUANTIZE(coef,quantval : INT32) : int;
begin begin
Dequantize := DESCALE((coef)*(quantval), IFAST_SCALE_BITS-PASS1_BITS); Dequantize := DESCALE((coef)*(quantval), IFAST_SCALE_BITS-PASS1_BITS);
end; end;
{$endif} {$endif}
{ Like DESCALE, but applies to a DCTELEM and produces an int. { Like DESCALE, but applies to a DCTELEM and produces an int.
We assume that int right shift is unsigned if INT32 right shift is. } We assume that int right shift is unsigned if INT32 right shift is. }
function IDESCALE(x : DCTELEM; n : int) : int; function IDESCALE(x : DCTELEM; n : int) : int;
{$ifdef BITS_IN_JSAMPLE_IS_8} {$ifdef BITS_IN_JSAMPLE_IS_8}
const const
DCTELEMBITS = 16; { DCTELEM may be 16 or 32 bits } DCTELEMBITS = 16; { DCTELEM may be 16 or 32 bits }
{$else} {$else}
const const
DCTELEMBITS = 32; { DCTELEM must be 32 bits } DCTELEMBITS = 32; { DCTELEM must be 32 bits }
{$endif} {$endif}
var var
ishift_temp : DCTELEM; ishift_temp : DCTELEM;
begin begin
{$ifndef USE_ACCURATE_ROUNDING} {$ifndef USE_ACCURATE_ROUNDING}
ishift_temp := x + (INT32(1) shl (n-1)); ishift_temp := x + (INT32(1) shl (n-1));
{$else} {$else}
{ We can gain a little more speed, with a further compromise in accuracy, { We can gain a little more speed, with a further compromise in accuracy,
by omitting the addition in a descaling shift. This yields an incorrectly by omitting the addition in a descaling shift. This yields an incorrectly
rounded result half the time... } rounded result half the time... }
ishift_temp := x; ishift_temp := x;
{$endif} {$endif}
{$ifdef RIGHT_SHIFT_IS_UNSIGNED} {$ifdef RIGHT_SHIFT_IS_UNSIGNED}
if ishift_temp < 0 then if ishift_temp < 0 then
IDescale := (ishift_temp shr n) IDescale := (ishift_temp shr n)
or ((not DCTELEM(0)) shl (DCTELEMBITS-n)) or ((not DCTELEM(0)) shl (DCTELEMBITS-n))
else else
{$endif} {$endif}
IDescale := (ishift_temp shr n); IDescale := (ishift_temp shr n);
end; end;
{ Perform dequantization and inverse DCT on one block of coefficients. } { Perform dequantization and inverse DCT on one block of coefficients. }
{GLOBAL} {GLOBAL}
procedure jpeg_idct_ifast (cinfo : j_decompress_ptr; procedure jpeg_idct_ifast (cinfo : j_decompress_ptr;
compptr : jpeg_component_info_ptr; compptr : jpeg_component_info_ptr;
coef_block : JCOEFPTR; coef_block : JCOEFPTR;
output_buf : JSAMPARRAY; output_buf : JSAMPARRAY;
output_col : JDIMENSION); output_col : JDIMENSION);
type type
PWorkspace = ^TWorkspace; PWorkspace = ^TWorkspace;
TWorkspace = coef_bits_field; { buffers data between passes } TWorkspace = coef_bits_field; { buffers data between passes }
var var
tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7 : DCTELEM; tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7 : DCTELEM;
tmp10, tmp11, tmp12, tmp13 : DCTELEM; tmp10, tmp11, tmp12, tmp13 : DCTELEM;
z5, z10, z11, z12, z13 : DCTELEM; z5, z10, z11, z12, z13 : DCTELEM;
inptr : JCOEFPTR; inptr : JCOEFPTR;
quantptr : IFAST_MULT_TYPE_FIELD_PTR; quantptr : IFAST_MULT_TYPE_FIELD_PTR;
wsptr : PWorkspace; wsptr : PWorkspace;
outptr : JSAMPROW; outptr : JSAMPROW;
range_limit : JSAMPROW; range_limit : JSAMPROW;
ctr : int; ctr : int;
workspace : TWorkspace; { buffers data between passes } workspace : TWorkspace; { buffers data between passes }
{SHIFT_TEMPS} { for DESCALE } {SHIFT_TEMPS} { for DESCALE }
{ISHIFT_TEMPS} { for IDESCALE } {ISHIFT_TEMPS} { for IDESCALE }
var var
dcval : int; dcval : int;
var var
dcval_ : JSAMPLE; dcval_ : JSAMPLE;
begin begin
{ Each IDCT routine is responsible for range-limiting its results and { Each IDCT routine is responsible for range-limiting its results and
converting them to unsigned form (0..MAXJSAMPLE). The raw outputs could converting them to unsigned form (0..MAXJSAMPLE). The raw outputs could
be quite far out of range if the input data is corrupt, so a bulletproof be quite far out of range if the input data is corrupt, so a bulletproof
range-limiting step is required. We use a mask-and-table-lookup method range-limiting step is required. We use a mask-and-table-lookup method
to do the combined operations quickly. See the comments with to do the combined operations quickly. See the comments with
prepare_range_limit_table (in jdmaster.c) for more info. } prepare_range_limit_table (in jdmaster.c) for more info. }
range_limit := JSAMPROW(@(cinfo^.sample_range_limit^[CENTERJSAMPLE])); range_limit := JSAMPROW(@(cinfo^.sample_range_limit^[CENTERJSAMPLE]));
{ Pass 1: process columns from input, store into work array. } { Pass 1: process columns from input, store into work array. }
inptr := coef_block; inptr := coef_block;
quantptr := IFAST_MULT_TYPE_FIELD_PTR(compptr^.dct_table); quantptr := IFAST_MULT_TYPE_FIELD_PTR(compptr^.dct_table);
wsptr := @workspace; wsptr := @workspace;
for ctr := pred(DCTSIZE) downto 0 do for ctr := pred(DCTSIZE) downto 0 do
begin begin
{ Due to quantization, we will usually find that many of the input { Due to quantization, we will usually find that many of the input
coefficients are zero, especially the AC terms. We can exploit this coefficients are zero, especially the AC terms. We can exploit this
by short-circuiting the IDCT calculation for any column in which all by short-circuiting the IDCT calculation for any column in which all
the AC terms are zero. In that case each output is equal to the the AC terms are zero. In that case each output is equal to the
DC coefficient (with scale factor as needed). DC coefficient (with scale factor as needed).
With typical images and quantization tables, half or more of the With typical images and quantization tables, half or more of the
column DCT calculations can be simplified this way. } column DCT calculations can be simplified this way. }
if (inptr^[DCTSIZE*1]=0) and (inptr^[DCTSIZE*2]=0) and (inptr^[DCTSIZE*3]=0) and if (inptr^[DCTSIZE*1]=0) and (inptr^[DCTSIZE*2]=0) and (inptr^[DCTSIZE*3]=0) and
(inptr^[DCTSIZE*4]=0) and (inptr^[DCTSIZE*5]=0) and (inptr^[DCTSIZE*6]=0) and (inptr^[DCTSIZE*4]=0) and (inptr^[DCTSIZE*5]=0) and (inptr^[DCTSIZE*6]=0) and
(inptr^[DCTSIZE*7]=0) then (inptr^[DCTSIZE*7]=0) then
begin begin
{ AC terms all zero } { AC terms all zero }
dcval := int(DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0])); dcval := int(DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]));
wsptr^[DCTSIZE*0] := dcval; wsptr^[DCTSIZE*0] := dcval;
wsptr^[DCTSIZE*1] := dcval; wsptr^[DCTSIZE*1] := dcval;
wsptr^[DCTSIZE*2] := dcval; wsptr^[DCTSIZE*2] := dcval;
wsptr^[DCTSIZE*3] := dcval; wsptr^[DCTSIZE*3] := dcval;
wsptr^[DCTSIZE*4] := dcval; wsptr^[DCTSIZE*4] := dcval;
wsptr^[DCTSIZE*5] := dcval; wsptr^[DCTSIZE*5] := dcval;
wsptr^[DCTSIZE*6] := dcval; wsptr^[DCTSIZE*6] := dcval;
wsptr^[DCTSIZE*7] := dcval; wsptr^[DCTSIZE*7] := dcval;
Inc(JCOEF_PTR(inptr)); { advance pointers to next column } Inc(JCOEF_PTR(inptr)); { advance pointers to next column }
Inc(IFAST_MULT_TYPE_PTR(quantptr)); Inc(IFAST_MULT_TYPE_PTR(quantptr));
Inc(int_ptr(wsptr)); Inc(int_ptr(wsptr));
continue; continue;
end; end;
{ Even part } { Even part }
tmp0 := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]); tmp0 := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]);
tmp1 := DEQUANTIZE(inptr^[DCTSIZE*2], quantptr^[DCTSIZE*2]); tmp1 := DEQUANTIZE(inptr^[DCTSIZE*2], quantptr^[DCTSIZE*2]);
tmp2 := DEQUANTIZE(inptr^[DCTSIZE*4], quantptr^[DCTSIZE*4]); tmp2 := DEQUANTIZE(inptr^[DCTSIZE*4], quantptr^[DCTSIZE*4]);
tmp3 := DEQUANTIZE(inptr^[DCTSIZE*6], quantptr^[DCTSIZE*6]); tmp3 := DEQUANTIZE(inptr^[DCTSIZE*6], quantptr^[DCTSIZE*6]);
tmp10 := tmp0 + tmp2; { phase 3 } tmp10 := tmp0 + tmp2; { phase 3 }
tmp11 := tmp0 - tmp2; tmp11 := tmp0 - tmp2;
tmp13 := tmp1 + tmp3; { phases 5-3 } tmp13 := tmp1 + tmp3; { phases 5-3 }
tmp12 := MULTIPLY(tmp1 - tmp3, FIX_1_414213562) - tmp13; { 2*c4 } tmp12 := MULTIPLY(tmp1 - tmp3, FIX_1_414213562) - tmp13; { 2*c4 }
tmp0 := tmp10 + tmp13; { phase 2 } tmp0 := tmp10 + tmp13; { phase 2 }
tmp3 := tmp10 - tmp13; tmp3 := tmp10 - tmp13;
tmp1 := tmp11 + tmp12; tmp1 := tmp11 + tmp12;
tmp2 := tmp11 - tmp12; tmp2 := tmp11 - tmp12;
{ Odd part } { Odd part }
tmp4 := DEQUANTIZE(inptr^[DCTSIZE*1], quantptr^[DCTSIZE*1]); tmp4 := DEQUANTIZE(inptr^[DCTSIZE*1], quantptr^[DCTSIZE*1]);
tmp5 := DEQUANTIZE(inptr^[DCTSIZE*3], quantptr^[DCTSIZE*3]); tmp5 := DEQUANTIZE(inptr^[DCTSIZE*3], quantptr^[DCTSIZE*3]);
tmp6 := DEQUANTIZE(inptr^[DCTSIZE*5], quantptr^[DCTSIZE*5]); tmp6 := DEQUANTIZE(inptr^[DCTSIZE*5], quantptr^[DCTSIZE*5]);
tmp7 := DEQUANTIZE(inptr^[DCTSIZE*7], quantptr^[DCTSIZE*7]); tmp7 := DEQUANTIZE(inptr^[DCTSIZE*7], quantptr^[DCTSIZE*7]);
z13 := tmp6 + tmp5; { phase 6 } z13 := tmp6 + tmp5; { phase 6 }
z10 := tmp6 - tmp5; z10 := tmp6 - tmp5;
z11 := tmp4 + tmp7; z11 := tmp4 + tmp7;
z12 := tmp4 - tmp7; z12 := tmp4 - tmp7;
tmp7 := z11 + z13; { phase 5 } tmp7 := z11 + z13; { phase 5 }
tmp11 := MULTIPLY(z11 - z13, FIX_1_414213562); { 2*c4 } tmp11 := MULTIPLY(z11 - z13, FIX_1_414213562); { 2*c4 }
z5 := MULTIPLY(z10 + z12, FIX_1_847759065); { 2*c2 } z5 := MULTIPLY(z10 + z12, FIX_1_847759065); { 2*c2 }
tmp10 := MULTIPLY(z12, FIX_1_082392200) - z5; { 2*(c2-c6) } tmp10 := MULTIPLY(z12, FIX_1_082392200) - z5; { 2*(c2-c6) }
tmp12 := MULTIPLY(z10, - FIX_2_613125930) + z5; { -2*(c2+c6) } tmp12 := MULTIPLY(z10, - FIX_2_613125930) + z5; { -2*(c2+c6) }
tmp6 := tmp12 - tmp7; { phase 2 } tmp6 := tmp12 - tmp7; { phase 2 }
tmp5 := tmp11 - tmp6; tmp5 := tmp11 - tmp6;
tmp4 := tmp10 + tmp5; tmp4 := tmp10 + tmp5;
wsptr^[DCTSIZE*0] := int (tmp0 + tmp7); wsptr^[DCTSIZE*0] := int (tmp0 + tmp7);
wsptr^[DCTSIZE*7] := int (tmp0 - tmp7); wsptr^[DCTSIZE*7] := int (tmp0 - tmp7);
wsptr^[DCTSIZE*1] := int (tmp1 + tmp6); wsptr^[DCTSIZE*1] := int (tmp1 + tmp6);
wsptr^[DCTSIZE*6] := int (tmp1 - tmp6); wsptr^[DCTSIZE*6] := int (tmp1 - tmp6);
wsptr^[DCTSIZE*2] := int (tmp2 + tmp5); wsptr^[DCTSIZE*2] := int (tmp2 + tmp5);
wsptr^[DCTSIZE*5] := int (tmp2 - tmp5); wsptr^[DCTSIZE*5] := int (tmp2 - tmp5);
wsptr^[DCTSIZE*4] := int (tmp3 + tmp4); wsptr^[DCTSIZE*4] := int (tmp3 + tmp4);
wsptr^[DCTSIZE*3] := int (tmp3 - tmp4); wsptr^[DCTSIZE*3] := int (tmp3 - tmp4);
Inc(JCOEF_PTR(inptr)); { advance pointers to next column } Inc(JCOEF_PTR(inptr)); { advance pointers to next column }
Inc(IFAST_MULT_TYPE_PTR(quantptr)); Inc(IFAST_MULT_TYPE_PTR(quantptr));
Inc(int_ptr(wsptr)); Inc(int_ptr(wsptr));
end; end;
{ Pass 2: process rows from work array, store into output array. } { Pass 2: process rows from work array, store into output array. }
{ Note that we must descale the results by a factor of 8 == 2**3, } { Note that we must descale the results by a factor of 8 == 2**3, }
{ and also undo the PASS1_BITS scaling. } { and also undo the PASS1_BITS scaling. }
wsptr := @workspace; wsptr := @workspace;
for ctr := 0 to pred(DCTSIZE) do for ctr := 0 to pred(DCTSIZE) do
begin begin
outptr := JSAMPROW(@output_buf^[ctr]^[output_col]); outptr := JSAMPROW(@output_buf^[ctr]^[output_col]);
{ Rows of zeroes can be exploited in the same way as we did with columns. { Rows of zeroes can be exploited in the same way as we did with columns.
However, the column calculation has created many nonzero AC terms, so However, the column calculation has created many nonzero AC terms, so
the simplification applies less often (typically 5% to 10% of the time). the simplification applies less often (typically 5% to 10% of the time).
On machines with very fast multiplication, it's possible that the On machines with very fast multiplication, it's possible that the
test takes more time than it's worth. In that case this section test takes more time than it's worth. In that case this section
may be commented out. } may be commented out. }
{$ifndef NO_ZERO_ROW_TEST} {$ifndef NO_ZERO_ROW_TEST}
if (wsptr^[1]=0) and (wsptr^[2]=0) and (wsptr^[3]=0) and (wsptr^[4]=0) and if (wsptr^[1]=0) and (wsptr^[2]=0) and (wsptr^[3]=0) and (wsptr^[4]=0) and
(wsptr^[5]=0) and (wsptr^[6]=0) and (wsptr^[7]=0) then (wsptr^[5]=0) and (wsptr^[6]=0) and (wsptr^[7]=0) then
begin begin
{ AC terms all zero } { AC terms all zero }
dcval_ := range_limit^[IDESCALE(wsptr^[0], PASS1_BITS+3) dcval_ := range_limit^[IDESCALE(wsptr^[0], PASS1_BITS+3)
and RANGE_MASK]; and RANGE_MASK];
outptr^[0] := dcval_; outptr^[0] := dcval_;
outptr^[1] := dcval_; outptr^[1] := dcval_;
outptr^[2] := dcval_; outptr^[2] := dcval_;
outptr^[3] := dcval_; outptr^[3] := dcval_;
outptr^[4] := dcval_; outptr^[4] := dcval_;
outptr^[5] := dcval_; outptr^[5] := dcval_;
outptr^[6] := dcval_; outptr^[6] := dcval_;
outptr^[7] := dcval_; outptr^[7] := dcval_;
Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row }
continue; continue;
end; end;
{$endif} {$endif}
{ Even part } { Even part }
tmp10 := (DCTELEM(wsptr^[0]) + DCTELEM(wsptr^[4])); tmp10 := (DCTELEM(wsptr^[0]) + DCTELEM(wsptr^[4]));
tmp11 := (DCTELEM(wsptr^[0]) - DCTELEM(wsptr^[4])); tmp11 := (DCTELEM(wsptr^[0]) - DCTELEM(wsptr^[4]));
tmp13 := (DCTELEM(wsptr^[2]) + DCTELEM(wsptr^[6])); tmp13 := (DCTELEM(wsptr^[2]) + DCTELEM(wsptr^[6]));
tmp12 := MULTIPLY(DCTELEM(wsptr^[2]) - DCTELEM(wsptr^[6]), FIX_1_414213562) tmp12 := MULTIPLY(DCTELEM(wsptr^[2]) - DCTELEM(wsptr^[6]), FIX_1_414213562)
- tmp13; - tmp13;
tmp0 := tmp10 + tmp13; tmp0 := tmp10 + tmp13;
tmp3 := tmp10 - tmp13; tmp3 := tmp10 - tmp13;
tmp1 := tmp11 + tmp12; tmp1 := tmp11 + tmp12;
tmp2 := tmp11 - tmp12; tmp2 := tmp11 - tmp12;
{ Odd part } { Odd part }
z13 := DCTELEM(wsptr^[5]) + DCTELEM(wsptr^[3]); z13 := DCTELEM(wsptr^[5]) + DCTELEM(wsptr^[3]);
z10 := DCTELEM(wsptr^[5]) - DCTELEM(wsptr^[3]); z10 := DCTELEM(wsptr^[5]) - DCTELEM(wsptr^[3]);
z11 := DCTELEM(wsptr^[1]) + DCTELEM(wsptr^[7]); z11 := DCTELEM(wsptr^[1]) + DCTELEM(wsptr^[7]);
z12 := DCTELEM(wsptr^[1]) - DCTELEM(wsptr^[7]); z12 := DCTELEM(wsptr^[1]) - DCTELEM(wsptr^[7]);
tmp7 := z11 + z13; { phase 5 } tmp7 := z11 + z13; { phase 5 }
tmp11 := MULTIPLY(z11 - z13, FIX_1_414213562); { 2*c4 } tmp11 := MULTIPLY(z11 - z13, FIX_1_414213562); { 2*c4 }
z5 := MULTIPLY(z10 + z12, FIX_1_847759065); { 2*c2 } z5 := MULTIPLY(z10 + z12, FIX_1_847759065); { 2*c2 }
tmp10 := MULTIPLY(z12, FIX_1_082392200) - z5; { 2*(c2-c6) } tmp10 := MULTIPLY(z12, FIX_1_082392200) - z5; { 2*(c2-c6) }
tmp12 := MULTIPLY(z10, - FIX_2_613125930) + z5; { -2*(c2+c6) } tmp12 := MULTIPLY(z10, - FIX_2_613125930) + z5; { -2*(c2+c6) }
tmp6 := tmp12 - tmp7; { phase 2 } tmp6 := tmp12 - tmp7; { phase 2 }
tmp5 := tmp11 - tmp6; tmp5 := tmp11 - tmp6;
tmp4 := tmp10 + tmp5; tmp4 := tmp10 + tmp5;
{ Final output stage: scale down by a factor of 8 and range-limit } { Final output stage: scale down by a factor of 8 and range-limit }
outptr^[0] := range_limit^[IDESCALE(tmp0 + tmp7, PASS1_BITS+3) outptr^[0] := range_limit^[IDESCALE(tmp0 + tmp7, PASS1_BITS+3)
and RANGE_MASK]; and RANGE_MASK];
outptr^[7] := range_limit^[IDESCALE(tmp0 - tmp7, PASS1_BITS+3) outptr^[7] := range_limit^[IDESCALE(tmp0 - tmp7, PASS1_BITS+3)
and RANGE_MASK]; and RANGE_MASK];
outptr^[1] := range_limit^[IDESCALE(tmp1 + tmp6, PASS1_BITS+3) outptr^[1] := range_limit^[IDESCALE(tmp1 + tmp6, PASS1_BITS+3)
and RANGE_MASK]; and RANGE_MASK];
outptr^[6] := range_limit^[IDESCALE(tmp1 - tmp6, PASS1_BITS+3) outptr^[6] := range_limit^[IDESCALE(tmp1 - tmp6, PASS1_BITS+3)
and RANGE_MASK]; and RANGE_MASK];
outptr^[2] := range_limit^[IDESCALE(tmp2 + tmp5, PASS1_BITS+3) outptr^[2] := range_limit^[IDESCALE(tmp2 + tmp5, PASS1_BITS+3)
and RANGE_MASK]; and RANGE_MASK];
outptr^[5] := range_limit^[IDESCALE(tmp2 - tmp5, PASS1_BITS+3) outptr^[5] := range_limit^[IDESCALE(tmp2 - tmp5, PASS1_BITS+3)
and RANGE_MASK]; and RANGE_MASK];
outptr^[4] := range_limit^[IDESCALE(tmp3 + tmp4, PASS1_BITS+3) outptr^[4] := range_limit^[IDESCALE(tmp3 + tmp4, PASS1_BITS+3)
and RANGE_MASK]; and RANGE_MASK];
outptr^[3] := range_limit^[IDESCALE(tmp3 - tmp4, PASS1_BITS+3) outptr^[3] := range_limit^[IDESCALE(tmp3 - tmp4, PASS1_BITS+3)
and RANGE_MASK]; and RANGE_MASK];
Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row }
end; end;
end; end;
end. end.

880
Imaging/JpegLib/imjidctint.pas
View File

@ -1,440 +1,440 @@
unit imjidctint; unit imjidctint;
{$Q+} {$Q+}
{ This file contains a slow-but-accurate integer implementation of the { This file contains a slow-but-accurate integer implementation of the
inverse DCT (Discrete Cosine Transform). In the IJG code, this routine inverse DCT (Discrete Cosine Transform). In the IJG code, this routine
must also perform dequantization of the input coefficients. must also perform dequantization of the input coefficients.
A 2-D IDCT can be done by 1-D IDCT on each column followed by 1-D IDCT A 2-D IDCT can be done by 1-D IDCT on each column followed by 1-D IDCT
on each row (or vice versa, but it's more convenient to emit a row at on each row (or vice versa, but it's more convenient to emit a row at
a time). Direct algorithms are also available, but they are much more a time). Direct algorithms are also available, but they are much more
complex and seem not to be any faster when reduced to code. complex and seem not to be any faster when reduced to code.
This implementation is based on an algorithm described in This implementation is based on an algorithm described in
C. Loeffler, A. Ligtenberg and G. Moschytz, "Practical Fast 1-D DCT C. Loeffler, A. Ligtenberg and G. Moschytz, "Practical Fast 1-D DCT
Algorithms with 11 Multiplications", Proc. Int'l. Conf. on Acoustics, Algorithms with 11 Multiplications", Proc. Int'l. Conf. on Acoustics,
Speech, and Signal Processing 1989 (ICASSP '89), pp. 988-991. Speech, and Signal Processing 1989 (ICASSP '89), pp. 988-991.
The primary algorithm described there uses 11 multiplies and 29 adds. The primary algorithm described there uses 11 multiplies and 29 adds.
We use their alternate method with 12 multiplies and 32 adds. We use their alternate method with 12 multiplies and 32 adds.
The advantage of this method is that no data path contains more than one The advantage of this method is that no data path contains more than one
multiplication; this allows a very simple and accurate implementation in multiplication; this allows a very simple and accurate implementation in
scaled fixed-point arithmetic, with a minimal number of shifts. } scaled fixed-point arithmetic, with a minimal number of shifts. }
{ Original : jidctint.c ; Copyright (C) 1991-1998, Thomas G. Lane. } { Original : jidctint.c ; Copyright (C) 1991-1998, Thomas G. Lane. }
interface interface
{$I imjconfig.inc} {$I imjconfig.inc}
uses uses
imjmorecfg, imjmorecfg,
imjinclude, imjinclude,
imjpeglib, imjpeglib,
imjdct; { Private declarations for DCT subsystem } imjdct; { Private declarations for DCT subsystem }
{ Perform dequantization and inverse DCT on one block of coefficients. } { Perform dequantization and inverse DCT on one block of coefficients. }
{GLOBAL} {GLOBAL}
procedure jpeg_idct_islow (cinfo : j_decompress_ptr; procedure jpeg_idct_islow (cinfo : j_decompress_ptr;
compptr : jpeg_component_info_ptr; compptr : jpeg_component_info_ptr;
coef_block : JCOEFPTR; coef_block : JCOEFPTR;
output_buf : JSAMPARRAY; output_buf : JSAMPARRAY;
output_col : JDIMENSION); output_col : JDIMENSION);
implementation implementation
{ This module is specialized to the case DCTSIZE = 8. } { This module is specialized to the case DCTSIZE = 8. }
{$ifndef DCTSIZE_IS_8} {$ifndef DCTSIZE_IS_8}
Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err } Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err }
{$endif} {$endif}
{ The poop on this scaling stuff is as follows: { The poop on this scaling stuff is as follows:
Each 1-D IDCT step produces outputs which are a factor of sqrt(N) Each 1-D IDCT step produces outputs which are a factor of sqrt(N)
larger than the true IDCT outputs. The final outputs are therefore larger than the true IDCT outputs. The final outputs are therefore
a factor of N larger than desired; since N=8 this can be cured by a factor of N larger than desired; since N=8 this can be cured by
a simple right shift at the end of the algorithm. The advantage of a simple right shift at the end of the algorithm. The advantage of
this arrangement is that we save two multiplications per 1-D IDCT, this arrangement is that we save two multiplications per 1-D IDCT,
because the y0 and y4 inputs need not be divided by sqrt(N). because the y0 and y4 inputs need not be divided by sqrt(N).
We have to do addition and subtraction of the integer inputs, which We have to do addition and subtraction of the integer inputs, which
is no problem, and multiplication by fractional constants, which is is no problem, and multiplication by fractional constants, which is
a problem to do in integer arithmetic. We multiply all the constants a problem to do in integer arithmetic. We multiply all the constants
by CONST_SCALE and convert them to integer constants (thus retaining by CONST_SCALE and convert them to integer constants (thus retaining
CONST_BITS bits of precision in the constants). After doing a CONST_BITS bits of precision in the constants). After doing a
multiplication we have to divide the product by CONST_SCALE, with proper multiplication we have to divide the product by CONST_SCALE, with proper
rounding, to produce the correct output. This division can be done rounding, to produce the correct output. This division can be done
cheaply as a right shift of CONST_BITS bits. We postpone shifting cheaply as a right shift of CONST_BITS bits. We postpone shifting
as long as possible so that partial sums can be added together with as long as possible so that partial sums can be added together with
full fractional precision. full fractional precision.
The outputs of the first pass are scaled up by PASS1_BITS bits so that The outputs of the first pass are scaled up by PASS1_BITS bits so that
they are represented to better-than-integral precision. These outputs they are represented to better-than-integral precision. These outputs
require BITS_IN_JSAMPLE + PASS1_BITS + 3 bits; this fits in a 16-bit word require BITS_IN_JSAMPLE + PASS1_BITS + 3 bits; this fits in a 16-bit word
with the recommended scaling. (To scale up 12-bit sample data further, an with the recommended scaling. (To scale up 12-bit sample data further, an
intermediate INT32 array would be needed.) intermediate INT32 array would be needed.)
To avoid overflow of the 32-bit intermediate results in pass 2, we must To avoid overflow of the 32-bit intermediate results in pass 2, we must
have BITS_IN_JSAMPLE + CONST_BITS + PASS1_BITS <= 26. Error analysis have BITS_IN_JSAMPLE + CONST_BITS + PASS1_BITS <= 26. Error analysis
shows that the values given below are the most effective. } shows that the values given below are the most effective. }
{$ifdef BITS_IN_JSAMPLE_IS_8} {$ifdef BITS_IN_JSAMPLE_IS_8}
const const
CONST_BITS = 13; CONST_BITS = 13;
PASS1_BITS = 2; PASS1_BITS = 2;
{$else} {$else}
const const
CONST_BITS = 13; CONST_BITS = 13;
PASS1_BITS = 1; { lose a little precision to avoid overflow } PASS1_BITS = 1; { lose a little precision to avoid overflow }
{$endif} {$endif}
const const
CONST_SCALE = (INT32(1) shl CONST_BITS); CONST_SCALE = (INT32(1) shl CONST_BITS);
const const
FIX_0_298631336 = INT32(Round(CONST_SCALE * 0.298631336)); {2446} FIX_0_298631336 = INT32(Round(CONST_SCALE * 0.298631336)); {2446}
FIX_0_390180644 = INT32(Round(CONST_SCALE * 0.390180644)); {3196} FIX_0_390180644 = INT32(Round(CONST_SCALE * 0.390180644)); {3196}
FIX_0_541196100 = INT32(Round(CONST_SCALE * 0.541196100)); {4433} FIX_0_541196100 = INT32(Round(CONST_SCALE * 0.541196100)); {4433}
FIX_0_765366865 = INT32(Round(CONST_SCALE * 0.765366865)); {6270} FIX_0_765366865 = INT32(Round(CONST_SCALE * 0.765366865)); {6270}
FIX_0_899976223 = INT32(Round(CONST_SCALE * 0.899976223)); {7373} FIX_0_899976223 = INT32(Round(CONST_SCALE * 0.899976223)); {7373}
FIX_1_175875602 = INT32(Round(CONST_SCALE * 1.175875602)); {9633} FIX_1_175875602 = INT32(Round(CONST_SCALE * 1.175875602)); {9633}
FIX_1_501321110 = INT32(Round(CONST_SCALE * 1.501321110)); {12299} FIX_1_501321110 = INT32(Round(CONST_SCALE * 1.501321110)); {12299}
FIX_1_847759065 = INT32(Round(CONST_SCALE * 1.847759065)); {15137} FIX_1_847759065 = INT32(Round(CONST_SCALE * 1.847759065)); {15137}
FIX_1_961570560 = INT32(Round(CONST_SCALE * 1.961570560)); {16069} FIX_1_961570560 = INT32(Round(CONST_SCALE * 1.961570560)); {16069}
FIX_2_053119869 = INT32(Round(CONST_SCALE * 2.053119869)); {16819} FIX_2_053119869 = INT32(Round(CONST_SCALE * 2.053119869)); {16819}
FIX_2_562915447 = INT32(Round(CONST_SCALE * 2.562915447)); {20995} FIX_2_562915447 = INT32(Round(CONST_SCALE * 2.562915447)); {20995}
FIX_3_072711026 = INT32(Round(CONST_SCALE * 3.072711026)); {25172} FIX_3_072711026 = INT32(Round(CONST_SCALE * 3.072711026)); {25172}
{ Multiply an INT32 variable by an INT32 constant to yield an INT32 result. { Multiply an INT32 variable by an INT32 constant to yield an INT32 result.
For 8-bit samples with the recommended scaling, all the variable For 8-bit samples with the recommended scaling, all the variable
and constant values involved are no more than 16 bits wide, so a and constant values involved are no more than 16 bits wide, so a
16x16->32 bit multiply can be used instead of a full 32x32 multiply. 16x16->32 bit multiply can be used instead of a full 32x32 multiply.
For 12-bit samples, a full 32-bit multiplication will be needed. } For 12-bit samples, a full 32-bit multiplication will be needed. }
{$ifdef BITS_IN_JSAMPLE_IS_8} {$ifdef BITS_IN_JSAMPLE_IS_8}
{$IFDEF BASM16} {$IFDEF BASM16}
{$IFNDEF WIN32} {$IFNDEF WIN32}
{MULTIPLY16C16(var,const)} {MULTIPLY16C16(var,const)}
function Multiply(X, Y: Integer): integer; assembler; function Multiply(X, Y: Integer): integer; assembler;
asm asm
mov ax, X mov ax, X
imul Y imul Y
mov al, ah mov al, ah
mov ah, dl mov ah, dl
end; end;
{$ENDIF} {$ENDIF}
{$ENDIF} {$ENDIF}
function Multiply(X, Y: INT32): INT32; function Multiply(X, Y: INT32): INT32;
begin begin
Multiply := INT32(X) * INT32(Y); Multiply := INT32(X) * INT32(Y);
end; end;
{$else} {$else}
{#define MULTIPLY(var,const) ((var) * (const))} {#define MULTIPLY(var,const) ((var) * (const))}
function Multiply(X, Y: INT32): INT32; function Multiply(X, Y: INT32): INT32;
begin begin
Multiply := INT32(X) * INT32(Y); Multiply := INT32(X) * INT32(Y);
end; end;
{$endif} {$endif}
{ Dequantize a coefficient by multiplying it by the multiplier-table { Dequantize a coefficient by multiplying it by the multiplier-table
entry; produce an int result. In this module, both inputs and result entry; produce an int result. In this module, both inputs and result
are 16 bits or less, so either int or short multiply will work. } are 16 bits or less, so either int or short multiply will work. }
function DEQUANTIZE(coef,quantval : int) : int; function DEQUANTIZE(coef,quantval : int) : int;
begin begin
Dequantize := ( ISLOW_MULT_TYPE(coef) * quantval); Dequantize := ( ISLOW_MULT_TYPE(coef) * quantval);
end; end;
{ Descale and correctly round an INT32 value that's scaled by N bits. { Descale and correctly round an INT32 value that's scaled by N bits.
We assume RIGHT_SHIFT rounds towards minus infinity, so adding We assume RIGHT_SHIFT rounds towards minus infinity, so adding
the fudge factor is correct for either sign of X. } the fudge factor is correct for either sign of X. }
function DESCALE(x : INT32; n : int) : INT32; function DESCALE(x : INT32; n : int) : INT32;
var var
shift_temp : INT32; shift_temp : INT32;
begin begin
{$ifdef RIGHT_SHIFT_IS_UNSIGNED} {$ifdef RIGHT_SHIFT_IS_UNSIGNED}
shift_temp := x + (INT32(1) shl (n-1)); shift_temp := x + (INT32(1) shl (n-1));
if shift_temp < 0 then if shift_temp < 0 then
Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n)) Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n))
else else
Descale := (shift_temp shr n); Descale := (shift_temp shr n);
{$else} {$else}
Descale := (x + (INT32(1) shl (n-1)) shr n; Descale := (x + (INT32(1) shl (n-1)) shr n;
{$endif} {$endif}
end; end;
{ Perform dequantization and inverse DCT on one block of coefficients. } { Perform dequantization and inverse DCT on one block of coefficients. }
{GLOBAL} {GLOBAL}
procedure jpeg_idct_islow (cinfo : j_decompress_ptr; procedure jpeg_idct_islow (cinfo : j_decompress_ptr;
compptr : jpeg_component_info_ptr; compptr : jpeg_component_info_ptr;
coef_block : JCOEFPTR; coef_block : JCOEFPTR;
output_buf : JSAMPARRAY; output_buf : JSAMPARRAY;
output_col : JDIMENSION); output_col : JDIMENSION);
type type
PWorkspace = ^TWorkspace; PWorkspace = ^TWorkspace;
TWorkspace = coef_bits_field; { buffers data between passes } TWorkspace = coef_bits_field; { buffers data between passes }
var var
tmp0, tmp1, tmp2, tmp3 : INT32; tmp0, tmp1, tmp2, tmp3 : INT32;
tmp10, tmp11, tmp12, tmp13 : INT32; tmp10, tmp11, tmp12, tmp13 : INT32;
z1, z2, z3, z4, z5 : INT32; z1, z2, z3, z4, z5 : INT32;
inptr : JCOEFPTR; inptr : JCOEFPTR;
quantptr : ISLOW_MULT_TYPE_FIELD_PTR; quantptr : ISLOW_MULT_TYPE_FIELD_PTR;
wsptr : PWorkspace; wsptr : PWorkspace;
outptr : JSAMPROW; outptr : JSAMPROW;
range_limit : JSAMPROW; range_limit : JSAMPROW;
ctr : int; ctr : int;
workspace : TWorkspace; workspace : TWorkspace;
{SHIFT_TEMPS} {SHIFT_TEMPS}
var var
dcval : int; dcval : int;
var var
dcval_ : JSAMPLE; dcval_ : JSAMPLE;
begin begin
{ Each IDCT routine is responsible for range-limiting its results and { Each IDCT routine is responsible for range-limiting its results and
converting them to unsigned form (0..MAXJSAMPLE). The raw outputs could converting them to unsigned form (0..MAXJSAMPLE). The raw outputs could
be quite far out of range if the input data is corrupt, so a bulletproof be quite far out of range if the input data is corrupt, so a bulletproof
range-limiting step is required. We use a mask-and-table-lookup method range-limiting step is required. We use a mask-and-table-lookup method
to do the combined operations quickly. See the comments with to do the combined operations quickly. See the comments with
prepare_range_limit_table (in jdmaster.c) for more info. } prepare_range_limit_table (in jdmaster.c) for more info. }
range_limit := JSAMPROW(@(cinfo^.sample_range_limit^[CENTERJSAMPLE])); range_limit := JSAMPROW(@(cinfo^.sample_range_limit^[CENTERJSAMPLE]));
{ Pass 1: process columns from input, store into work array. } { Pass 1: process columns from input, store into work array. }
{ Note results are scaled up by sqrt(8) compared to a true IDCT; } { Note results are scaled up by sqrt(8) compared to a true IDCT; }
{ furthermore, we scale the results by 2**PASS1_BITS. } { furthermore, we scale the results by 2**PASS1_BITS. }
inptr := coef_block; inptr := coef_block;
quantptr := ISLOW_MULT_TYPE_FIELD_PTR (compptr^.dct_table); quantptr := ISLOW_MULT_TYPE_FIELD_PTR (compptr^.dct_table);
wsptr := PWorkspace(@workspace); wsptr := PWorkspace(@workspace);
for ctr := pred(DCTSIZE) downto 0 do for ctr := pred(DCTSIZE) downto 0 do
begin begin
{ Due to quantization, we will usually find that many of the input { Due to quantization, we will usually find that many of the input
coefficients are zero, especially the AC terms. We can exploit this coefficients are zero, especially the AC terms. We can exploit this
by short-circuiting the IDCT calculation for any column in which all by short-circuiting the IDCT calculation for any column in which all
the AC terms are zero. In that case each output is equal to the the AC terms are zero. In that case each output is equal to the
DC coefficient (with scale factor as needed). DC coefficient (with scale factor as needed).
With typical images and quantization tables, half or more of the With typical images and quantization tables, half or more of the
column DCT calculations can be simplified this way. } column DCT calculations can be simplified this way. }
if ((inptr^[DCTSIZE*1]=0) and (inptr^[DCTSIZE*2]=0) and if ((inptr^[DCTSIZE*1]=0) and (inptr^[DCTSIZE*2]=0) and
(inptr^[DCTSIZE*3]=0) and (inptr^[DCTSIZE*4]=0) and (inptr^[DCTSIZE*3]=0) and (inptr^[DCTSIZE*4]=0) and
(inptr^[DCTSIZE*5]=0) and (inptr^[DCTSIZE*6]=0) and (inptr^[DCTSIZE*5]=0) and (inptr^[DCTSIZE*6]=0) and
(inptr^[DCTSIZE*7]=0)) then (inptr^[DCTSIZE*7]=0)) then
begin begin
{ AC terms all zero } { AC terms all zero }
dcval := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]) shl PASS1_BITS; dcval := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]) shl PASS1_BITS;
wsptr^[DCTSIZE*0] := dcval; wsptr^[DCTSIZE*0] := dcval;
wsptr^[DCTSIZE*1] := dcval; wsptr^[DCTSIZE*1] := dcval;
wsptr^[DCTSIZE*2] := dcval; wsptr^[DCTSIZE*2] := dcval;
wsptr^[DCTSIZE*3] := dcval; wsptr^[DCTSIZE*3] := dcval;
wsptr^[DCTSIZE*4] := dcval; wsptr^[DCTSIZE*4] := dcval;
wsptr^[DCTSIZE*5] := dcval; wsptr^[DCTSIZE*5] := dcval;
wsptr^[DCTSIZE*6] := dcval; wsptr^[DCTSIZE*6] := dcval;
wsptr^[DCTSIZE*7] := dcval; wsptr^[DCTSIZE*7] := dcval;
Inc(JCOEF_PTR(inptr)); { advance pointers to next column } Inc(JCOEF_PTR(inptr)); { advance pointers to next column }
Inc(ISLOW_MULT_TYPE_PTR(quantptr)); Inc(ISLOW_MULT_TYPE_PTR(quantptr));
Inc(int_ptr(wsptr)); Inc(int_ptr(wsptr));
continue; continue;
end; end;
{ Even part: reverse the even part of the forward DCT. } { Even part: reverse the even part of the forward DCT. }
{ The rotator is sqrt(2)*c(-6). } { The rotator is sqrt(2)*c(-6). }
z2 := DEQUANTIZE(inptr^[DCTSIZE*2], quantptr^[DCTSIZE*2]); z2 := DEQUANTIZE(inptr^[DCTSIZE*2], quantptr^[DCTSIZE*2]);
z3 := DEQUANTIZE(inptr^[DCTSIZE*6], quantptr^[DCTSIZE*6]); z3 := DEQUANTIZE(inptr^[DCTSIZE*6], quantptr^[DCTSIZE*6]);
z1 := MULTIPLY(z2 + z3, FIX_0_541196100); z1 := MULTIPLY(z2 + z3, FIX_0_541196100);
tmp2 := z1 + MULTIPLY(z3, - FIX_1_847759065); tmp2 := z1 + MULTIPLY(z3, - FIX_1_847759065);
tmp3 := z1 + MULTIPLY(z2, FIX_0_765366865); tmp3 := z1 + MULTIPLY(z2, FIX_0_765366865);
z2 := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]); z2 := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]);
z3 := DEQUANTIZE(inptr^[DCTSIZE*4], quantptr^[DCTSIZE*4]); z3 := DEQUANTIZE(inptr^[DCTSIZE*4], quantptr^[DCTSIZE*4]);
tmp0 := (z2 + z3) shl CONST_BITS; tmp0 := (z2 + z3) shl CONST_BITS;
tmp1 := (z2 - z3) shl CONST_BITS; tmp1 := (z2 - z3) shl CONST_BITS;
tmp10 := tmp0 + tmp3; tmp10 := tmp0 + tmp3;
tmp13 := tmp0 - tmp3; tmp13 := tmp0 - tmp3;
tmp11 := tmp1 + tmp2; tmp11 := tmp1 + tmp2;
tmp12 := tmp1 - tmp2; tmp12 := tmp1 - tmp2;
{ Odd part per figure 8; the matrix is unitary and hence its { Odd part per figure 8; the matrix is unitary and hence its
transpose is its inverse. i0..i3 are y7,y5,y3,y1 respectively. } transpose is its inverse. i0..i3 are y7,y5,y3,y1 respectively. }
tmp0 := DEQUANTIZE(inptr^[DCTSIZE*7], quantptr^[DCTSIZE*7]); tmp0 := DEQUANTIZE(inptr^[DCTSIZE*7], quantptr^[DCTSIZE*7]);
tmp1 := DEQUANTIZE(inptr^[DCTSIZE*5], quantptr^[DCTSIZE*5]); tmp1 := DEQUANTIZE(inptr^[DCTSIZE*5], quantptr^[DCTSIZE*5]);
tmp2 := DEQUANTIZE(inptr^[DCTSIZE*3], quantptr^[DCTSIZE*3]); tmp2 := DEQUANTIZE(inptr^[DCTSIZE*3], quantptr^[DCTSIZE*3]);
tmp3 := DEQUANTIZE(inptr^[DCTSIZE*1], quantptr^[DCTSIZE*1]); tmp3 := DEQUANTIZE(inptr^[DCTSIZE*1], quantptr^[DCTSIZE*1]);
z1 := tmp0 + tmp3; z1 := tmp0 + tmp3;
z2 := tmp1 + tmp2; z2 := tmp1 + tmp2;
z3 := tmp0 + tmp2; z3 := tmp0 + tmp2;
z4 := tmp1 + tmp3; z4 := tmp1 + tmp3;
z5 := MULTIPLY(z3 + z4, FIX_1_175875602); { sqrt(2) * c3 } z5 := MULTIPLY(z3 + z4, FIX_1_175875602); { sqrt(2) * c3 }
tmp0 := MULTIPLY(tmp0, FIX_0_298631336); { sqrt(2) * (-c1+c3+c5-c7) } tmp0 := MULTIPLY(tmp0, FIX_0_298631336); { sqrt(2) * (-c1+c3+c5-c7) }
tmp1 := MULTIPLY(tmp1, FIX_2_053119869); { sqrt(2) * ( c1+c3-c5+c7) } tmp1 := MULTIPLY(tmp1, FIX_2_053119869); { sqrt(2) * ( c1+c3-c5+c7) }
tmp2 := MULTIPLY(tmp2, FIX_3_072711026); { sqrt(2) * ( c1+c3+c5-c7) } tmp2 := MULTIPLY(tmp2, FIX_3_072711026); { sqrt(2) * ( c1+c3+c5-c7) }
tmp3 := MULTIPLY(tmp3, FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) } tmp3 := MULTIPLY(tmp3, FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) }
z1 := MULTIPLY(z1, - FIX_0_899976223); { sqrt(2) * (c7-c3) } z1 := MULTIPLY(z1, - FIX_0_899976223); { sqrt(2) * (c7-c3) }
z2 := MULTIPLY(z2, - FIX_2_562915447); { sqrt(2) * (-c1-c3) } z2 := MULTIPLY(z2, - FIX_2_562915447); { sqrt(2) * (-c1-c3) }
z3 := MULTIPLY(z3, - FIX_1_961570560); { sqrt(2) * (-c3-c5) } z3 := MULTIPLY(z3, - FIX_1_961570560); { sqrt(2) * (-c3-c5) }
z4 := MULTIPLY(z4, - FIX_0_390180644); { sqrt(2) * (c5-c3) } z4 := MULTIPLY(z4, - FIX_0_390180644); { sqrt(2) * (c5-c3) }
Inc(z3, z5); Inc(z3, z5);
Inc(z4, z5); Inc(z4, z5);
Inc(tmp0, z1 + z3); Inc(tmp0, z1 + z3);
Inc(tmp1, z2 + z4); Inc(tmp1, z2 + z4);
Inc(tmp2, z2 + z3); Inc(tmp2, z2 + z3);
Inc(tmp3, z1 + z4); Inc(tmp3, z1 + z4);
{ Final output stage: inputs are tmp10..tmp13, tmp0..tmp3 } { Final output stage: inputs are tmp10..tmp13, tmp0..tmp3 }
wsptr^[DCTSIZE*0] := int (DESCALE(tmp10 + tmp3, CONST_BITS-PASS1_BITS)); wsptr^[DCTSIZE*0] := int (DESCALE(tmp10 + tmp3, CONST_BITS-PASS1_BITS));
wsptr^[DCTSIZE*7] := int (DESCALE(tmp10 - tmp3, CONST_BITS-PASS1_BITS)); wsptr^[DCTSIZE*7] := int (DESCALE(tmp10 - tmp3, CONST_BITS-PASS1_BITS));
wsptr^[DCTSIZE*1] := int (DESCALE(tmp11 + tmp2, CONST_BITS-PASS1_BITS)); wsptr^[DCTSIZE*1] := int (DESCALE(tmp11 + tmp2, CONST_BITS-PASS1_BITS));
wsptr^[DCTSIZE*6] := int (DESCALE(tmp11 - tmp2, CONST_BITS-PASS1_BITS)); wsptr^[DCTSIZE*6] := int (DESCALE(tmp11 - tmp2, CONST_BITS-PASS1_BITS));
wsptr^[DCTSIZE*2] := int (DESCALE(tmp12 + tmp1, CONST_BITS-PASS1_BITS)); wsptr^[DCTSIZE*2] := int (DESCALE(tmp12 + tmp1, CONST_BITS-PASS1_BITS));
wsptr^[DCTSIZE*5] := int (DESCALE(tmp12 - tmp1, CONST_BITS-PASS1_BITS)); wsptr^[DCTSIZE*5] := int (DESCALE(tmp12 - tmp1, CONST_BITS-PASS1_BITS));
wsptr^[DCTSIZE*3] := int (DESCALE(tmp13 + tmp0, CONST_BITS-PASS1_BITS)); wsptr^[DCTSIZE*3] := int (DESCALE(tmp13 + tmp0, CONST_BITS-PASS1_BITS));
wsptr^[DCTSIZE*4] := int (DESCALE(tmp13 - tmp0, CONST_BITS-PASS1_BITS)); wsptr^[DCTSIZE*4] := int (DESCALE(tmp13 - tmp0, CONST_BITS-PASS1_BITS));
Inc(JCOEF_PTR(inptr)); { advance pointers to next column } Inc(JCOEF_PTR(inptr)); { advance pointers to next column }
Inc(ISLOW_MULT_TYPE_PTR(quantptr)); Inc(ISLOW_MULT_TYPE_PTR(quantptr));
Inc(int_ptr(wsptr)); Inc(int_ptr(wsptr));
end; end;
{ Pass 2: process rows from work array, store into output array. } { Pass 2: process rows from work array, store into output array. }
{ Note that we must descale the results by a factor of 8 == 2**3, } { Note that we must descale the results by a factor of 8 == 2**3, }
{ and also undo the PASS1_BITS scaling. } { and also undo the PASS1_BITS scaling. }
wsptr := @workspace; wsptr := @workspace;
for ctr := 0 to pred(DCTSIZE) do for ctr := 0 to pred(DCTSIZE) do
begin begin
outptr := output_buf^[ctr]; outptr := output_buf^[ctr];
Inc(JSAMPLE_PTR(outptr), output_col); Inc(JSAMPLE_PTR(outptr), output_col);
{ Rows of zeroes can be exploited in the same way as we did with columns. { Rows of zeroes can be exploited in the same way as we did with columns.
However, the column calculation has created many nonzero AC terms, so However, the column calculation has created many nonzero AC terms, so
the simplification applies less often (typically 5% to 10% of the time). the simplification applies less often (typically 5% to 10% of the time).
On machines with very fast multiplication, it's possible that the On machines with very fast multiplication, it's possible that the
test takes more time than it's worth. In that case this section test takes more time than it's worth. In that case this section
may be commented out. } may be commented out. }
{$ifndef NO_ZERO_ROW_TEST} {$ifndef NO_ZERO_ROW_TEST}
if ((wsptr^[1]=0) and (wsptr^[2]=0) and (wsptr^[3]=0) and (wsptr^[4]=0) if ((wsptr^[1]=0) and (wsptr^[2]=0) and (wsptr^[3]=0) and (wsptr^[4]=0)
and (wsptr^[5]=0) and (wsptr^[6]=0) and (wsptr^[7]=0)) then and (wsptr^[5]=0) and (wsptr^[6]=0) and (wsptr^[7]=0)) then
begin begin
{ AC terms all zero } { AC terms all zero }
JSAMPLE(dcval_) := range_limit^[int(DESCALE(INT32(wsptr^[0]), JSAMPLE(dcval_) := range_limit^[int(DESCALE(INT32(wsptr^[0]),
PASS1_BITS+3)) and RANGE_MASK]; PASS1_BITS+3)) and RANGE_MASK];
outptr^[0] := dcval_; outptr^[0] := dcval_;
outptr^[1] := dcval_; outptr^[1] := dcval_;
outptr^[2] := dcval_; outptr^[2] := dcval_;
outptr^[3] := dcval_; outptr^[3] := dcval_;
outptr^[4] := dcval_; outptr^[4] := dcval_;
outptr^[5] := dcval_; outptr^[5] := dcval_;
outptr^[6] := dcval_; outptr^[6] := dcval_;
outptr^[7] := dcval_; outptr^[7] := dcval_;
Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row }
continue; continue;
end; end;
{$endif} {$endif}
{ Even part: reverse the even part of the forward DCT. } { Even part: reverse the even part of the forward DCT. }
{ The rotator is sqrt(2)*c(-6). } { The rotator is sqrt(2)*c(-6). }
z2 := INT32 (wsptr^[2]); z2 := INT32 (wsptr^[2]);
z3 := INT32 (wsptr^[6]); z3 := INT32 (wsptr^[6]);
z1 := MULTIPLY(z2 + z3, FIX_0_541196100); z1 := MULTIPLY(z2 + z3, FIX_0_541196100);
tmp2 := z1 + MULTIPLY(z3, - FIX_1_847759065); tmp2 := z1 + MULTIPLY(z3, - FIX_1_847759065);
tmp3 := z1 + MULTIPLY(z2, FIX_0_765366865); tmp3 := z1 + MULTIPLY(z2, FIX_0_765366865);
tmp0 := (INT32(wsptr^[0]) + INT32(wsptr^[4])) shl CONST_BITS; tmp0 := (INT32(wsptr^[0]) + INT32(wsptr^[4])) shl CONST_BITS;
tmp1 := (INT32(wsptr^[0]) - INT32(wsptr^[4])) shl CONST_BITS; tmp1 := (INT32(wsptr^[0]) - INT32(wsptr^[4])) shl CONST_BITS;
tmp10 := tmp0 + tmp3; tmp10 := tmp0 + tmp3;
tmp13 := tmp0 - tmp3; tmp13 := tmp0 - tmp3;
tmp11 := tmp1 + tmp2; tmp11 := tmp1 + tmp2;
tmp12 := tmp1 - tmp2; tmp12 := tmp1 - tmp2;
{ Odd part per figure 8; the matrix is unitary and hence its { Odd part per figure 8; the matrix is unitary and hence its
transpose is its inverse. i0..i3 are y7,y5,y3,y1 respectively. } transpose is its inverse. i0..i3 are y7,y5,y3,y1 respectively. }
tmp0 := INT32(wsptr^[7]); tmp0 := INT32(wsptr^[7]);
tmp1 := INT32(wsptr^[5]); tmp1 := INT32(wsptr^[5]);
tmp2 := INT32(wsptr^[3]); tmp2 := INT32(wsptr^[3]);
tmp3 := INT32(wsptr^[1]); tmp3 := INT32(wsptr^[1]);
z1 := tmp0 + tmp3; z1 := tmp0 + tmp3;
z2 := tmp1 + tmp2; z2 := tmp1 + tmp2;
z3 := tmp0 + tmp2; z3 := tmp0 + tmp2;
z4 := tmp1 + tmp3; z4 := tmp1 + tmp3;
z5 := MULTIPLY(z3 + z4, FIX_1_175875602); { sqrt(2) * c3 } z5 := MULTIPLY(z3 + z4, FIX_1_175875602); { sqrt(2) * c3 }
tmp0 := MULTIPLY(tmp0, FIX_0_298631336); { sqrt(2) * (-c1+c3+c5-c7) } tmp0 := MULTIPLY(tmp0, FIX_0_298631336); { sqrt(2) * (-c1+c3+c5-c7) }
tmp1 := MULTIPLY(tmp1, FIX_2_053119869); { sqrt(2) * ( c1+c3-c5+c7) } tmp1 := MULTIPLY(tmp1, FIX_2_053119869); { sqrt(2) * ( c1+c3-c5+c7) }
tmp2 := MULTIPLY(tmp2, FIX_3_072711026); { sqrt(2) * ( c1+c3+c5-c7) } tmp2 := MULTIPLY(tmp2, FIX_3_072711026); { sqrt(2) * ( c1+c3+c5-c7) }
tmp3 := MULTIPLY(tmp3, FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) } tmp3 := MULTIPLY(tmp3, FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) }
z1 := MULTIPLY(z1, - FIX_0_899976223); { sqrt(2) * (c7-c3) } z1 := MULTIPLY(z1, - FIX_0_899976223); { sqrt(2) * (c7-c3) }
z2 := MULTIPLY(z2, - FIX_2_562915447); { sqrt(2) * (-c1-c3) } z2 := MULTIPLY(z2, - FIX_2_562915447); { sqrt(2) * (-c1-c3) }
z3 := MULTIPLY(z3, - FIX_1_961570560); { sqrt(2) * (-c3-c5) } z3 := MULTIPLY(z3, - FIX_1_961570560); { sqrt(2) * (-c3-c5) }
z4 := MULTIPLY(z4, - FIX_0_390180644); { sqrt(2) * (c5-c3) } z4 := MULTIPLY(z4, - FIX_0_390180644); { sqrt(2) * (c5-c3) }
Inc(z3, z5); Inc(z3, z5);
Inc(z4, z5); Inc(z4, z5);
Inc(tmp0, z1 + z3); Inc(tmp0, z1 + z3);
Inc(tmp1, z2 + z4); Inc(tmp1, z2 + z4);
Inc(tmp2, z2 + z3); Inc(tmp2, z2 + z3);
Inc(tmp3, z1 + z4); Inc(tmp3, z1 + z4);
{ Final output stage: inputs are tmp10..tmp13, tmp0..tmp3 } { Final output stage: inputs are tmp10..tmp13, tmp0..tmp3 }
outptr^[0] := range_limit^[ int(DESCALE(tmp10 + tmp3, outptr^[0] := range_limit^[ int(DESCALE(tmp10 + tmp3,
CONST_BITS+PASS1_BITS+3)) CONST_BITS+PASS1_BITS+3))
and RANGE_MASK]; and RANGE_MASK];
outptr^[7] := range_limit^[ int(DESCALE(tmp10 - tmp3, outptr^[7] := range_limit^[ int(DESCALE(tmp10 - tmp3,
CONST_BITS+PASS1_BITS+3)) CONST_BITS+PASS1_BITS+3))
and RANGE_MASK]; and RANGE_MASK];
outptr^[1] := range_limit^[ int(DESCALE(tmp11 + tmp2, outptr^[1] := range_limit^[ int(DESCALE(tmp11 + tmp2,
CONST_BITS+PASS1_BITS+3)) CONST_BITS+PASS1_BITS+3))
and RANGE_MASK]; and RANGE_MASK];
outptr^[6] := range_limit^[ int(DESCALE(tmp11 - tmp2, outptr^[6] := range_limit^[ int(DESCALE(tmp11 - tmp2,
CONST_BITS+PASS1_BITS+3)) CONST_BITS+PASS1_BITS+3))
and RANGE_MASK]; and RANGE_MASK];
outptr^[2] := range_limit^[ int(DESCALE(tmp12 + tmp1, outptr^[2] := range_limit^[ int(DESCALE(tmp12 + tmp1,
CONST_BITS+PASS1_BITS+3)) CONST_BITS+PASS1_BITS+3))
and RANGE_MASK]; and RANGE_MASK];
outptr^[5] := range_limit^[ int(DESCALE(tmp12 - tmp1, outptr^[5] := range_limit^[ int(DESCALE(tmp12 - tmp1,
CONST_BITS+PASS1_BITS+3)) CONST_BITS+PASS1_BITS+3))
and RANGE_MASK]; and RANGE_MASK];
outptr^[3] := range_limit^[ int(DESCALE(tmp13 + tmp0, outptr^[3] := range_limit^[ int(DESCALE(tmp13 + tmp0,
CONST_BITS+PASS1_BITS+3)) CONST_BITS+PASS1_BITS+3))
and RANGE_MASK]; and RANGE_MASK];
outptr^[4] := range_limit^[ int(DESCALE(tmp13 - tmp0, outptr^[4] := range_limit^[ int(DESCALE(tmp13 - tmp0,
CONST_BITS+PASS1_BITS+3)) CONST_BITS+PASS1_BITS+3))
and RANGE_MASK]; and RANGE_MASK];
Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row }
end; end;
end; end;
end. end.

1050
Imaging/JpegLib/imjidctred.pas
View File

File diff suppressed because it is too large Load Diff

252
Imaging/JpegLib/imjinclude.pas
View File

@ -1,126 +1,126 @@
unit imjinclude; unit imjinclude;
{ This file exists to provide a single place to fix any problems with { This file exists to provide a single place to fix any problems with
including the wrong system include files. (Common problems are taken including the wrong system include files. (Common problems are taken
care of by the standard jconfig symbols, but on really weird systems care of by the standard jconfig symbols, but on really weird systems
you may have to edit this file.) you may have to edit this file.)
NOTE: this file is NOT intended to be included by applications using the NOTE: this file is NOT intended to be included by applications using the
JPEG library. Most applications need only include jpeglib.h. } JPEG library. Most applications need only include jpeglib.h. }
{ Original: jinclude.h Copyright (C) 1991-1994, Thomas G. Lane. } { Original: jinclude.h Copyright (C) 1991-1994, Thomas G. Lane. }
interface interface
{$I imjconfig.inc} {$I imjconfig.inc}
{ Include auto-config file to find out which system include files we need. } { Include auto-config file to find out which system include files we need. }
uses uses
{$ifdef Delphi_Stream} {$ifdef Delphi_Stream}
classes, classes,
{$endif} {$endif}
imjmorecfg; imjmorecfg;
{ Nomssi: { Nomssi:
To write a dest/source manager that handle streams rather than files, To write a dest/source manager that handle streams rather than files,
you can edit the FILEptr definition and the JFREAD() and JFWRITE() you can edit the FILEptr definition and the JFREAD() and JFWRITE()
functions in this unit, you don't need to change the default managers functions in this unit, you don't need to change the default managers
JDATASRC and JDATADST. } JDATASRC and JDATADST. }
{$ifdef Delphi_Stream} {$ifdef Delphi_Stream}
type type
FILEptr = ^TStream; FILEptr = ^TStream;
{$else} {$else}
{$ifdef Delphi_Jpeg} {$ifdef Delphi_Jpeg}
type type
FILEptr = TCustomMemoryStream; FILEptr = TCustomMemoryStream;
{$else} {$else}
type type
FILEptr = ^File; FILEptr = ^File;
{$endif} {$endif}
{$endif} {$endif}
{ We need the NULL macro and size_t typedef. { We need the NULL macro and size_t typedef.
On an ANSI-conforming system it is sufficient to include <stddef.h>. On an ANSI-conforming system it is sufficient to include <stddef.h>.
Otherwise, we get them from <stdlib.h> or <stdio.h>; we may have to Otherwise, we get them from <stdlib.h> or <stdio.h>; we may have to
pull in <sys/types.h> as well. pull in <sys/types.h> as well.
Note that the core JPEG library does not require <stdio.h>; Note that the core JPEG library does not require <stdio.h>;
only the default error handler and data source/destination modules do. only the default error handler and data source/destination modules do.
But we must pull it in because of the references to FILE in jpeglib.h. But we must pull it in because of the references to FILE in jpeglib.h.
You can remove those references if you want to compile without <stdio.h>.} You can remove those references if you want to compile without <stdio.h>.}
{ We need memory copying and zeroing functions, plus strncpy(). { We need memory copying and zeroing functions, plus strncpy().
ANSI and System V implementations declare these in <string.h>. ANSI and System V implementations declare these in <string.h>.
BSD doesn't have the mem() functions, but it does have bcopy()/bzero(). BSD doesn't have the mem() functions, but it does have bcopy()/bzero().
Some systems may declare memset and memcpy in <memory.h>. Some systems may declare memset and memcpy in <memory.h>.
NOTE: we assume the size parameters to these functions are of type size_t. NOTE: we assume the size parameters to these functions are of type size_t.
Change the casts in these macros if not! } Change the casts in these macros if not! }
procedure MEMZERO(target : pointer; size : size_t); procedure MEMZERO(target : pointer; size : size_t);
procedure MEMCOPY(dest, src : pointer; size : size_t); procedure MEMCOPY(dest, src : pointer; size : size_t);
{function SIZEOF(object) : size_t;} {function SIZEOF(object) : size_t;}
function JFREAD(fp : FILEptr; buf : pointer; sizeofbuf : size_t) : size_t; function JFREAD(fp : FILEptr; buf : pointer; sizeofbuf : size_t) : size_t;
function JFWRITE(fp : FILEptr; buf : pointer; sizeofbuf : size_t) : size_t; function JFWRITE(fp : FILEptr; buf : pointer; sizeofbuf : size_t) : size_t;
implementation implementation
procedure MEMZERO(target : pointer; size : size_t); procedure MEMZERO(target : pointer; size : size_t);
begin begin
FillChar(target^, size, 0); FillChar(target^, size, 0);
end; end;
procedure MEMCOPY(dest, src : pointer; size : size_t); procedure MEMCOPY(dest, src : pointer; size : size_t);
begin begin
Move(src^, dest^, size); Move(src^, dest^, size);
end; end;
{ In ANSI C, and indeed any rational implementation, size_t is also the { In ANSI C, and indeed any rational implementation, size_t is also the
type returned by sizeof(). However, it seems there are some irrational type returned by sizeof(). However, it seems there are some irrational
implementations out there, in which sizeof() returns an int even though implementations out there, in which sizeof() returns an int even though
size_t is defined as long or unsigned long. To ensure consistent results size_t is defined as long or unsigned long. To ensure consistent results
we always use this SIZEOF() macro in place of using sizeof() directly. } we always use this SIZEOF() macro in place of using sizeof() directly. }
{#define {#define
SIZEOF(object) (size_t(sizeof(object))} SIZEOF(object) (size_t(sizeof(object))}
{ The modules that use fread() and fwrite() always invoke them through { The modules that use fread() and fwrite() always invoke them through
these macros. On some systems you may need to twiddle the argument casts. these macros. On some systems you may need to twiddle the argument casts.
CAUTION: argument order is different from underlying functions! } CAUTION: argument order is different from underlying functions! }
function JFREAD(fp : FILEptr; buf : pointer; sizeofbuf : size_t) : size_t; function JFREAD(fp : FILEptr; buf : pointer; sizeofbuf : size_t) : size_t;
var var
count : uint; count : uint;
begin begin
{$ifdef Delphi_Stream} {$ifdef Delphi_Stream}
count := fp^.Read(buf^, sizeofbuf); count := fp^.Read(buf^, sizeofbuf);
{$else} {$else}
blockread(fp^, buf^, sizeofbuf, count); blockread(fp^, buf^, sizeofbuf, count);
{$endif} {$endif}
JFREAD := size_t(count); JFREAD := size_t(count);
end; end;
function JFWRITE(fp : FILEptr; buf : pointer; sizeofbuf : size_t) : size_t; function JFWRITE(fp : FILEptr; buf : pointer; sizeofbuf : size_t) : size_t;
var var
count : uint; count : uint;
begin begin
{$ifdef Delphi_Stream} {$ifdef Delphi_Stream}
count := fp^.Write(buf^, sizeofbuf); count := fp^.Write(buf^, sizeofbuf);
{$else} {$else}
blockwrite(fp^, buf^, sizeofbuf, count); blockwrite(fp^, buf^, sizeofbuf, count);
{$endif} {$endif}
JFWRITE := size_t(count); JFWRITE := size_t(count);
end; end;
end. end.

2566
Imaging/JpegLib/imjmemmgr.pas
View File

File diff suppressed because it is too large Load Diff

518
Imaging/JpegLib/imjmemnobs.pas
View File

@ -1,259 +1,259 @@
unit imjmemnobs; unit imjmemnobs;
{ Delphi3 -- > jmemnobs from jmemwin } { Delphi3 -- > jmemnobs from jmemwin }
{ This file provides an Win32-compatible implementation of the system- { This file provides an Win32-compatible implementation of the system-
dependent portion of the JPEG memory manager. } dependent portion of the JPEG memory manager. }
{ Check jmemnobs.c } { Check jmemnobs.c }
{ Copyright (C) 1996, Jacques Nomssi Nzali } { Copyright (C) 1996, Jacques Nomssi Nzali }
interface interface
{$I imjconfig.inc} {$I imjconfig.inc}
uses uses
imjmorecfg, imjmorecfg,
imjdeferr, imjdeferr,
imjerror, imjerror,
imjpeglib; imjpeglib;
{ The macro MAX_ALLOC_CHUNK designates the maximum number of bytes that may { The macro MAX_ALLOC_CHUNK designates the maximum number of bytes that may
be requested in a single call to jpeg_get_large (and jpeg_get_small for that be requested in a single call to jpeg_get_large (and jpeg_get_small for that
matter, but that case should never come into play). This macro is needed matter, but that case should never come into play). This macro is needed
to model the 64Kb-segment-size limit of far addressing on 80x86 machines. to model the 64Kb-segment-size limit of far addressing on 80x86 machines.
On those machines, we expect that jconfig.h will provide a proper value. On those machines, we expect that jconfig.h will provide a proper value.
On machines with 32-bit flat address spaces, any large constant may be used. On machines with 32-bit flat address spaces, any large constant may be used.
NB: jmemmgr.c expects that MAX_ALLOC_CHUNK will be representable as type NB: jmemmgr.c expects that MAX_ALLOC_CHUNK will be representable as type
size_t and will be a multiple of sizeof(align_type). } size_t and will be a multiple of sizeof(align_type). }
const const
MAX_ALLOC_CHUNK = long(1000000000); MAX_ALLOC_CHUNK = long(1000000000);
{GLOBAL} {GLOBAL}
procedure jpeg_open_backing_store (cinfo : j_common_ptr; procedure jpeg_open_backing_store (cinfo : j_common_ptr;
info : backing_store_ptr; info : backing_store_ptr;
total_bytes_needed : long); total_bytes_needed : long);
{ These routines take care of any system-dependent initialization and { These routines take care of any system-dependent initialization and
cleanup required. } cleanup required. }
{GLOBAL} {GLOBAL}
function jpeg_mem_init (cinfo : j_common_ptr) : long; function jpeg_mem_init (cinfo : j_common_ptr) : long;
{GLOBAL} {GLOBAL}
procedure jpeg_mem_term (cinfo : j_common_ptr); procedure jpeg_mem_term (cinfo : j_common_ptr);
{ These two functions are used to allocate and release small chunks of { These two functions are used to allocate and release small chunks of
memory. (Typically the total amount requested through jpeg_get_small is memory. (Typically the total amount requested through jpeg_get_small is
no more than 20K or so; this will be requested in chunks of a few K each.) no more than 20K or so; this will be requested in chunks of a few K each.)
Behavior should be the same as for the standard library functions malloc Behavior should be the same as for the standard library functions malloc
and free; in particular, jpeg_get_small must return NIL on failure. and free; in particular, jpeg_get_small must return NIL on failure.
On most systems, these ARE malloc and free. jpeg_free_small is passed the On most systems, these ARE malloc and free. jpeg_free_small is passed the
size of the object being freed, just in case it's needed. size of the object being freed, just in case it's needed.
On an 80x86 machine using small-data memory model, these manage near heap. } On an 80x86 machine using small-data memory model, these manage near heap. }
{ Near-memory allocation and freeing are controlled by the regular library { Near-memory allocation and freeing are controlled by the regular library
routines malloc() and free(). } routines malloc() and free(). }
{GLOBAL} {GLOBAL}
function jpeg_get_small (cinfo : j_common_ptr; function jpeg_get_small (cinfo : j_common_ptr;
sizeofobject : size_t) : pointer; sizeofobject : size_t) : pointer;
{GLOBAL} {GLOBAL}
{object is a reserved word in Borland Pascal } {object is a reserved word in Borland Pascal }
procedure jpeg_free_small (cinfo : j_common_ptr; procedure jpeg_free_small (cinfo : j_common_ptr;
an_object : pointer; an_object : pointer;
sizeofobject : size_t); sizeofobject : size_t);
{ These two functions are used to allocate and release large chunks of { These two functions are used to allocate and release large chunks of
memory (up to the total free space designated by jpeg_mem_available). memory (up to the total free space designated by jpeg_mem_available).
The interface is the same as above, except that on an 80x86 machine, The interface is the same as above, except that on an 80x86 machine,
far pointers are used. On most other machines these are identical to far pointers are used. On most other machines these are identical to
the jpeg_get/free_small routines; but we keep them separate anyway, the jpeg_get/free_small routines; but we keep them separate anyway,
in case a different allocation strategy is desirable for large chunks. } in case a different allocation strategy is desirable for large chunks. }
{ "Large" objects are allocated in far memory, if possible } { "Large" objects are allocated in far memory, if possible }
{GLOBAL} {GLOBAL}
function jpeg_get_large (cinfo : j_common_ptr; function jpeg_get_large (cinfo : j_common_ptr;
sizeofobject : size_t) : voidp; {far} sizeofobject : size_t) : voidp; {far}
{GLOBAL} {GLOBAL}
procedure jpeg_free_large (cinfo : j_common_ptr; procedure jpeg_free_large (cinfo : j_common_ptr;
{var?} an_object : voidp; {FAR} {var?} an_object : voidp; {FAR}
sizeofobject : size_t); sizeofobject : size_t);
{ This routine computes the total memory space available for allocation. { This routine computes the total memory space available for allocation.
It's impossible to do this in a portable way; our current solution is It's impossible to do this in a portable way; our current solution is
to make the user tell us (with a default value set at compile time). to make the user tell us (with a default value set at compile time).
If you can actually get the available space, it's a good idea to subtract If you can actually get the available space, it's a good idea to subtract
a slop factor of 5% or so. } a slop factor of 5% or so. }
{GLOBAL} {GLOBAL}
function jpeg_mem_available (cinfo : j_common_ptr; function jpeg_mem_available (cinfo : j_common_ptr;
min_bytes_needed : long; min_bytes_needed : long;
max_bytes_needed : long; max_bytes_needed : long;
already_allocated : long) : long; already_allocated : long) : long;
implementation implementation
{ This structure holds whatever state is needed to access a single { This structure holds whatever state is needed to access a single
backing-store object. The read/write/close method pointers are called backing-store object. The read/write/close method pointers are called
by jmemmgr.c to manipulate the backing-store object; all other fields by jmemmgr.c to manipulate the backing-store object; all other fields
are private to the system-dependent backing store routines. } are private to the system-dependent backing store routines. }
{ These two functions are used to allocate and release small chunks of { These two functions are used to allocate and release small chunks of
memory. (Typically the total amount requested through jpeg_get_small is memory. (Typically the total amount requested through jpeg_get_small is
no more than 20K or so; this will be requested in chunks of a few K each.) no more than 20K or so; this will be requested in chunks of a few K each.)
Behavior should be the same as for the standard library functions malloc Behavior should be the same as for the standard library functions malloc
and free; in particular, jpeg_get_small must return NIL on failure. and free; in particular, jpeg_get_small must return NIL on failure.
On most systems, these ARE malloc and free. jpeg_free_small is passed the On most systems, these ARE malloc and free. jpeg_free_small is passed the
size of the object being freed, just in case it's needed. size of the object being freed, just in case it's needed.
On an 80x86 machine using small-data memory model, these manage near heap. } On an 80x86 machine using small-data memory model, these manage near heap. }
{ Near-memory allocation and freeing are controlled by the regular library { Near-memory allocation and freeing are controlled by the regular library
routines malloc() and free(). } routines malloc() and free(). }
{GLOBAL} {GLOBAL}
function jpeg_get_small (cinfo : j_common_ptr; function jpeg_get_small (cinfo : j_common_ptr;
sizeofobject : size_t) : pointer; sizeofobject : size_t) : pointer;
var var
p : pointer; p : pointer;
begin begin
GetMem(p, sizeofobject); GetMem(p, sizeofobject);
jpeg_get_small := p; jpeg_get_small := p;
end; end;
{GLOBAL} {GLOBAL}
{object is a reserved word in Object Pascal } {object is a reserved word in Object Pascal }
procedure jpeg_free_small (cinfo : j_common_ptr; procedure jpeg_free_small (cinfo : j_common_ptr;
an_object : pointer; an_object : pointer;
sizeofobject : size_t); sizeofobject : size_t);
begin begin
FreeMem(an_object, sizeofobject); FreeMem(an_object, sizeofobject);
end; end;
{ These two functions are used to allocate and release large chunks of { These two functions are used to allocate and release large chunks of
memory (up to the total free space designated by jpeg_mem_available). memory (up to the total free space designated by jpeg_mem_available).
The interface is the same as above, except that on an 80x86 machine, The interface is the same as above, except that on an 80x86 machine,
far pointers are used. On most other machines these are identical to far pointers are used. On most other machines these are identical to
the jpeg_get/free_small routines; but we keep them separate anyway, the jpeg_get/free_small routines; but we keep them separate anyway,
in case a different allocation strategy is desirable for large chunks. } in case a different allocation strategy is desirable for large chunks. }
{GLOBAL} {GLOBAL}
function jpeg_get_large (cinfo : j_common_ptr; function jpeg_get_large (cinfo : j_common_ptr;
sizeofobject : size_t) : voidp; {far} sizeofobject : size_t) : voidp; {far}
var var
p : pointer; p : pointer;
begin begin
GetMem(p, sizeofobject); GetMem(p, sizeofobject);
jpeg_get_large := p; jpeg_get_large := p;
end; end;
{GLOBAL} {GLOBAL}
procedure jpeg_free_large (cinfo : j_common_ptr; procedure jpeg_free_large (cinfo : j_common_ptr;
{var?} an_object : voidp; {FAR} {var?} an_object : voidp; {FAR}
sizeofobject : size_t); sizeofobject : size_t);
begin begin
Freemem(an_object, sizeofobject); Freemem(an_object, sizeofobject);
end; end;
{ This routine computes the total space still available for allocation by { This routine computes the total space still available for allocation by
jpeg_get_large. If more space than this is needed, backing store will be jpeg_get_large. If more space than this is needed, backing store will be
used. NOTE: any memory already allocated must not be counted. used. NOTE: any memory already allocated must not be counted.
There is a minimum space requirement, corresponding to the minimum There is a minimum space requirement, corresponding to the minimum
feasible buffer sizes; jmemmgr.c will request that much space even if feasible buffer sizes; jmemmgr.c will request that much space even if
jpeg_mem_available returns zero. The maximum space needed, enough to hold jpeg_mem_available returns zero. The maximum space needed, enough to hold
all working storage in memory, is also passed in case it is useful. all working storage in memory, is also passed in case it is useful.
Finally, the total space already allocated is passed. If no better Finally, the total space already allocated is passed. If no better
method is available, cinfo^.mem^.max_memory_to_use - already_allocated method is available, cinfo^.mem^.max_memory_to_use - already_allocated
is often a suitable calculation. is often a suitable calculation.
It is OK for jpeg_mem_available to underestimate the space available It is OK for jpeg_mem_available to underestimate the space available
(that'll just lead to more backing-store access than is really necessary). (that'll just lead to more backing-store access than is really necessary).
However, an overestimate will lead to failure. Hence it's wise to subtract However, an overestimate will lead to failure. Hence it's wise to subtract
a slop factor from the true available space. 5% should be enough. a slop factor from the true available space. 5% should be enough.
On machines with lots of virtual memory, any large constant may be returned. On machines with lots of virtual memory, any large constant may be returned.
Conversely, zero may be returned to always use the minimum amount of memory.} Conversely, zero may be returned to always use the minimum amount of memory.}
{ This routine computes the total memory space available for allocation. { This routine computes the total memory space available for allocation.
It's impossible to do this in a portable way; our current solution is It's impossible to do this in a portable way; our current solution is
to make the user tell us (with a default value set at compile time). to make the user tell us (with a default value set at compile time).
If you can actually get the available space, it's a good idea to subtract If you can actually get the available space, it's a good idea to subtract
a slop factor of 5% or so. } a slop factor of 5% or so. }
const const
DEFAULT_MAX_MEM = long(300000); { for total usage about 450K } DEFAULT_MAX_MEM = long(300000); { for total usage about 450K }
{GLOBAL} {GLOBAL}
function jpeg_mem_available (cinfo : j_common_ptr; function jpeg_mem_available (cinfo : j_common_ptr;
min_bytes_needed : long; min_bytes_needed : long;
max_bytes_needed : long; max_bytes_needed : long;
already_allocated : long) : long; already_allocated : long) : long;
begin begin
{jpeg_mem_available := cinfo^.mem^.max_memory_to_use - already_allocated;} {jpeg_mem_available := cinfo^.mem^.max_memory_to_use - already_allocated;}
jpeg_mem_available := max_bytes_needed; jpeg_mem_available := max_bytes_needed;
end; end;
{ Initial opening of a backing-store object. This must fill in the { Initial opening of a backing-store object. This must fill in the
read/write/close pointers in the object. The read/write routines read/write/close pointers in the object. The read/write routines
may take an error exit if the specified maximum file size is exceeded. may take an error exit if the specified maximum file size is exceeded.
(If jpeg_mem_available always returns a large value, this routine can (If jpeg_mem_available always returns a large value, this routine can
just take an error exit.) } just take an error exit.) }
{ Initial opening of a backing-store object. } { Initial opening of a backing-store object. }
{GLOBAL} {GLOBAL}
procedure jpeg_open_backing_store (cinfo : j_common_ptr; procedure jpeg_open_backing_store (cinfo : j_common_ptr;
info : backing_store_ptr; info : backing_store_ptr;
total_bytes_needed : long); total_bytes_needed : long);
begin begin
ERREXIT(cinfo, JERR_NO_BACKING_STORE); ERREXIT(cinfo, JERR_NO_BACKING_STORE);
end; end;
{ These routines take care of any system-dependent initialization and { These routines take care of any system-dependent initialization and
cleanup required. jpeg_mem_init will be called before anything is cleanup required. jpeg_mem_init will be called before anything is
allocated (and, therefore, nothing in cinfo is of use except the error allocated (and, therefore, nothing in cinfo is of use except the error
manager pointer). It should return a suitable default value for manager pointer). It should return a suitable default value for
max_memory_to_use; this may subsequently be overridden by the surrounding max_memory_to_use; this may subsequently be overridden by the surrounding
application. (Note that max_memory_to_use is only important if application. (Note that max_memory_to_use is only important if
jpeg_mem_available chooses to consult it ... no one else will.) jpeg_mem_available chooses to consult it ... no one else will.)
jpeg_mem_term may assume that all requested memory has been freed and that jpeg_mem_term may assume that all requested memory has been freed and that
all opened backing-store objects have been closed. } all opened backing-store objects have been closed. }
{ These routines take care of any system-dependent initialization and { These routines take care of any system-dependent initialization and
cleanup required. } cleanup required. }
{GLOBAL} {GLOBAL}
function jpeg_mem_init (cinfo : j_common_ptr) : long; function jpeg_mem_init (cinfo : j_common_ptr) : long;
begin begin
jpeg_mem_init := DEFAULT_MAX_MEM; { default for max_memory_to_use } jpeg_mem_init := DEFAULT_MAX_MEM; { default for max_memory_to_use }
end; end;
{GLOBAL} {GLOBAL}
procedure jpeg_mem_term (cinfo : j_common_ptr); procedure jpeg_mem_term (cinfo : j_common_ptr);
begin begin
end; end;
end. end.

466
Imaging/JpegLib/imjmorecfg.pas
View File

@ -1,247 +1,219 @@
unit imjmorecfg; unit imjmorecfg;
{ This file contains additional configuration options that customize the { This file contains additional configuration options that customize the
JPEG software for special applications or support machine-dependent JPEG software for special applications or support machine-dependent
optimizations. Most users will not need to touch this file. } optimizations. Most users will not need to touch this file. }
{ Source: jmorecfg.h; Copyright (C) 1991-1996, Thomas G. Lane. } { Source: jmorecfg.h; Copyright (C) 1991-1996, Thomas G. Lane. }
interface interface
{$I imjconfig.inc} {$I imjconfig.inc}
{$IFDEF FPC} { Free Pascal Compiler } type
type int = Integer;
int = longint; uInt = Cardinal;
uInt = Cardinal; { unsigned int } short = SmallInt;
short = Integer; ushort = Word;
ushort = Word; long = LongInt;
long = longint;
{$ELSE} type
{$IFDEF WIN32} voidp = pointer;
{ Delphi 2.0 }
type type
int = Integer; int_ptr = ^int;
uInt = Cardinal; size_t = int;
short = SmallInt;
ushort = Word; { Define BITS_IN_JSAMPLE as either
long = longint; 8 for 8-bit sample values (the usual setting)
{$ELSE} 12 for 12-bit sample values
{$IFDEF VIRTUALPASCAL} Only 8 and 12 are legal data precisions for lossy JPEG according to the
type JPEG standard, and the IJG code does not support anything else!
int = longint; We do not support run-time selection of data precision, sorry. }
uInt = longint; { unsigned int }
short = system.Integer;
ushort = system.Word; {$ifdef BITS_IN_JSAMPLE_IS_8} { use 8 or 12 }
long = longint; const
{$ELSE} BITS_IN_JSAMPLE = 8;
type {$else}
int = Integer; const
uInt = Word; { unsigned int } BITS_IN_JSAMPLE = 12;
short = Integer; {$endif}
ushort = Word;
long = longint;
{$ENDIF} { Maximum number of components (color channels) allowed in JPEG image.
{$ENDIF} To meet the letter of the JPEG spec, set this to 255. However, darn
{$ENDIF} few applications need more than 4 channels (maybe 5 for CMYK + alpha
type mask). We recommend 10 as a reasonable compromise; use 4 if you are
voidp = pointer; really short on memory. (Each allowed component costs a hundred or so
bytes of storage, whether actually used in an image or not.) }
type
int_ptr = ^int;
size_t = int; const
MAX_COMPONENTS = 10; { maximum number of image components }
{ Define BITS_IN_JSAMPLE as either
8 for 8-bit sample values (the usual setting)
12 for 12-bit sample values { Basic data types.
Only 8 and 12 are legal data precisions for lossy JPEG according to the You may need to change these if you have a machine with unusual data
JPEG standard, and the IJG code does not support anything else! type sizes; for example, "char" not 8 bits, "short" not 16 bits,
We do not support run-time selection of data precision, sorry. } or "long" not 32 bits. We don't care whether "int" is 16 or 32 bits,
but it had better be at least 16. }
{$ifdef BITS_IN_JSAMPLE_IS_8} { use 8 or 12 }
const
BITS_IN_JSAMPLE = 8; { Representation of a single sample (pixel element value).
{$else} We frequently allocate large arrays of these, so it's important to keep
const them small. But if you have memory to burn and access to char or short
BITS_IN_JSAMPLE = 12; arrays is very slow on your hardware, you might want to change these. }
{$endif}
{$ifdef BITS_IN_JSAMPLE_IS_8}
{ JSAMPLE should be the smallest type that will hold the values 0..255.
You can use a signed char by having GETJSAMPLE mask it with $FF. }
{ Maximum number of components (color channels) allowed in JPEG image.
To meet the letter of the JPEG spec, set this to 255. However, darn { CHAR_IS_UNSIGNED }
few applications need more than 4 channels (maybe 5 for CMYK + alpha type
mask). We recommend 10 as a reasonable compromise; use 4 if you are JSAMPLE = byte; { Pascal unsigned char }
really short on memory. (Each allowed component costs a hundred or so GETJSAMPLE = int;
bytes of storage, whether actually used in an image or not.) }
const
MAXJSAMPLE = 255;
const CENTERJSAMPLE = 128;
MAX_COMPONENTS = 10; { maximum number of image components }
{$endif}
{ Basic data types. {$ifndef BITS_IN_JSAMPLE_IS_8}
You may need to change these if you have a machine with unusual data { JSAMPLE should be the smallest type that will hold the values 0..4095.
type sizes; for example, "char" not 8 bits, "short" not 16 bits, On nearly all machines "short" will do nicely. }
or "long" not 32 bits. We don't care whether "int" is 16 or 32 bits,
but it had better be at least 16. } type
JSAMPLE = short;
GETJSAMPLE = int;
{ Representation of a single sample (pixel element value).
We frequently allocate large arrays of these, so it's important to keep const
them small. But if you have memory to burn and access to char or short MAXJSAMPLE = 4095;
arrays is very slow on your hardware, you might want to change these. } CENTERJSAMPLE = 2048;
{$endif} { BITS_IN_JSAMPLE = 12 }
{$ifdef BITS_IN_JSAMPLE_IS_8}
{ JSAMPLE should be the smallest type that will hold the values 0..255.
You can use a signed char by having GETJSAMPLE mask it with $FF. } { Representation of a DCT frequency coefficient.
This should be a signed value of at least 16 bits; "short" is usually OK.
{ CHAR_IS_UNSIGNED } Again, we allocate large arrays of these, but you can change to int
type if you have memory to burn and "short" is really slow. }
JSAMPLE = byte; { Pascal unsigned char } type
GETJSAMPLE = int; JCOEF = int;
JCOEF_PTR = ^JCOEF;
const
MAXJSAMPLE = 255;
CENTERJSAMPLE = 128; { Compressed datastreams are represented as arrays of JOCTET.
These must be EXACTLY 8 bits wide, at least once they are written to
{$endif} external storage. Note that when using the stdio data source/destination
managers, this is also the data type passed to fread/fwrite. }
{$ifndef BITS_IN_JSAMPLE_IS_8}
{ JSAMPLE should be the smallest type that will hold the values 0..4095.
On nearly all machines "short" will do nicely. } type
JOCTET = Byte;
type jTOctet = 0..(MaxInt div SizeOf(JOCTET))-1;
JSAMPLE = short; JOCTET_FIELD = array[jTOctet] of JOCTET;
GETJSAMPLE = int; JOCTET_FIELD_PTR = ^JOCTET_FIELD;
JOCTETPTR = ^JOCTET;
const
MAXJSAMPLE = 4095; GETJOCTET = JOCTET; { A work around }
CENTERJSAMPLE = 2048;
{$endif} { BITS_IN_JSAMPLE = 12 } { These typedefs are used for various table entries and so forth.
They must be at least as wide as specified; but making them too big
won't cost a huge amount of memory, so we don't provide special
{ Representation of a DCT frequency coefficient. extraction code like we did for JSAMPLE. (In other words, these
This should be a signed value of at least 16 bits; "short" is usually OK. typedefs live at a different point on the speed/space tradeoff curve.) }
Again, we allocate large arrays of these, but you can change to int
if you have memory to burn and "short" is really slow. }
type { UINT8 must hold at least the values 0..255. }
JCOEF = int;
JCOEF_PTR = ^JCOEF; type
UINT8 = Byte;
{ Compressed datastreams are represented as arrays of JOCTET. { UINT16 must hold at least the values 0..65535. }
These must be EXACTLY 8 bits wide, at least once they are written to
external storage. Note that when using the stdio data source/destination UINT16 = Word;
managers, this is also the data type passed to fread/fwrite. }
{ INT16 must hold at least the values -32768..32767. }
type INT16 = SmallInt;
JOCTET = Byte;
jTOctet = 0..(MaxInt div SizeOf(JOCTET))-1; { INT32 must hold at least signed 32-bit values. }
JOCTET_FIELD = array[jTOctet] of JOCTET;
JOCTET_FIELD_PTR = ^JOCTET_FIELD; INT32 = LongInt;
JOCTETPTR = ^JOCTET; type
INT32PTR = ^INT32;
GETJOCTET = JOCTET; { A work around }
{ Datatype used for image dimensions. The JPEG standard only supports
images up to 64K*64K due to 16-bit fields in SOF markers. Therefore
{ These typedefs are used for various table entries and so forth. "unsigned int" is sufficient on all machines. However, if you need to
They must be at least as wide as specified; but making them too big handle larger images and you don't mind deviating from the spec, you
won't cost a huge amount of memory, so we don't provide special can change this datatype. }
extraction code like we did for JSAMPLE. (In other words, these
typedefs live at a different point on the speed/space tradeoff curve.) } type
JDIMENSION = uInt;
{ UINT8 must hold at least the values 0..255. } const
JPEG_MAX_DIMENSION = 65500; { a tad under 64K to prevent overflows }
type
UINT8 = byte;
{ Ordering of RGB data in scanlines passed to or from the application.
{ UINT16 must hold at least the values 0..65535. } If your application wants to deal with data in the order B,G,R, just
change these macros. You can also deal with formats such as R,G,B,X
UINT16 = Word; (one extra byte per pixel) by changing RGB_PIXELSIZE. Note that changing
the offsets will also change the order in which colormap data is organized.
{ INT16 must hold at least the values -32768..32767. } RESTRICTIONS:
1. The sample applications cjpeg,djpeg do NOT support modified RGB formats.
INT16 = int; 2. These macros only affect RGB<=>YCbCr color conversion, so they are not
useful if you are using JPEG color spaces other than YCbCr or grayscale.
{ INT32 must hold at least signed 32-bit values. } 3. The color quantizer modules will not behave desirably if RGB_PIXELSIZE
is not 3 (they don't understand about dummy color components!). So you
INT32 = longint; can't use color quantization if you change that value. }
type
INT32PTR = ^INT32; {$ifdef RGB_RED_IS_0}
const
{ Datatype used for image dimensions. The JPEG standard only supports RGB_RED = 0; { Offset of Red in an RGB scanline element }
images up to 64K*64K due to 16-bit fields in SOF markers. Therefore RGB_GREEN = 1; { Offset of Green }
"unsigned int" is sufficient on all machines. However, if you need to RGB_BLUE = 2; { Offset of Blue }
handle larger images and you don't mind deviating from the spec, you {$else}
can change this datatype. } const
RGB_RED = 2; { Offset of Red in an RGB scanline element }
type RGB_GREEN = 1; { Offset of Green }
JDIMENSION = uInt; RGB_BLUE = 0; { Offset of Blue }
{$endif}
const
JPEG_MAX_DIMENSION = 65500; { a tad under 64K to prevent overflows } {$ifdef RGB_PIXELSIZE_IS_3}
const
RGB_PIXELSIZE = 3; { JSAMPLEs per RGB scanline element }
{ Ordering of RGB data in scanlines passed to or from the application. {$else}
If your application wants to deal with data in the order B,G,R, just const
change these macros. You can also deal with formats such as R,G,B,X RGB_PIXELSIZE = ??; { Nomssi: deliberate syntax error. Set this value }
(one extra byte per pixel) by changing RGB_PIXELSIZE. Note that changing {$endif}
the offsets will also change the order in which colormap data is organized.
RESTRICTIONS: { Definitions for speed-related optimizations. }
1. The sample applications cjpeg,djpeg do NOT support modified RGB formats.
2. These macros only affect RGB<=>YCbCr color conversion, so they are not { On some machines (notably 68000 series) "int" is 32 bits, but multiplying
useful if you are using JPEG color spaces other than YCbCr or grayscale. two 16-bit shorts is faster than multiplying two ints. Define MULTIPLIER
3. The color quantizer modules will not behave desirably if RGB_PIXELSIZE as short on such a machine. MULTIPLIER must be at least 16 bits wide. }
is not 3 (they don't understand about dummy color components!). So you type
can't use color quantization if you change that value. } MULTIPLIER = int; { type for fastest integer multiply }
{$ifdef RGB_RED_IS_0}
const { FAST_FLOAT should be either float or double, whichever is done faster
RGB_RED = 0; { Offset of Red in an RGB scanline element } by your compiler. (Note that this type is only used in the floating point
RGB_GREEN = 1; { Offset of Green } DCT routines, so it only matters if you've defined DCT_FLOAT_SUPPORTED.)
RGB_BLUE = 2; { Offset of Blue } Typically, float is faster in ANSI C compilers, while double is faster in
{$else} pre-ANSI compilers (because they insist on converting to double anyway).
const The code below therefore chooses float if we have ANSI-style prototypes. }
RGB_RED = 2; { Offset of Red in an RGB scanline element }
RGB_GREEN = 1; { Offset of Green } type
RGB_BLUE = 0; { Offset of Blue } FAST_FLOAT = double; {float}
{$endif}
{$ifdef RGB_PIXELSIZE_IS_3} implementation
const
RGB_PIXELSIZE = 3; { JSAMPLEs per RGB scanline element }
{$else} end.
const
RGB_PIXELSIZE = ??; { Nomssi: deliberate syntax error. Set this value }
{$endif}
{ Definitions for speed-related optimizations. }
{ On some machines (notably 68000 series) "int" is 32 bits, but multiplying
two 16-bit shorts is faster than multiplying two ints. Define MULTIPLIER
as short on such a machine. MULTIPLIER must be at least 16 bits wide. }
type
MULTIPLIER = int; { type for fastest integer multiply }
{ FAST_FLOAT should be either float or double, whichever is done faster
by your compiler. (Note that this type is only used in the floating point
DCT routines, so it only matters if you've defined DCT_FLOAT_SUPPORTED.)
Typically, float is faster in ANSI C compilers, while double is faster in
pre-ANSI compilers (because they insist on converting to double anyway).
The code below therefore chooses float if we have ANSI-style prototypes. }
type
FAST_FLOAT = double; {float}
implementation
end.

2600
Imaging/JpegLib/imjpeglib.pas
View File

File diff suppressed because it is too large Load Diff

2018
Imaging/JpegLib/imjquant1.pas
View File

File diff suppressed because it is too large Load Diff

3102
Imaging/JpegLib/imjquant2.pas
View File

File diff suppressed because it is too large Load Diff

464
Imaging/JpegLib/imjutils.pas
View File

@ -1,232 +1,232 @@
unit imjutils; unit imjutils;
{ This file contains tables and miscellaneous utility routines needed { This file contains tables and miscellaneous utility routines needed
for both compression and decompression. for both compression and decompression.
Note we prefix all global names with "j" to minimize conflicts with Note we prefix all global names with "j" to minimize conflicts with
a surrounding application. } a surrounding application. }
{ Source: jutils.c; Copyright (C) 1991-1996, Thomas G. Lane. } { Source: jutils.c; Copyright (C) 1991-1996, Thomas G. Lane. }
interface interface
{$I imjconfig.inc} {$I imjconfig.inc}
uses uses
imjmorecfg, imjmorecfg,
imjinclude, imjinclude,
imjpeglib; imjpeglib;
{ jpeg_zigzag_order[i] is the zigzag-order position of the i'th element { jpeg_zigzag_order[i] is the zigzag-order position of the i'th element
of a DCT block read in natural order (left to right, top to bottom). } of a DCT block read in natural order (left to right, top to bottom). }
{$ifdef FALSE} { This table is not actually needed in v6a } {$ifdef FALSE} { This table is not actually needed in v6a }
const const
jpeg_zigzag_order : array[0..DCTSIZE2] of int = jpeg_zigzag_order : array[0..DCTSIZE2] of int =
(0, 1, 5, 6, 14, 15, 27, 28, (0, 1, 5, 6, 14, 15, 27, 28,
2, 4, 7, 13, 16, 26, 29, 42, 2, 4, 7, 13, 16, 26, 29, 42,
3, 8, 12, 17, 25, 30, 41, 43, 3, 8, 12, 17, 25, 30, 41, 43,
9, 11, 18, 24, 31, 40, 44, 53, 9, 11, 18, 24, 31, 40, 44, 53,
10, 19, 23, 32, 39, 45, 52, 54, 10, 19, 23, 32, 39, 45, 52, 54,
20, 22, 33, 38, 46, 51, 55, 60, 20, 22, 33, 38, 46, 51, 55, 60,
21, 34, 37, 47, 50, 56, 59, 61, 21, 34, 37, 47, 50, 56, 59, 61,
35, 36, 48, 49, 57, 58, 62, 63); 35, 36, 48, 49, 57, 58, 62, 63);
{$endif} {$endif}
{ jpeg_natural_order[i] is the natural-order position of the i'th element { jpeg_natural_order[i] is the natural-order position of the i'th element
of zigzag order. of zigzag order.
When reading corrupted data, the Huffman decoders could attempt When reading corrupted data, the Huffman decoders could attempt
to reference an entry beyond the end of this array (if the decoded to reference an entry beyond the end of this array (if the decoded
zero run length reaches past the end of the block). To prevent zero run length reaches past the end of the block). To prevent
wild stores without adding an inner-loop test, we put some extra wild stores without adding an inner-loop test, we put some extra
"63"s after the real entries. This will cause the extra coefficient "63"s after the real entries. This will cause the extra coefficient
to be stored in location 63 of the block, not somewhere random. to be stored in location 63 of the block, not somewhere random.
The worst case would be a run-length of 15, which means we need 16 The worst case would be a run-length of 15, which means we need 16
fake entries. } fake entries. }
const const
jpeg_natural_order : array[0..DCTSIZE2+16-1] of int = jpeg_natural_order : array[0..DCTSIZE2+16-1] of int =
(0, 1, 8, 16, 9, 2, 3, 10, (0, 1, 8, 16, 9, 2, 3, 10,
17, 24, 32, 25, 18, 11, 4, 5, 17, 24, 32, 25, 18, 11, 4, 5,
12, 19, 26, 33, 40, 48, 41, 34, 12, 19, 26, 33, 40, 48, 41, 34,
27, 20, 13, 6, 7, 14, 21, 28, 27, 20, 13, 6, 7, 14, 21, 28,
35, 42, 49, 56, 57, 50, 43, 36, 35, 42, 49, 56, 57, 50, 43, 36,
29, 22, 15, 23, 30, 37, 44, 51, 29, 22, 15, 23, 30, 37, 44, 51,
58, 59, 52, 45, 38, 31, 39, 46, 58, 59, 52, 45, 38, 31, 39, 46,
53, 60, 61, 54, 47, 55, 62, 63, 53, 60, 61, 54, 47, 55, 62, 63,
63, 63, 63, 63, 63, 63, 63, 63, { extra entries for safety in decoder } 63, 63, 63, 63, 63, 63, 63, 63, { extra entries for safety in decoder }
63, 63, 63, 63, 63, 63, 63, 63); 63, 63, 63, 63, 63, 63, 63, 63);
{ Arithmetic utilities } { Arithmetic utilities }
{GLOBAL} {GLOBAL}
function jdiv_round_up (a : long; b : long) : long; function jdiv_round_up (a : long; b : long) : long;
{GLOBAL} {GLOBAL}
function jround_up (a : long; b : long) : long; function jround_up (a : long; b : long) : long;
{GLOBAL} {GLOBAL}
procedure jcopy_sample_rows (input_array : JSAMPARRAY; procedure jcopy_sample_rows (input_array : JSAMPARRAY;
source_row : int; source_row : int;
output_array : JSAMPARRAY; dest_row : int; output_array : JSAMPARRAY; dest_row : int;
num_rows : int; num_cols : JDIMENSION); num_rows : int; num_cols : JDIMENSION);
{GLOBAL} {GLOBAL}
procedure jcopy_block_row (input_row : JBLOCKROW; procedure jcopy_block_row (input_row : JBLOCKROW;
output_row : JBLOCKROW; output_row : JBLOCKROW;
num_blocks : JDIMENSION); num_blocks : JDIMENSION);
{GLOBAL} {GLOBAL}
procedure jzero_far (target : pointer;{far} bytestozero : size_t); procedure jzero_far (target : pointer;{far} bytestozero : size_t);
procedure FMEMZERO(target : pointer; size : size_t); procedure FMEMZERO(target : pointer; size : size_t);
procedure FMEMCOPY(dest,src : pointer; size : size_t); procedure FMEMCOPY(dest,src : pointer; size : size_t);
implementation implementation
{GLOBAL} {GLOBAL}
function jdiv_round_up (a : long; b : long) : long; function jdiv_round_up (a : long; b : long) : long;
{ Compute a/b rounded up to next integer, ie, ceil(a/b) } { Compute a/b rounded up to next integer, ie, ceil(a/b) }
{ Assumes a >= 0, b > 0 } { Assumes a >= 0, b > 0 }
begin begin
jdiv_round_up := (a + b - long(1)) div b; jdiv_round_up := (a + b - long(1)) div b;
end; end;
{GLOBAL} {GLOBAL}
function jround_up (a : long; b : long) : long; function jround_up (a : long; b : long) : long;
{ Compute a rounded up to next multiple of b, ie, ceil(a/b)*b } { Compute a rounded up to next multiple of b, ie, ceil(a/b)*b }
{ Assumes a >= 0, b > 0 } { Assumes a >= 0, b > 0 }
begin begin
Inc(a, b - long(1)); Inc(a, b - long(1));
jround_up := a - (a mod b); jround_up := a - (a mod b);
end; end;
{ On normal machines we can apply MEMCOPY() and MEMZERO() to sample arrays { On normal machines we can apply MEMCOPY() and MEMZERO() to sample arrays
and coefficient-block arrays. This won't work on 80x86 because the arrays and coefficient-block arrays. This won't work on 80x86 because the arrays
are FAR and we're assuming a small-pointer memory model. However, some are FAR and we're assuming a small-pointer memory model. However, some
DOS compilers provide far-pointer versions of memcpy() and memset() even DOS compilers provide far-pointer versions of memcpy() and memset() even
in the small-model libraries. These will be used if USE_FMEM is defined. in the small-model libraries. These will be used if USE_FMEM is defined.
Otherwise, the routines below do it the hard way. (The performance cost Otherwise, the routines below do it the hard way. (The performance cost
is not all that great, because these routines aren't very heavily used.) } is not all that great, because these routines aren't very heavily used.) }
{$ifndef NEED_FAR_POINTERS} { normal case, same as regular macros } {$ifndef NEED_FAR_POINTERS} { normal case, same as regular macros }
procedure FMEMZERO(target : pointer; size : size_t); procedure FMEMZERO(target : pointer; size : size_t);
begin begin
FillChar(target^, size, 0); FillChar(target^, size, 0);
end; end;
procedure FMEMCOPY(dest,src : pointer; size : size_t); procedure FMEMCOPY(dest,src : pointer; size : size_t);
begin begin
Move(src^, dest^, size); Move(src^, dest^, size);
end; end;
{$else} { 80x86 case, define if we can } {$else} { 80x86 case, define if we can }
{$ifdef USE_FMEM} {$ifdef USE_FMEM}
FMEMCOPY(dest,src,size) _fmemcpy((void FAR *)(dest), (const void FAR *)(src), (size_t)(size)) FMEMCOPY(dest,src,size) _fmemcpy((void FAR *)(dest), (const void FAR *)(src), (size_t)(size))
FMEMZERO(target,size) _fmemset((void FAR *)(target), 0, (size_t)(size)) FMEMZERO(target,size) _fmemset((void FAR *)(target), 0, (size_t)(size))
{$endif} {$endif}
{$endif} {$endif}
{GLOBAL} {GLOBAL}
procedure jcopy_sample_rows (input_array : JSAMPARRAY; source_row : int; procedure jcopy_sample_rows (input_array : JSAMPARRAY; source_row : int;
output_array : JSAMPARRAY; dest_row : int; output_array : JSAMPARRAY; dest_row : int;
num_rows : int; num_cols : JDIMENSION); num_rows : int; num_cols : JDIMENSION);
{ Copy some rows of samples from one place to another. { Copy some rows of samples from one place to another.
num_rows rows are copied from input_array[source_row++] num_rows rows are copied from input_array[source_row++]
to output_array[dest_row++]; these areas may overlap for duplication. to output_array[dest_row++]; these areas may overlap for duplication.
The source and destination arrays must be at least as wide as num_cols. } The source and destination arrays must be at least as wide as num_cols. }
var var
inptr, outptr : JSAMPLE_PTR; {register} inptr, outptr : JSAMPLE_PTR; {register}
{$ifdef FMEMCOPY} {$ifdef FMEMCOPY}
count : size_t; {register} count : size_t; {register}
{$else} {$else}
count : JDIMENSION; {register} count : JDIMENSION; {register}
{$endif} {$endif}
row : int; {register} row : int; {register}
begin begin
{$ifdef FMEMCOPY} {$ifdef FMEMCOPY}
count := size_t(num_cols * SIZEOF(JSAMPLE)); count := size_t(num_cols * SIZEOF(JSAMPLE));
{$endif} {$endif}
Inc(JSAMPROW_PTR(input_array), source_row); Inc(JSAMPROW_PTR(input_array), source_row);
Inc(JSAMPROW_PTR(output_array), dest_row); Inc(JSAMPROW_PTR(output_array), dest_row);
for row := pred(num_rows) downto 0 do for row := pred(num_rows) downto 0 do
begin begin
inptr := JSAMPLE_PTR(input_array^[0]); inptr := JSAMPLE_PTR(input_array^[0]);
Inc(JSAMPROW_PTR(input_array)); Inc(JSAMPROW_PTR(input_array));
outptr := JSAMPLE_PTR(output_array^[0]); outptr := JSAMPLE_PTR(output_array^[0]);
Inc(JSAMPROW_PTR(output_array)); Inc(JSAMPROW_PTR(output_array));
{$ifdef FMEMCOPY} {$ifdef FMEMCOPY}
FMEMCOPY(outptr, inptr, count); FMEMCOPY(outptr, inptr, count);
{$else} {$else}
for count := pred(num_cols) downto 0 do for count := pred(num_cols) downto 0 do
begin begin
outptr^ := inptr^; { needn't bother with GETJSAMPLE() here } outptr^ := inptr^; { needn't bother with GETJSAMPLE() here }
Inc(inptr); Inc(inptr);
Inc(outptr); Inc(outptr);
end; end;
{$endif} {$endif}
end; end;
end; end;
{GLOBAL} {GLOBAL}
procedure jcopy_block_row (input_row : JBLOCKROW; procedure jcopy_block_row (input_row : JBLOCKROW;
output_row : JBLOCKROW; output_row : JBLOCKROW;
num_blocks : JDIMENSION); num_blocks : JDIMENSION);
{ Copy a row of coefficient blocks from one place to another. } { Copy a row of coefficient blocks from one place to another. }
{$ifdef FMEMCOPY} {$ifdef FMEMCOPY}
begin begin
FMEMCOPY(output_row, input_row, num_blocks * (DCTSIZE2 * SIZEOF(JCOEF))); FMEMCOPY(output_row, input_row, num_blocks * (DCTSIZE2 * SIZEOF(JCOEF)));
{$else} {$else}
var var
inptr, outptr : JCOEFPTR; {register} inptr, outptr : JCOEFPTR; {register}
count : long; {register} count : long; {register}
begin begin
inptr := JCOEFPTR (input_row); inptr := JCOEFPTR (input_row);
outptr := JCOEFPTR (output_row); outptr := JCOEFPTR (output_row);
for count := long(num_blocks) * DCTSIZE2 -1 downto 0 do for count := long(num_blocks) * DCTSIZE2 -1 downto 0 do
begin begin
outptr^ := inptr^; outptr^ := inptr^;
Inc(outptr); Inc(outptr);
Inc(inptr); Inc(inptr);
end; end;
{$endif} {$endif}
end; end;
{GLOBAL} {GLOBAL}
procedure jzero_far (target : pointer;{far} bytestozero : size_t); procedure jzero_far (target : pointer;{far} bytestozero : size_t);
{ Zero out a chunk of FAR memory. } { Zero out a chunk of FAR memory. }
{ This might be sample-array data, block-array data, or alloc_large data. } { This might be sample-array data, block-array data, or alloc_large data. }
{$ifdef FMEMZERO} {$ifdef FMEMZERO}
begin begin
FMEMZERO(target, bytestozero); FMEMZERO(target, bytestozero);
{$else} {$else}
var var
ptr : byteptr; ptr : byteptr;
count : size_t; {register} count : size_t; {register}
begin begin
ptr := target; ptr := target;
for count := bytestozero-1 downto 0 do for count := bytestozero-1 downto 0 do
begin begin
ptr^ := 0; ptr^ := 0;
Inc(ptr); Inc(ptr);
end; end;
{$endif} {$endif}
end; end;
end. end.

760
Imaging/JpegLib/readme.txt
View File

@ -1,381 +1,381 @@
_____________________________________________________________________________ _____________________________________________________________________________
PASJPEG 1.1 May 29th, 1999 PASJPEG 1.1 May 29th, 1999
Based on the Independent JPEG Group's JPEG software release 6b Based on the Independent JPEG Group's JPEG software release 6b
Copyright (C) 1996,1998,1999 by NOMSSI NZALI Jacques H. C. Copyright (C) 1996,1998,1999 by NOMSSI NZALI Jacques H. C.
[kn&n DES] See "Legal issues" for conditions of distribution and use. [kn&n DES] See "Legal issues" for conditions of distribution and use.
_____________________________________________________________________________ _____________________________________________________________________________
Information in this file Information in this file
======================== ========================
o Introduction o Introduction
o Notes o Notes
o File list o File list
o Translation o Translation
o Legal issues o Legal issues
o Archive Locations o Archive Locations
Introduction Introduction
============ ============
PASJPEG is a port of the sixth public release of the IJG C source (release PASJPEG is a port of the sixth public release of the IJG C source (release
6b of 27-Mar-98) [3], that implements JPEG baseline, extended-sequential, and 6b of 27-Mar-98) [3], that implements JPEG baseline, extended-sequential, and
progressive compression processes to Turbo Pascal 7.0 for DOS (TP). The code progressive compression processes to Turbo Pascal 7.0 for DOS (TP). The code
has been tested under Delphi 3.0, it can be ported to other Pascal has been tested under Delphi 3.0, it can be ported to other Pascal
environments, since many compilers try to be compatible to TP. environments, since many compilers try to be compatible to TP.
JPEG (pronounced "jay-peg") is a standardized familly of algorithms for JPEG (pronounced "jay-peg") is a standardized familly of algorithms for
compression of continous tone still images. Most JPEG processes are lossy, compression of continous tone still images. Most JPEG processes are lossy,
the output image is not exactly identical to the input image. However, on the output image is not exactly identical to the input image. However, on
typical photographic images, very good compression levels can be obtained typical photographic images, very good compression levels can be obtained
with no visible change, and remarkably high compression levels are possible with no visible change, and remarkably high compression levels are possible
if you can tolerate a low-quality image [1],[2]. The Independent JPEG Group if you can tolerate a low-quality image [1],[2]. The Independent JPEG Group
(IJG) has created a free, portable C library for JPEG compression and (IJG) has created a free, portable C library for JPEG compression and
decompression of JPEG images. decompression of JPEG images.
The IJG documentation (system architecture, using the IJG JPEG library, The IJG documentation (system architecture, using the IJG JPEG library,
usage and file list) is a must read. The files DEMO.PAS, TEST.PAS, CJPEG.PAS, usage and file list) is a must read. The files DEMO.PAS, TEST.PAS, CJPEG.PAS,
DJPEG.PAS and EXAMPLE.PAS demonstrate the usage of the JPEG decompression DJPEG.PAS and EXAMPLE.PAS demonstrate the usage of the JPEG decompression
and compression library. The RDJPGCOM application shows how to parse a JFIF and compression library. The RDJPGCOM application shows how to parse a JFIF
file. file.
Notes: Notes:
====== ======
* Please report any errors/problems you may find in code and in the * Please report any errors/problems you may find in code and in the
documentation (e.g. this README.TXT file). documentation (e.g. this README.TXT file).
* The sample applications (CJPEG, DJPEG) doesn't support all the options * The sample applications (CJPEG, DJPEG) doesn't support all the options
of the original C code. WRJPGCOM is not ported. of the original C code. WRJPGCOM is not ported.
* Environment variable JPEGMEM syntax changed; * Environment variable JPEGMEM syntax changed;
* You can modify the jpeg.pas unit from the Delphi 3 distribution to * You can modify the jpeg.pas unit from the Delphi 3 distribution to
use PasJPEG. use PasJPEG.
Change log Change log
========== ==========
1. bugs fixed: 1. bugs fixed:
* in procedure read_gif_map(), unit RDCOLMAP.PAS (used by DJPEG sample * in procedure read_gif_map(), unit RDCOLMAP.PAS (used by DJPEG sample
application). Davie Lee Reed <smatters@iquest.net> application). Davie Lee Reed <smatters@iquest.net>
* -dct int and -dct fast now bytewise equal to the IJG output. * -dct int and -dct fast now bytewise equal to the IJG output.
* -dct float produced large files * -dct float produced large files
2. Support for scripts 2. Support for scripts
3. BASM version of JIDCTINT.PAS for Delphi 2 and 3. 3. BASM version of JIDCTINT.PAS for Delphi 2 and 3.
4. images with integral sampling ratios were not decoded correctly. 4. images with integral sampling ratios were not decoded correctly.
Create a jpeg file with cjpeg and the option "-sample 4x1" and try to decode Create a jpeg file with cjpeg and the option "-sample 4x1" and try to decode
it with any software that uses PasJpeg. Thanks to Jannie Gerber for reporting it with any software that uses PasJpeg. Thanks to Jannie Gerber for reporting
this with a fix: In JDSAMPLE.PAS, procedure int_upsample(), this with a fix: In JDSAMPLE.PAS, procedure int_upsample(),
for h := pred(h_expand) downto 0 do for h := pred(h_expand) downto 0 do
begin begin
outptr^ := invalue; outptr^ := invalue;
+=> inc(outptr); { this is the culprit that was left out!!! } +=> inc(outptr); { this is the culprit that was left out!!! }
Dec(outcount); Dec(outcount);
end; end;
File list File list
========= =========
Here is a road map to the files in the PasJPEG distribution. The Here is a road map to the files in the PasJPEG distribution. The
distribution includes the JPEG library proper, plus two application distribution includes the JPEG library proper, plus two application
programs ("cjpeg" and "djpeg") which use the library to convert JPEG programs ("cjpeg" and "djpeg") which use the library to convert JPEG
files to and from some other popular image formats. A third application files to and from some other popular image formats. A third application
"jpegtran" uses the library to do lossless conversion between different "jpegtran" uses the library to do lossless conversion between different
variants of JPEG. There is also the stand-alone applications "rdjpgcom". variants of JPEG. There is also the stand-alone applications "rdjpgcom".
Documentation(see README for a guide to the documentation files): Documentation(see README for a guide to the documentation files):
readme.txt Introduction, Documentation readme.txt Introduction, Documentation
Additional files Additional files
demo.pas Demo program, uses example.pas demo.pas Demo program, uses example.pas
example.pas Sample code for calling JPEG library. example.pas Sample code for calling JPEG library.
test.pas Sample application code for demo.pas test.pas Sample application code for demo.pas
Configuration/installation files and programs (see install.doc for more info): Configuration/installation files and programs (see install.doc for more info):
jconfig.inc Configuration declarations. jconfig.inc Configuration declarations.
*.ijg script files *.ijg script files
Pascal source code files: Pascal source code files:
jinclude.pas Central include file used by all IJG .c files to reference jinclude.pas Central include file used by all IJG .c files to reference
system include files. system include files.
jpeglib.pas JPEG library's internal data structures, exported data jpeglib.pas JPEG library's internal data structures, exported data
and function declarations. and function declarations.
jmorecfg.pas Additional configuration declarations; need not be changed jmorecfg.pas Additional configuration declarations; need not be changed
for a standard installation. for a standard installation.
jdeferr.pas defines the error and message text. jdeferr.pas defines the error and message text.
jerror.pas Declares JPEG library's error and trace message codes. jerror.pas Declares JPEG library's error and trace message codes.
jinclude.pas the place to specify system depedent input/output code. jinclude.pas the place to specify system depedent input/output code.
jdct.pas Private declarations for forward & reverse DCT subsystems. jdct.pas Private declarations for forward & reverse DCT subsystems.
These files contain most of the functions intended to be called directly by These files contain most of the functions intended to be called directly by
an application program: an application program:
jcapimin.pas Application program interface: core routines for compression. jcapimin.pas Application program interface: core routines for compression.
jcapistd.pas Application program interface: standard compression. jcapistd.pas Application program interface: standard compression.
jdapimin.pas Application program interface: core routines for decompression. jdapimin.pas Application program interface: core routines for decompression.
jdapistd.pas Application program interface: standard decompression. jdapistd.pas Application program interface: standard decompression.
jcomapi.pas Application program interface routines common to compression jcomapi.pas Application program interface routines common to compression
and decompression. and decompression.
jcparam.pas Compression parameter setting helper routines. jcparam.pas Compression parameter setting helper routines.
jctrans.pas API and library routines for transcoding compression. jctrans.pas API and library routines for transcoding compression.
jdtrans.pas API and library routines for transcoding decompression. jdtrans.pas API and library routines for transcoding decompression.
Compression side of the library: Compression side of the library:
jcinit.pas Initialization: determines which other modules to use. jcinit.pas Initialization: determines which other modules to use.
jcmaster.pas Master control: setup and inter-pass sequencing logic. jcmaster.pas Master control: setup and inter-pass sequencing logic.
jcmainct.pas Main buffer controller (preprocessor => JPEG compressor). jcmainct.pas Main buffer controller (preprocessor => JPEG compressor).
jcprepct.pas Preprocessor buffer controller. jcprepct.pas Preprocessor buffer controller.
jccoefct.pas Buffer controller for DCT coefficient buffer. jccoefct.pas Buffer controller for DCT coefficient buffer.
jccolor.pas Color space conversion. jccolor.pas Color space conversion.
jcsample.pas Downsampling. jcsample.pas Downsampling.
jcdctmgr.pas DCT manager (DCT implementation selection & control). jcdctmgr.pas DCT manager (DCT implementation selection & control).
jfdctint.pas Forward DCT using slow-but-accurate integer method. jfdctint.pas Forward DCT using slow-but-accurate integer method.
jfdctfst.pas Forward DCT using faster, less accurate integer method. jfdctfst.pas Forward DCT using faster, less accurate integer method.
jfdctflt.pas Forward DCT using floating-point arithmetic. jfdctflt.pas Forward DCT using floating-point arithmetic.
jchuff.pas Huffman entropy coding for sequential JPEG. jchuff.pas Huffman entropy coding for sequential JPEG.
jcphuff.pas Huffman entropy coding for progressive JPEG. jcphuff.pas Huffman entropy coding for progressive JPEG.
jcmarker.pas JPEG marker writing. jcmarker.pas JPEG marker writing.
jdatadst.pas Data destination manager for stdio output. jdatadst.pas Data destination manager for stdio output.
Decompression side of the library: Decompression side of the library:
jdmaster.pas Master control: determines which other modules to use. jdmaster.pas Master control: determines which other modules to use.
jdinput.pas Input controller: controls input processing modules. jdinput.pas Input controller: controls input processing modules.
jdmainct.pas Main buffer controller (JPEG decompressor => postprocessor). jdmainct.pas Main buffer controller (JPEG decompressor => postprocessor).
jdcoefct.pas Buffer controller for DCT coefficient buffer. jdcoefct.pas Buffer controller for DCT coefficient buffer.
jdpostct.pas Postprocessor buffer controller. jdpostct.pas Postprocessor buffer controller.
jdmarker.pas JPEG marker reading. jdmarker.pas JPEG marker reading.
jdhuff.pas Huffman entropy decoding for sequential JPEG. jdhuff.pas Huffman entropy decoding for sequential JPEG.
jdphuff.pas Huffman entropy decoding for progressive JPEG. jdphuff.pas Huffman entropy decoding for progressive JPEG.
jddctmgr.pas IDCT manager (IDCT implementation selection & control). jddctmgr.pas IDCT manager (IDCT implementation selection & control).
jidctint.pas Inverse DCT using slow-but-accurate integer method. jidctint.pas Inverse DCT using slow-but-accurate integer method.
jidctasm.pas BASM specific version of jidctint.pas for 32bit Delphi. jidctasm.pas BASM specific version of jidctint.pas for 32bit Delphi.
jidctfst.pas Inverse DCT using faster, less accurate integer method. jidctfst.pas Inverse DCT using faster, less accurate integer method.
jidctflt.pas Inverse DCT using floating-point arithmetic. jidctflt.pas Inverse DCT using floating-point arithmetic.
jidctred.pas Inverse DCTs with reduced-size outputs. jidctred.pas Inverse DCTs with reduced-size outputs.
jidct2d.pas How to for a direct 2D Inverse DCT - not used jidct2d.pas How to for a direct 2D Inverse DCT - not used
jdsample.pas Upsampling. jdsample.pas Upsampling.
jdcolor.pas Color space conversion. jdcolor.pas Color space conversion.
jdmerge.pas Merged upsampling/color conversion (faster, lower quality). jdmerge.pas Merged upsampling/color conversion (faster, lower quality).
jquant1.pas One-pass color quantization using a fixed-spacing colormap. jquant1.pas One-pass color quantization using a fixed-spacing colormap.
jquant2.pas Two-pass color quantization using a custom-generated colormap. jquant2.pas Two-pass color quantization using a custom-generated colormap.
Also handles one-pass quantization to an externally given map. Also handles one-pass quantization to an externally given map.
jdatasrc.pas Data source manager for stdio input. jdatasrc.pas Data source manager for stdio input.
Support files for both compression and decompression: Support files for both compression and decompression:
jerror.pas Standard error handling routines (application replaceable). jerror.pas Standard error handling routines (application replaceable).
jmemmgr.pas System-independent (more or less) memory management code. jmemmgr.pas System-independent (more or less) memory management code.
jutils.pas Miscellaneous utility routines. jutils.pas Miscellaneous utility routines.
jmemmgr.pas relies on a system-dependent memory management module. The jmemmgr.pas relies on a system-dependent memory management module. The
PASJPEG distribution includes the following implementations of the system- PASJPEG distribution includes the following implementations of the system-
dependent module: dependent module:
jmemnobs.pas "No backing store": assumes adequate virtual memory exists. jmemnobs.pas "No backing store": assumes adequate virtual memory exists.
jmemdos.pas Custom implementation for MS-DOS (16-bit environment only): jmemdos.pas Custom implementation for MS-DOS (16-bit environment only):
can use extended and expanded memory as well as temporary can use extended and expanded memory as well as temporary
files. files.
jmemsys.pas A skeleton with all the declaration you need to create a jmemsys.pas A skeleton with all the declaration you need to create a
working system-dependent JPEG memory manager on unusual working system-dependent JPEG memory manager on unusual
systems. systems.
Exactly one of the system-dependent units should be used in jmemmgr.pas. Exactly one of the system-dependent units should be used in jmemmgr.pas.
jmemdosa.pas BASM 80x86 assembly code support for jmemdos.pas; used only jmemdosa.pas BASM 80x86 assembly code support for jmemdos.pas; used only
in MS-DOS-specific configurations of the JPEG library. in MS-DOS-specific configurations of the JPEG library.
Applications using the library should use jmorecfg, jerror, jpeglib, and Applications using the library should use jmorecfg, jerror, jpeglib, and
include jconfig.inc. include jconfig.inc.
CJPEG/DJPEG/JPEGTRAN CJPEG/DJPEG/JPEGTRAN
Pascal source code files: Pascal source code files:
cderror.pas Additional error and trace message codes for cjpeg/djpeg. cderror.pas Additional error and trace message codes for cjpeg/djpeg.
Not used, Those errors have been added to jdeferr. Not used, Those errors have been added to jdeferr.
cjpeg.pas Main program for cjpeg. cjpeg.pas Main program for cjpeg.
djpeg.pas Main program for djpeg. djpeg.pas Main program for djpeg.
jpegtran.pas Main program for jpegtran. jpegtran.pas Main program for jpegtran.
cdjpeg.pas Utility routines used by all three programs. cdjpeg.pas Utility routines used by all three programs.
rdcolmap.pas Code to read a colormap file for djpeg's "-map" switch. rdcolmap.pas Code to read a colormap file for djpeg's "-map" switch.
rdswitch.pas Code to process some of cjpeg's more complex switches. rdswitch.pas Code to process some of cjpeg's more complex switches.
Also used by jpegtran. Also used by jpegtran.
transupp.pas Support code for jpegtran: lossless image manipulations. transupp.pas Support code for jpegtran: lossless image manipulations.
fcache.pas fcache.pas
rdswitch.pas Code to process some of cjpeg's more complex switches. rdswitch.pas Code to process some of cjpeg's more complex switches.
Also used by jpegtran. Also used by jpegtran.
Image file writer modules for djpeg: Image file writer modules for djpeg:
wrbmp.pas BMP file output. wrbmp.pas BMP file output.
wrppm.pas PPM/PGM file output. wrppm.pas PPM/PGM file output.
wrtarga.pas Targa file output. wrtarga.pas Targa file output.
Image file reader modules for cjpeg: Image file reader modules for cjpeg:
rdbmp.pas BMP file input. rdbmp.pas BMP file input.
rdppm.pas PPM/PGM file input. rdppm.pas PPM/PGM file input.
rdtarga.pas Targa file input. - NOT READY YET rdtarga.pas Targa file input. - NOT READY YET
This program does not depend on the JPEG library This program does not depend on the JPEG library
rdjpgcom.pas Stand-alone rdjpgcom application. rdjpgcom.pas Stand-alone rdjpgcom application.
Translation Translation
=========== ===========
TP is unit-centric, exported type definitions and routines are declared TP is unit-centric, exported type definitions and routines are declared
in the "interface" part of the unit, "make" files are not needed. in the "interface" part of the unit, "make" files are not needed.
Macros are not supported, they were either copied as needed or translated Macros are not supported, they were either copied as needed or translated
to Pascal routines (procedure). The procedures will be replaced by code in to Pascal routines (procedure). The procedures will be replaced by code in
later releases. later releases.
Conditional defines that indicate whether to include various optional Conditional defines that indicate whether to include various optional
functions are defined in the file JCONFIG.INC. This file is included first functions are defined in the file JCONFIG.INC. This file is included first
in all source files. in all source files.
The base type definitions are in the unit JMORECFG.PAS. The error handling The base type definitions are in the unit JMORECFG.PAS. The error handling
macros have been converted to procedures in JERROR.PAS. The error codes are macros have been converted to procedures in JERROR.PAS. The error codes are
in JDEFERR.PAS. jpegint.h and jpeglib.h were merged into one large unit in JDEFERR.PAS. jpegint.h and jpeglib.h were merged into one large unit
JPEGLIB.PAS containing type definitions with global scope. JPEGLIB.PAS containing type definitions with global scope.
The translation of the header file is the most sophisticated work, a good The translation of the header file is the most sophisticated work, a good
understanding of the syntax is required. Once the header files are done, understanding of the syntax is required. Once the header files are done,
the translation turns into a lot of editing work. Each C source file was the translation turns into a lot of editing work. Each C source file was
converted to a unit by editing the syntax (separate variable definition converted to a unit by editing the syntax (separate variable definition
and usage, define labels, group variable definitions, expanding macros, etc). and usage, define labels, group variable definitions, expanding macros, etc).
The IJG source labels routines GLOBAL, METHODDEF and LOCAL. All globals The IJG source labels routines GLOBAL, METHODDEF and LOCAL. All globals
routines are in the interface section of the units. The "far" directive is routines are in the interface section of the units. The "far" directive is
used for methods (METHODDEF). used for methods (METHODDEF).
Some C -> Pascal examples. Some C -> Pascal examples.
* "{" -> "begin" "->" -> "^." " = " -> " := " "<<" -> " shl " * "{" -> "begin" "->" -> "^." " = " -> " := " "<<" -> " shl "
"}" -> "end;" "!=" -> "<>" " == " -> " = " ">>" -> " shr " "}" -> "end;" "!=" -> "<>" " == " -> " = " ">>" -> " shr "
"/*" -> "{" routine -> function "0x" -> "$" "/*" -> "{" routine -> function "0x" -> "$"
"*/" -> "}" (void) procedure "NULL" -> "NIL" "*/" -> "}" (void) procedure "NULL" -> "NIL"
* structs are records, Unions are variable records, pointers are always far, * structs are records, Unions are variable records, pointers are always far,
the operators && and || (and/or) have not the same priority in both the operators && and || (and/or) have not the same priority in both
languages, so parenthesis are important. The Pascal "case" doesn't have the languages, so parenthesis are important. The Pascal "case" doesn't have the
falltrough option of the C "switch" statement, my work around is to split falltrough option of the C "switch" statement, my work around is to split
one "switch" statement into many case statements. one "switch" statement into many case statements.
* The pointer type in C is not readily interchangeable. It is used to address * The pointer type in C is not readily interchangeable. It is used to address
an array (Pascal pointer to an array) or in pointer arithmetic a pointer to an array (Pascal pointer to an array) or in pointer arithmetic a pointer to
a single element. I've used the Inc() statement with type casting to a single element. I've used the Inc() statement with type casting to
translate pointer arithmetic most of the time. translate pointer arithmetic most of the time.
C example: C example:
typedef JSAMPLE* JSAMPROW; /* ptr to one image row of pixel samples. */ typedef JSAMPLE* JSAMPROW; /* ptr to one image row of pixel samples. */
Pascal Pascal
type type
JSAMPLE_PTR = ^JSAMPLE; { ptr to a single pixel sample. } JSAMPLE_PTR = ^JSAMPLE; { ptr to a single pixel sample. }
jTSample = 0..(MaxInt div SIZEOF(JSAMPLE))-1; jTSample = 0..(MaxInt div SIZEOF(JSAMPLE))-1;
JSAMPLE_ARRAY = Array[jTSample] of JSAMPLE; {far} JSAMPLE_ARRAY = Array[jTSample] of JSAMPLE; {far}
JSAMPROW = ^JSAMPLE_ARRAY; { ptr to one image row of pixel samples. } JSAMPROW = ^JSAMPLE_ARRAY; { ptr to one image row of pixel samples. }
The following code The following code
JSAMPROW buffer0, buffer1; /* ptr to a JSAMPLE buffer. */ JSAMPROW buffer0, buffer1; /* ptr to a JSAMPLE buffer. */
... ...
buffer1 = buffer0 + i; buffer1 = buffer0 + i;
can be translated to can be translated to
var var
buffer0, buffer1 : JSAMPROW; buffer0, buffer1 : JSAMPROW;
... ...
buffer1 := buffer0; buffer1 := buffer0;
Inc(JSAMPLE_PTR(buffer1), i); Inc(JSAMPLE_PTR(buffer1), i);
or or
buffer1 := JSAMPROW(@ buffer0^[i]); buffer1 := JSAMPROW(@ buffer0^[i]);
Declaring the variables as JSAMPLE_PTR may reduce type casting in some Declaring the variables as JSAMPLE_PTR may reduce type casting in some
places. I use help pointers to handle negative array offsets. places. I use help pointers to handle negative array offsets.
While translating the type of function parameter from C to Pascal, one can While translating the type of function parameter from C to Pascal, one can
often use "var", "const", or "array of" parameters instead of pointers. often use "var", "const", or "array of" parameters instead of pointers.
While translating for(;;)-loops with more than one induction variable to While translating for(;;)-loops with more than one induction variable to
Pascal "for to/downto do"-loops, the extra induction variables have to be Pascal "for to/downto do"-loops, the extra induction variables have to be
manually updated at the end of the loop and before "continue"-statements. manually updated at the end of the loop and before "continue"-statements.
Legal issues Legal issues
============ ============
Copyright (C) 1996,1998 by Jacques Nomssi Nzali Copyright (C) 1996,1998 by Jacques Nomssi Nzali
This software is provided 'as-is', without any express or implied This software is provided 'as-is', without any express or implied
warranty. In no event will the author be held liable for any damages warranty. In no event will the author be held liable for any damages
arising from the use of this software. arising from the use of this software.
Permission is granted to anyone to use this software for any purpose, Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions: freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not 1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software claim that you wrote the original software. If you use this software
in a product, an acknowledgment in the product documentation would be in a product, an acknowledgment in the product documentation would be
appreciated but is not required. appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be 2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software. misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution. 3. This notice may not be removed or altered from any source distribution.
Archive Locations: Archive Locations:
================== ==================
[1] Thomas G. Lane, JPEG FAQ [1] Thomas G. Lane, JPEG FAQ
in comp.graphics.misc and related newsgroups in comp.graphics.misc and related newsgroups
[2] Wallace, Gregory K.: The JPEG Still Picture Compression Standard [2] Wallace, Gregory K.: The JPEG Still Picture Compression Standard
ftp.uu.net, graphics/jpeg/wallace.ps.Z ftp.uu.net, graphics/jpeg/wallace.ps.Z
[3] The Independent JPEG Group C library for JPEG encoding and decoding, [3] The Independent JPEG Group C library for JPEG encoding and decoding,
rev 6b. rev 6b.
ftp://ftp.uu.net/graphics/jpeg/ ftp://ftp.uu.net/graphics/jpeg/
or SimTel in msdos/graphics/ or SimTel in msdos/graphics/
[4] JPEG implementation, written by the PVRG group at Stanford, [4] JPEG implementation, written by the PVRG group at Stanford,
ftp havefun.stanford.edu:/pub/jpeg/JPEGv1.2.tar.Z. ftp havefun.stanford.edu:/pub/jpeg/JPEGv1.2.tar.Z.
[5] PASJPEG.ZIP at NView ftp site [5] PASJPEG.ZIP at NView ftp site
ftp://druckfix.physik.tu-chemnitz.de/pub/nv/ ftp://druckfix.physik.tu-chemnitz.de/pub/nv/
http://www.tu-chemnitz.de/~nomssi/pub/pasjpeg.zip http://www.tu-chemnitz.de/~nomssi/pub/pasjpeg.zip
[6] The PasJPEG home page with links [6] The PasJPEG home page with links
http://www.tu-chemnitz.de/~nomssi/pasjpeg.html http://www.tu-chemnitz.de/~nomssi/pasjpeg.html
_____________________________________________________________________________ _____________________________________________________________________________

1045
Imaging/ZLib/dzlib.pas
View File

File diff suppressed because it is too large Load Diff

228
Imaging/ZLib/imadler.pas
View File

@ -1,114 +1,114 @@
Unit imadler; Unit imadler;
{ {
adler32.c -- compute the Adler-32 checksum of a data stream adler32.c -- compute the Adler-32 checksum of a data stream
Copyright (C) 1995-1998 Mark Adler Copyright (C) 1995-1998 Mark Adler
Pascal tranlastion Pascal tranlastion
Copyright (C) 1998 by Jacques Nomssi Nzali Copyright (C) 1998 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt For conditions of distribution and use, see copyright notice in readme.txt
} }
interface interface
{$I imzconf.inc} {$I imzconf.inc}
uses uses
imzutil; imzutil;
function adler32(adler : uLong; buf : pBytef; len : uInt) : uLong; function adler32(adler : uLong; buf : pBytef; len : uInt) : uLong;
{ Update a running Adler-32 checksum with the bytes buf[0..len-1] and { Update a running Adler-32 checksum with the bytes buf[0..len-1] and
return the updated checksum. If buf is NIL, this function returns return the updated checksum. If buf is NIL, this function returns
the required initial value for the checksum. the required initial value for the checksum.
An Adler-32 checksum is almost as reliable as a CRC32 but can be computed An Adler-32 checksum is almost as reliable as a CRC32 but can be computed
much faster. Usage example: much faster. Usage example:
var var
adler : uLong; adler : uLong;
begin begin
adler := adler32(0, Z_NULL, 0); adler := adler32(0, Z_NULL, 0);
while (read_buffer(buffer, length) <> EOF) do while (read_buffer(buffer, length) <> EOF) do
adler := adler32(adler, buffer, length); adler := adler32(adler, buffer, length);
if (adler <> original_adler) then if (adler <> original_adler) then
error(); error();
end; end;
} }
implementation implementation
const const
BASE = uLong(65521); { largest prime smaller than 65536 } BASE = uLong(65521); { largest prime smaller than 65536 }
{NMAX = 5552; original code with unsigned 32 bit integer } {NMAX = 5552; original code with unsigned 32 bit integer }
{ NMAX is the largest n such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^32-1 } { NMAX is the largest n such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^32-1 }
NMAX = 3854; { code with signed 32 bit integer } NMAX = 3854; { code with signed 32 bit integer }
{ NMAX is the largest n such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^31-1 } { NMAX is the largest n such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^31-1 }
{ The penalty is the time loss in the extra MOD-calls. } { The penalty is the time loss in the extra MOD-calls. }
{ ========================================================================= } { ========================================================================= }
function adler32(adler : uLong; buf : pBytef; len : uInt) : uLong; function adler32(adler : uLong; buf : pBytef; len : uInt) : uLong;
var var
s1, s2 : uLong; s1, s2 : uLong;
k : int; k : int;
begin begin
s1 := adler and $ffff; s1 := adler and $ffff;
s2 := (adler shr 16) and $ffff; s2 := (adler shr 16) and $ffff;
if not Assigned(buf) then if not Assigned(buf) then
begin begin
adler32 := uLong(1); adler32 := uLong(1);
exit; exit;
end; end;
while (len > 0) do while (len > 0) do
begin begin
if len < NMAX then if len < NMAX then
k := len k := len
else else
k := NMAX; k := NMAX;
Dec(len, k); Dec(len, k);
{ {
while (k >= 16) do while (k >= 16) do
begin begin
DO16(buf); DO16(buf);
Inc(buf, 16); Inc(buf, 16);
Dec(k, 16); Dec(k, 16);
end; end;
if (k <> 0) then if (k <> 0) then
repeat repeat
Inc(s1, buf^); Inc(s1, buf^);
Inc(puf); Inc(puf);
Inc(s2, s1); Inc(s2, s1);
Dec(k); Dec(k);
until (k = 0); until (k = 0);
} }
while (k > 0) do while (k > 0) do
begin begin
Inc(s1, buf^); Inc(s1, buf^);
Inc(s2, s1); Inc(s2, s1);
Inc(buf); Inc(buf);
Dec(k); Dec(k);
end; end;
s1 := s1 mod BASE; s1 := s1 mod BASE;
s2 := s2 mod BASE; s2 := s2 mod BASE;
end; end;
adler32 := (s2 shl 16) or s1; adler32 := (s2 shl 16) or s1;
end; end;
{ {
#define DO1(buf,i) #define DO1(buf,i)
begin begin
Inc(s1, buf[i]); Inc(s1, buf[i]);
Inc(s2, s1); Inc(s2, s1);
end; end;
#define DO2(buf,i) DO1(buf,i); DO1(buf,i+1); #define DO2(buf,i) DO1(buf,i); DO1(buf,i+1);
#define DO4(buf,i) DO2(buf,i); DO2(buf,i+2); #define DO4(buf,i) DO2(buf,i); DO2(buf,i+2);
#define DO8(buf,i) DO4(buf,i); DO4(buf,i+4); #define DO8(buf,i) DO4(buf,i); DO4(buf,i+4);
#define DO16(buf) DO8(buf,0); DO8(buf,8); #define DO16(buf) DO8(buf,0); DO8(buf,8);
} }
end. end.

1902
Imaging/ZLib/iminfblock.pas
View File

File diff suppressed because it is too large Load Diff

1152
Imaging/ZLib/iminfcodes.pas
View File

File diff suppressed because it is too large Load Diff

636
Imaging/ZLib/iminffast.pas
View File

@ -1,318 +1,318 @@
Unit iminffast; Unit iminffast;
{ {
inffast.h and inffast.h and
inffast.c -- process literals and length/distance pairs fast inffast.c -- process literals and length/distance pairs fast
Copyright (C) 1995-1998 Mark Adler Copyright (C) 1995-1998 Mark Adler
Pascal tranlastion Pascal tranlastion
Copyright (C) 1998 by Jacques Nomssi Nzali Copyright (C) 1998 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt For conditions of distribution and use, see copyright notice in readme.txt
} }
interface interface
{$I imzconf.inc} {$I imzconf.inc}
uses uses
{$ifdef DEBUG} {$ifdef DEBUG}
SysUtils, strutils, SysUtils, strutils,
{$ENDIF} {$ENDIF}
imzutil, impaszlib; imzutil, impaszlib;
function inflate_fast( bl : uInt; function inflate_fast( bl : uInt;
bd : uInt; bd : uInt;
tl : pInflate_huft; tl : pInflate_huft;
td : pInflate_huft; td : pInflate_huft;
var s : inflate_blocks_state; var s : inflate_blocks_state;
var z : z_stream) : int; var z : z_stream) : int;
implementation implementation
uses uses
iminfutil; iminfutil;
{ Called with number of bytes left to write in window at least 258 { Called with number of bytes left to write in window at least 258
(the maximum string length) and number of input bytes available (the maximum string length) and number of input bytes available
at least ten. The ten bytes are six bytes for the longest length/ at least ten. The ten bytes are six bytes for the longest length/
distance pair plus four bytes for overloading the bit buffer. } distance pair plus four bytes for overloading the bit buffer. }
function inflate_fast( bl : uInt; function inflate_fast( bl : uInt;
bd : uInt; bd : uInt;
tl : pInflate_huft; tl : pInflate_huft;
td : pInflate_huft; td : pInflate_huft;
var s : inflate_blocks_state; var s : inflate_blocks_state;
var z : z_stream) : int; var z : z_stream) : int;
var var
t : pInflate_huft; { temporary pointer } t : pInflate_huft; { temporary pointer }
e : uInt; { extra bits or operation } e : uInt; { extra bits or operation }
b : uLong; { bit buffer } b : uLong; { bit buffer }
k : uInt; { bits in bit buffer } k : uInt; { bits in bit buffer }
p : pBytef; { input data pointer } p : pBytef; { input data pointer }
n : uInt; { bytes available there } n : uInt; { bytes available there }
q : pBytef; { output window write pointer } q : pBytef; { output window write pointer }
m : uInt; { bytes to end of window or read pointer } m : uInt; { bytes to end of window or read pointer }
ml : uInt; { mask for literal/length tree } ml : uInt; { mask for literal/length tree }
md : uInt; { mask for distance tree } md : uInt; { mask for distance tree }
c : uInt; { bytes to copy } c : uInt; { bytes to copy }
d : uInt; { distance back to copy from } d : uInt; { distance back to copy from }
r : pBytef; { copy source pointer } r : pBytef; { copy source pointer }
begin begin
{ load input, output, bit values (macro LOAD) } { load input, output, bit values (macro LOAD) }
p := z.next_in; p := z.next_in;
n := z.avail_in; n := z.avail_in;
b := s.bitb; b := s.bitb;
k := s.bitk; k := s.bitk;
q := s.write; q := s.write;
if ptr2int(q) < ptr2int(s.read) then if ptr2int(q) < ptr2int(s.read) then
m := uInt(ptr2int(s.read)-ptr2int(q)-1) m := uInt(ptr2int(s.read)-ptr2int(q)-1)
else else
m := uInt(ptr2int(s.zend)-ptr2int(q)); m := uInt(ptr2int(s.zend)-ptr2int(q));
{ initialize masks } { initialize masks }
ml := inflate_mask[bl]; ml := inflate_mask[bl];
md := inflate_mask[bd]; md := inflate_mask[bd];
{ do until not enough input or output space for fast loop } { do until not enough input or output space for fast loop }
repeat { assume called with (m >= 258) and (n >= 10) } repeat { assume called with (m >= 258) and (n >= 10) }
{ get literal/length code } { get literal/length code }
{GRABBITS(20);} { max bits for literal/length code } {GRABBITS(20);} { max bits for literal/length code }
while (k < 20) do while (k < 20) do
begin begin
Dec(n); Dec(n);
b := b or (uLong(p^) shl k); b := b or (uLong(p^) shl k);
Inc(p); Inc(p);
Inc(k, 8); Inc(k, 8);
end; end;
t := @(huft_ptr(tl)^[uInt(b) and ml]); t := @(huft_ptr(tl)^[uInt(b) and ml]);
e := t^.exop; e := t^.exop;
if (e = 0) then if (e = 0) then
begin begin
{DUMPBITS(t^.bits);} {DUMPBITS(t^.bits);}
b := b shr t^.bits; b := b shr t^.bits;
Dec(k, t^.bits); Dec(k, t^.bits);
{$IFDEF DEBUG} {$IFDEF DEBUG}
if (t^.base >= $20) and (t^.base < $7f) then if (t^.base >= $20) and (t^.base < $7f) then
Tracevv('inflate: * literal '+AnsiChar(t^.base)) Tracevv('inflate: * literal '+AnsiChar(t^.base))
else else
Tracevv('inflate: * literal '+ IntToStr(t^.base)); Tracevv('inflate: * literal '+ IntToStr(t^.base));
{$ENDIF} {$ENDIF}
q^ := Byte(t^.base); q^ := Byte(t^.base);
Inc(q); Inc(q);
Dec(m); Dec(m);
continue; continue;
end; end;
repeat repeat
{DUMPBITS(t^.bits);} {DUMPBITS(t^.bits);}
b := b shr t^.bits; b := b shr t^.bits;
Dec(k, t^.bits); Dec(k, t^.bits);
if (e and 16 <> 0) then if (e and 16 <> 0) then
begin begin
{ get extra bits for length } { get extra bits for length }
e := e and 15; e := e and 15;
c := t^.base + (uInt(b) and inflate_mask[e]); c := t^.base + (uInt(b) and inflate_mask[e]);
{DUMPBITS(e);} {DUMPBITS(e);}
b := b shr e; b := b shr e;
Dec(k, e); Dec(k, e);
{$IFDEF DEBUG} {$IFDEF DEBUG}
Tracevv('inflate: * length ' + IntToStr(c)); Tracevv('inflate: * length ' + IntToStr(c));
{$ENDIF} {$ENDIF}
{ decode distance base of block to copy } { decode distance base of block to copy }
{GRABBITS(15);} { max bits for distance code } {GRABBITS(15);} { max bits for distance code }
while (k < 15) do while (k < 15) do
begin begin
Dec(n); Dec(n);
b := b or (uLong(p^) shl k); b := b or (uLong(p^) shl k);
Inc(p); Inc(p);
Inc(k, 8); Inc(k, 8);
end; end;
t := @huft_ptr(td)^[uInt(b) and md]; t := @huft_ptr(td)^[uInt(b) and md];
e := t^.exop; e := t^.exop;
repeat repeat
{DUMPBITS(t^.bits);} {DUMPBITS(t^.bits);}
b := b shr t^.bits; b := b shr t^.bits;
Dec(k, t^.bits); Dec(k, t^.bits);
if (e and 16 <> 0) then if (e and 16 <> 0) then
begin begin
{ get extra bits to add to distance base } { get extra bits to add to distance base }
e := e and 15; e := e and 15;
{GRABBITS(e);} { get extra bits (up to 13) } {GRABBITS(e);} { get extra bits (up to 13) }
while (k < e) do while (k < e) do
begin begin
Dec(n); Dec(n);
b := b or (uLong(p^) shl k); b := b or (uLong(p^) shl k);
Inc(p); Inc(p);
Inc(k, 8); Inc(k, 8);
end; end;
d := t^.base + (uInt(b) and inflate_mask[e]); d := t^.base + (uInt(b) and inflate_mask[e]);
{DUMPBITS(e);} {DUMPBITS(e);}
b := b shr e; b := b shr e;
Dec(k, e); Dec(k, e);
{$IFDEF DEBUG} {$IFDEF DEBUG}
Tracevv('inflate: * distance '+IntToStr(d)); Tracevv('inflate: * distance '+IntToStr(d));
{$ENDIF} {$ENDIF}
{ do the copy } { do the copy }
Dec(m, c); Dec(m, c);
if (uInt(ptr2int(q) - ptr2int(s.window)) >= d) then { offset before dest } if (uInt(ptr2int(q) - ptr2int(s.window)) >= d) then { offset before dest }
begin { just copy } begin { just copy }
r := q; r := q;
Dec(r, d); Dec(r, d);
q^ := r^; Inc(q); Inc(r); Dec(c); { minimum count is three, } q^ := r^; Inc(q); Inc(r); Dec(c); { minimum count is three, }
q^ := r^; Inc(q); Inc(r); Dec(c); { so unroll loop a little } q^ := r^; Inc(q); Inc(r); Dec(c); { so unroll loop a little }
end end
else { else offset after destination } else { else offset after destination }
begin begin
e := d - uInt(ptr2int(q) - ptr2int(s.window)); { bytes from offset to end } e := d - uInt(ptr2int(q) - ptr2int(s.window)); { bytes from offset to end }
r := s.zend; r := s.zend;
Dec(r, e); { pointer to offset } Dec(r, e); { pointer to offset }
if (c > e) then { if source crosses, } if (c > e) then { if source crosses, }
begin begin
Dec(c, e); { copy to end of window } Dec(c, e); { copy to end of window }
repeat repeat
q^ := r^; q^ := r^;
Inc(q); Inc(q);
Inc(r); Inc(r);
Dec(e); Dec(e);
until (e=0); until (e=0);
r := s.window; { copy rest from start of window } r := s.window; { copy rest from start of window }
end; end;
end; end;
repeat { copy all or what's left } repeat { copy all or what's left }
q^ := r^; q^ := r^;
Inc(q); Inc(q);
Inc(r); Inc(r);
Dec(c); Dec(c);
until (c = 0); until (c = 0);
break; break;
end end
else else
if (e and 64 = 0) then if (e and 64 = 0) then
begin begin
Inc(t, t^.base + (uInt(b) and inflate_mask[e])); Inc(t, t^.base + (uInt(b) and inflate_mask[e]));
e := t^.exop; e := t^.exop;
end end
else else
begin begin
z.msg := 'invalid distance code'; z.msg := 'invalid distance code';
{UNGRAB} {UNGRAB}
c := z.avail_in-n; c := z.avail_in-n;
if (k shr 3) < c then if (k shr 3) < c then
c := k shr 3; c := k shr 3;
Inc(n, c); Inc(n, c);
Dec(p, c); Dec(p, c);
Dec(k, c shl 3); Dec(k, c shl 3);
{UPDATE} {UPDATE}
s.bitb := b; s.bitb := b;
s.bitk := k; s.bitk := k;
z.avail_in := n; z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p; z.next_in := p;
s.write := q; s.write := q;
inflate_fast := Z_DATA_ERROR; inflate_fast := Z_DATA_ERROR;
exit; exit;
end; end;
until FALSE; until FALSE;
break; break;
end; end;
if (e and 64 = 0) then if (e and 64 = 0) then
begin begin
{t += t->base; {t += t->base;
e = (t += ((uInt)b & inflate_mask[e]))->exop;} e = (t += ((uInt)b & inflate_mask[e]))->exop;}
Inc(t, t^.base + (uInt(b) and inflate_mask[e])); Inc(t, t^.base + (uInt(b) and inflate_mask[e]));
e := t^.exop; e := t^.exop;
if (e = 0) then if (e = 0) then
begin begin
{DUMPBITS(t^.bits);} {DUMPBITS(t^.bits);}
b := b shr t^.bits; b := b shr t^.bits;
Dec(k, t^.bits); Dec(k, t^.bits);
{$IFDEF DEBUG} {$IFDEF DEBUG}
if (t^.base >= $20) and (t^.base < $7f) then if (t^.base >= $20) and (t^.base < $7f) then
Tracevv('inflate: * literal '+AnsiChar(t^.base)) Tracevv('inflate: * literal '+AnsiChar(t^.base))
else else
Tracevv('inflate: * literal '+IntToStr(t^.base)); Tracevv('inflate: * literal '+IntToStr(t^.base));
{$ENDIF} {$ENDIF}
q^ := Byte(t^.base); q^ := Byte(t^.base);
Inc(q); Inc(q);
Dec(m); Dec(m);
break; break;
end; end;
end end
else else
if (e and 32 <> 0) then if (e and 32 <> 0) then
begin begin
{$IFDEF DEBUG} {$IFDEF DEBUG}
Tracevv('inflate: * end of block'); Tracevv('inflate: * end of block');
{$ENDIF} {$ENDIF}
{UNGRAB} {UNGRAB}
c := z.avail_in-n; c := z.avail_in-n;
if (k shr 3) < c then if (k shr 3) < c then
c := k shr 3; c := k shr 3;
Inc(n, c); Inc(n, c);
Dec(p, c); Dec(p, c);
Dec(k, c shl 3); Dec(k, c shl 3);
{UPDATE} {UPDATE}
s.bitb := b; s.bitb := b;
s.bitk := k; s.bitk := k;
z.avail_in := n; z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p; z.next_in := p;
s.write := q; s.write := q;
inflate_fast := Z_STREAM_END; inflate_fast := Z_STREAM_END;
exit; exit;
end end
else else
begin begin
z.msg := 'invalid literal/length code'; z.msg := 'invalid literal/length code';
{UNGRAB} {UNGRAB}
c := z.avail_in-n; c := z.avail_in-n;
if (k shr 3) < c then if (k shr 3) < c then
c := k shr 3; c := k shr 3;
Inc(n, c); Inc(n, c);
Dec(p, c); Dec(p, c);
Dec(k, c shl 3); Dec(k, c shl 3);
{UPDATE} {UPDATE}
s.bitb := b; s.bitb := b;
s.bitk := k; s.bitk := k;
z.avail_in := n; z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p; z.next_in := p;
s.write := q; s.write := q;
inflate_fast := Z_DATA_ERROR; inflate_fast := Z_DATA_ERROR;
exit; exit;
end; end;
until FALSE; until FALSE;
until (m < 258) or (n < 10); until (m < 258) or (n < 10);
{ not enough input or output--restore pointers and return } { not enough input or output--restore pointers and return }
{UNGRAB} {UNGRAB}
c := z.avail_in-n; c := z.avail_in-n;
if (k shr 3) < c then if (k shr 3) < c then
c := k shr 3; c := k shr 3;
Inc(n, c); Inc(n, c);
Dec(p, c); Dec(p, c);
Dec(k, c shl 3); Dec(k, c shl 3);
{UPDATE} {UPDATE}
s.bitb := b; s.bitb := b;
s.bitk := k; s.bitk := k;
z.avail_in := n; z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p; z.next_in := p;
s.write := q; s.write := q;
inflate_fast := Z_OK; inflate_fast := Z_OK;
end; end;
end. end.

1560
Imaging/ZLib/iminftrees.pas
View File

File diff suppressed because it is too large Load Diff

444
Imaging/ZLib/iminfutil.pas
View File

@ -1,222 +1,222 @@
Unit iminfutil; Unit iminfutil;
{ types and macros common to blocks and codes { types and macros common to blocks and codes
Copyright (C) 1995-1998 Mark Adler Copyright (C) 1995-1998 Mark Adler
WARNING: this file should *not* be used by applications. It is WARNING: this file should *not* be used by applications. It is
part of the implementation of the compression library and is part of the implementation of the compression library and is
subject to change. subject to change.
Pascal tranlastion Pascal tranlastion
Copyright (C) 1998 by Jacques Nomssi Nzali Copyright (C) 1998 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt For conditions of distribution and use, see copyright notice in readme.txt
} }
interface interface
{$I imzconf.inc} {$I imzconf.inc}
uses uses
imzutil, impaszlib; imzutil, impaszlib;
{ copy as much as possible from the sliding window to the output area } { copy as much as possible from the sliding window to the output area }
function inflate_flush(var s : inflate_blocks_state; function inflate_flush(var s : inflate_blocks_state;
var z : z_stream; var z : z_stream;
r : int) : int; r : int) : int;
{ And'ing with mask[n] masks the lower n bits } { And'ing with mask[n] masks the lower n bits }
const const
inflate_mask : array[0..17-1] of uInt = ( inflate_mask : array[0..17-1] of uInt = (
$0000, $0000,
$0001, $0003, $0007, $000f, $001f, $003f, $007f, $00ff, $0001, $0003, $0007, $000f, $001f, $003f, $007f, $00ff,
$01ff, $03ff, $07ff, $0fff, $1fff, $3fff, $7fff, $ffff); $01ff, $03ff, $07ff, $0fff, $1fff, $3fff, $7fff, $ffff);
{procedure GRABBITS(j : int);} {procedure GRABBITS(j : int);}
{procedure DUMPBITS(j : int);} {procedure DUMPBITS(j : int);}
{procedure NEEDBITS(j : int);} {procedure NEEDBITS(j : int);}
implementation implementation
{ macros for bit input with no checking and for returning unused bytes } { macros for bit input with no checking and for returning unused bytes }
procedure GRABBITS(j : int); procedure GRABBITS(j : int);
begin begin
{while (k < j) do {while (k < j) do
begin begin
Dec(z^.avail_in); Dec(z^.avail_in);
Inc(z^.total_in); Inc(z^.total_in);
b := b or (uLong(z^.next_in^) shl k); b := b or (uLong(z^.next_in^) shl k);
Inc(z^.next_in); Inc(z^.next_in);
Inc(k, 8); Inc(k, 8);
end;} end;}
end; end;
procedure DUMPBITS(j : int); procedure DUMPBITS(j : int);
begin begin
{b := b shr j; {b := b shr j;
Dec(k, j);} Dec(k, j);}
end; end;
procedure NEEDBITS(j : int); procedure NEEDBITS(j : int);
begin begin
(* (*
while (k < j) do while (k < j) do
begin begin
{NEEDBYTE;} {NEEDBYTE;}
if (n <> 0) then if (n <> 0) then
r :=Z_OK r :=Z_OK
else else
begin begin
{UPDATE} {UPDATE}
s.bitb := b; s.bitb := b;
s.bitk := k; s.bitk := k;
z.avail_in := n; z.avail_in := n;
Inc(z.total_in, LongInt(p)-LongInt(z.next_in)); Inc(z.total_in, LongInt(p)-LongInt(z.next_in));
z.next_in := p; z.next_in := p;
s.write := q; s.write := q;
result := inflate_flush(s,z,r); result := inflate_flush(s,z,r);
exit; exit;
end; end;
Dec(n); Dec(n);
b := b or (uLong(p^) shl k); b := b or (uLong(p^) shl k);
Inc(p); Inc(p);
Inc(k, 8); Inc(k, 8);
end; end;
*) *)
end; end;
procedure NEEDOUT; procedure NEEDOUT;
begin begin
(* (*
if (m = 0) then if (m = 0) then
begin begin
{WRAP} {WRAP}
if (q = s.zend) and (s.read <> s.window) then if (q = s.zend) and (s.read <> s.window) then
begin begin
q := s.window; q := s.window;
if LongInt(q) < LongInt(s.read) then if LongInt(q) < LongInt(s.read) then
m := uInt(LongInt(s.read)-LongInt(q)-1) m := uInt(LongInt(s.read)-LongInt(q)-1)
else else
m := uInt(LongInt(s.zend)-LongInt(q)); m := uInt(LongInt(s.zend)-LongInt(q));
end; end;
if (m = 0) then if (m = 0) then
begin begin
{FLUSH} {FLUSH}
s.write := q; s.write := q;
r := inflate_flush(s,z,r); r := inflate_flush(s,z,r);
q := s.write; q := s.write;
if LongInt(q) < LongInt(s.read) then if LongInt(q) < LongInt(s.read) then
m := uInt(LongInt(s.read)-LongInt(q)-1) m := uInt(LongInt(s.read)-LongInt(q)-1)
else else
m := uInt(LongInt(s.zend)-LongInt(q)); m := uInt(LongInt(s.zend)-LongInt(q));
{WRAP} {WRAP}
if (q = s.zend) and (s.read <> s.window) then if (q = s.zend) and (s.read <> s.window) then
begin begin
q := s.window; q := s.window;
if LongInt(q) < LongInt(s.read) then if LongInt(q) < LongInt(s.read) then
m := uInt(LongInt(s.read)-LongInt(q)-1) m := uInt(LongInt(s.read)-LongInt(q)-1)
else else
m := uInt(LongInt(s.zend)-LongInt(q)); m := uInt(LongInt(s.zend)-LongInt(q));
end; end;
if (m = 0) then if (m = 0) then
begin begin
{UPDATE} {UPDATE}
s.bitb := b; s.bitb := b;
s.bitk := k; s.bitk := k;
z.avail_in := n; z.avail_in := n;
Inc(z.total_in, LongInt(p)-LongInt(z.next_in)); Inc(z.total_in, LongInt(p)-LongInt(z.next_in));
z.next_in := p; z.next_in := p;
s.write := q; s.write := q;
result := inflate_flush(s,z,r); result := inflate_flush(s,z,r);
exit; exit;
end; end;
end; end;
end; end;
r := Z_OK; r := Z_OK;
*) *)
end; end;
{ copy as much as possible from the sliding window to the output area } { copy as much as possible from the sliding window to the output area }
function inflate_flush(var s : inflate_blocks_state; function inflate_flush(var s : inflate_blocks_state;
var z : z_stream; var z : z_stream;
r : int) : int; r : int) : int;
var var
n : uInt; n : uInt;
p : pBytef; p : pBytef;
q : pBytef; q : pBytef;
begin begin
{ local copies of source and destination pointers } { local copies of source and destination pointers }
p := z.next_out; p := z.next_out;
q := s.read; q := s.read;
{ compute number of bytes to copy as far as end of window } { compute number of bytes to copy as far as end of window }
if ptr2int(q) <= ptr2int(s.write) then if ptr2int(q) <= ptr2int(s.write) then
n := uInt(ptr2int(s.write) - ptr2int(q)) n := uInt(ptr2int(s.write) - ptr2int(q))
else else
n := uInt(ptr2int(s.zend) - ptr2int(q)); n := uInt(ptr2int(s.zend) - ptr2int(q));
if (n > z.avail_out) then if (n > z.avail_out) then
n := z.avail_out; n := z.avail_out;
if (n <> 0) and (r = Z_BUF_ERROR) then if (n <> 0) and (r = Z_BUF_ERROR) then
r := Z_OK; r := Z_OK;
{ update counters } { update counters }
Dec(z.avail_out, n); Dec(z.avail_out, n);
Inc(z.total_out, n); Inc(z.total_out, n);
{ update check information } { update check information }
if Assigned(s.checkfn) then if Assigned(s.checkfn) then
begin begin
s.check := s.checkfn(s.check, q, n); s.check := s.checkfn(s.check, q, n);
z.adler := s.check; z.adler := s.check;
end; end;
{ copy as far as end of window } { copy as far as end of window }
zmemcpy(p, q, n); zmemcpy(p, q, n);
Inc(p, n); Inc(p, n);
Inc(q, n); Inc(q, n);
{ see if more to copy at beginning of window } { see if more to copy at beginning of window }
if (q = s.zend) then if (q = s.zend) then
begin begin
{ wrap pointers } { wrap pointers }
q := s.window; q := s.window;
if (s.write = s.zend) then if (s.write = s.zend) then
s.write := s.window; s.write := s.window;
{ compute bytes to copy } { compute bytes to copy }
n := uInt(ptr2int(s.write) - ptr2int(q)); n := uInt(ptr2int(s.write) - ptr2int(q));
if (n > z.avail_out) then if (n > z.avail_out) then
n := z.avail_out; n := z.avail_out;
if (n <> 0) and (r = Z_BUF_ERROR) then if (n <> 0) and (r = Z_BUF_ERROR) then
r := Z_OK; r := Z_OK;
{ update counters } { update counters }
Dec( z.avail_out, n); Dec( z.avail_out, n);
Inc( z.total_out, n); Inc( z.total_out, n);
{ update check information } { update check information }
if Assigned(s.checkfn) then if Assigned(s.checkfn) then
begin begin
s.check := s.checkfn(s.check, q, n); s.check := s.checkfn(s.check, q, n);
z.adler := s.check; z.adler := s.check;
end; end;
{ copy } { copy }
zmemcpy(p, q, n); zmemcpy(p, q, n);
Inc(p, n); Inc(p, n);
Inc(q, n); Inc(q, n);
end; end;
{ update pointers } { update pointers }
z.next_out := p; z.next_out := p;
s.read := q; s.read := q;
{ done } { done }
inflate_flush := r; inflate_flush := r;
end; end;
end. end.

1040
Imaging/ZLib/impaszlib.pas
View File

File diff suppressed because it is too large Load Diff

4496
Imaging/ZLib/imtrees.pas
View File

File diff suppressed because it is too large Load Diff

50
Imaging/ZLib/imzconf.inc
View File

@ -1,25 +1,25 @@
{ -------------------------------------------------------------------- } { -------------------------------------------------------------------- }
{$DEFINE MAX_MATCH_IS_258} {$DEFINE MAX_MATCH_IS_258}
{ Compile with -DMAXSEG_64K if the alloc function cannot allocate more { Compile with -DMAXSEG_64K if the alloc function cannot allocate more
than 64k bytes at a time (needed on systems with 16-bit int). } than 64k bytes at a time (needed on systems with 16-bit int). }
{$UNDEF MAXSEG_64K} {$UNDEF MAXSEG_64K}
{$DEFINE UNALIGNED_OK} { requires SizeOf(ush) = 2 ! } {$DEFINE UNALIGNED_OK} { requires SizeOf(ush) = 2 ! }
{$UNDEF DYNAMIC_CRC_TABLE} {$UNDEF DYNAMIC_CRC_TABLE}
{$UNDEF FASTEST} {$UNDEF FASTEST}
{$DEFINE Use32} {$DEFINE Use32}
{$DEFINE patch112} { apply patch from the zlib home page } {$DEFINE patch112} { apply patch from the zlib home page }
{$IFDEF FPC} {$IFDEF FPC}
{$MODE DELPHI} {$MODE DELPHI}
{$ENDIF} {$ENDIF}
{$UNDEF DEBUG} // for Delphi 2007 in DEBUG mode {$UNDEF DEBUG} // for Delphi 2007 in DEBUG mode
{$RANGECHECKS OFF} {$RANGECHECKS OFF}
{$OVERFLOWCHECKS OFF} {$OVERFLOWCHECKS OFF}
{ -------------------------------------------------------------------- } { -------------------------------------------------------------------- }

4258
Imaging/ZLib/imzdeflate.pas
View File

File diff suppressed because it is too large Load Diff

1500
Imaging/ZLib/imzinflate.pas
View File

File diff suppressed because it is too large Load Diff

386
Imaging/ZLib/imzutil.pas
View File

@ -1,191 +1,195 @@
Unit imzutil; Unit imzutil;
{ {
Copyright (C) 1998 by Jacques Nomssi Nzali Copyright (C) 1998 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt For conditions of distribution and use, see copyright notice in readme.txt
} }
interface interface
{$I imzconf.inc} {$I imzconf.inc}
{ Type declarations } { Type declarations }
type type
{Byte = usigned char; 8 bits} {Byte = usigned char; 8 bits}
Bytef = byte; Bytef = byte;
charf = byte; charf = byte;
int = longint; int = longint;
intf = int; intf = int;
uInt = cardinal; { 16 bits or more } uInt = cardinal; { 16 bits or more }
uIntf = uInt; uIntf = uInt;
Long = longint; Long = longint;
uLong = Cardinal; uLong = Cardinal;
uLongf = uLong; uLongf = uLong;
voidp = pointer; voidp = pointer;
voidpf = voidp; voidpf = voidp;
pBytef = ^Bytef; pBytef = ^Bytef;
pIntf = ^intf; pIntf = ^intf;
puIntf = ^uIntf; puIntf = ^uIntf;
puLong = ^uLongf; puLong = ^uLongf;
ptr2int = uInt; {$IF Defined(FPC)}
{ a pointer to integer casting is used to do pointer arithmetic. ptr2int = PtrUInt;
ptr2int must be an integer type and sizeof(ptr2int) must be less {$ELSEIF CompilerVersion >= 20}
than sizeof(pointer) - Nomssi } ptr2int = NativeUInt;
{$ELSE}
type ptr2int = Cardinal;
zByteArray = array[0..(MaxInt div SizeOf(Bytef))-1] of Bytef; {$IFEND}
pzByteArray = ^zByteArray; { a pointer to integer casting is used to do pointer arithmetic. }
type
zIntfArray = array[0..(MaxInt div SizeOf(Intf))-1] of Intf; type
pzIntfArray = ^zIntfArray; zByteArray = array[0..(MaxInt div SizeOf(Bytef))-1] of Bytef;
type pzByteArray = ^zByteArray;
zuIntArray = array[0..(MaxInt div SizeOf(uInt))-1] of uInt; type
PuIntArray = ^zuIntArray; zIntfArray = array[0..(MaxInt div SizeOf(Intf))-1] of Intf;
pzIntfArray = ^zIntfArray;
{ Type declarations - only for deflate } type
zuIntArray = array[0..(MaxInt div SizeOf(uInt))-1] of uInt;
type PuIntArray = ^zuIntArray;
uch = Byte;
uchf = uch; { FAR } { Type declarations - only for deflate }
ush = Word;
ushf = ush; type
ulg = LongInt; uch = Byte;
uchf = uch; { FAR }
unsigned = uInt; ush = Word;
ushf = ush;
pcharf = ^charf; ulg = LongInt;
puchf = ^uchf;
pushf = ^ushf; unsigned = uInt;
type pcharf = ^charf;
zuchfArray = zByteArray; puchf = ^uchf;
puchfArray = ^zuchfArray; pushf = ^ushf;
type
zushfArray = array[0..(MaxInt div SizeOf(ushf))-1] of ushf; type
pushfArray = ^zushfArray; zuchfArray = zByteArray;
puchfArray = ^zuchfArray;
procedure zmemcpy(destp : pBytef; sourcep : pBytef; len : uInt); type
function zmemcmp(s1p, s2p : pBytef; len : uInt) : int; zushfArray = array[0..(MaxInt div SizeOf(ushf))-1] of ushf;
procedure zmemzero(destp : pBytef; len : uInt); pushfArray = ^zushfArray;
procedure zcfree(opaque : voidpf; ptr : voidpf);
function zcalloc (opaque : voidpf; items : uInt; size : uInt) : voidpf; procedure zmemcpy(destp : pBytef; sourcep : pBytef; len : uInt);
function zmemcmp(s1p, s2p : pBytef; len : uInt) : int;
implementation procedure zmemzero(destp : pBytef; len : uInt);
procedure zcfree(opaque : voidpf; ptr : voidpf);
procedure zmemcpy(destp : pBytef; sourcep : pBytef; len : uInt); function zcalloc (opaque : voidpf; items : uInt; size : uInt) : voidpf;
begin
Move(sourcep^, destp^, len); implementation
end;
procedure zmemcpy(destp : pBytef; sourcep : pBytef; len : uInt);
function zmemcmp(s1p, s2p : pBytef; len : uInt) : int; begin
var Move(sourcep^, destp^, len);
j : uInt; end;
source,
dest : pBytef; function zmemcmp(s1p, s2p : pBytef; len : uInt) : int;
begin var
source := s1p; j : uInt;
dest := s2p; source,
for j := 0 to pred(len) do dest : pBytef;
begin begin
if (source^ <> dest^) then source := s1p;
begin dest := s2p;
zmemcmp := 2*Ord(source^ > dest^)-1; for j := 0 to pred(len) do
exit; begin
end; if (source^ <> dest^) then
Inc(source); begin
Inc(dest); zmemcmp := 2*Ord(source^ > dest^)-1;
end; exit;
zmemcmp := 0; end;
end; Inc(source);
Inc(dest);
procedure zmemzero(destp : pBytef; len : uInt); end;
begin zmemcmp := 0;
FillChar(destp^, len, 0); end;
end;
procedure zmemzero(destp : pBytef; len : uInt);
procedure zcfree(opaque : voidpf; ptr : voidpf); begin
{$ifdef Delphi16} FillChar(destp^, len, 0);
var end;
Handle : THandle;
{$endif} procedure zcfree(opaque : voidpf; ptr : voidpf);
{$IFDEF FPC} {$ifdef Delphi16}
var var
memsize : uint; Handle : THandle;
{$ENDIF} {$endif}
begin {$IFDEF FPC}
(* var
{$IFDEF DPMI} memsize : uint;
{h :=} GlobalFreePtr(ptr); {$ENDIF}
{$ELSE} begin
{$IFDEF CALL_DOS} (*
dosFree(ptr); {$IFDEF DPMI}
{$ELSE} {h :=} GlobalFreePtr(ptr);
{$ifdef HugeMem} {$ELSE}
FreeMemHuge(ptr); {$IFDEF CALL_DOS}
{$else} dosFree(ptr);
{$ifdef Delphi16} {$ELSE}
Handle := GlobalHandle(LH(ptr).H); { HiWord(LongInt(ptr)) } {$ifdef HugeMem}
GlobalUnLock(Handle); FreeMemHuge(ptr);
GlobalFree(Handle); {$else}
{$else} {$ifdef Delphi16}
{$IFDEF FPC} Handle := GlobalHandle(LH(ptr).H); { HiWord(LongInt(ptr)) }
Dec(puIntf(ptr)); GlobalUnLock(Handle);
memsize := puIntf(ptr)^; GlobalFree(Handle);
FreeMem(ptr, memsize+SizeOf(uInt)); {$else}
{$ELSE} {$IFDEF FPC}
FreeMem(ptr); { Delphi 2,3,4 } Dec(puIntf(ptr));
{$ENDIF} memsize := puIntf(ptr)^;
{$endif} FreeMem(ptr, memsize+SizeOf(uInt));
{$endif} {$ELSE}
{$ENDIF} FreeMem(ptr); { Delphi 2,3,4 }
{$ENDIF} {$ENDIF}
*) {$endif}
FreeMem(ptr); {$endif}
end; {$ENDIF}
{$ENDIF}
function zcalloc (opaque : voidpf; items : uInt; size : uInt) : voidpf; *)
var FreeMem(ptr);
p : voidpf; end;
memsize : uLong;
{$ifdef Delphi16} function zcalloc (opaque : voidpf; items : uInt; size : uInt) : voidpf;
handle : THandle; var
{$endif} p : voidpf;
begin memsize : uLong;
memsize := uLong(items) * size; {$ifdef Delphi16}
(* handle : THandle;
{ $IFDEF DPMI} {$endif}
p := GlobalAllocPtr(gmem_moveable, memsize); begin
{ $ELSE} memsize := uLong(items) * size;
{ $IFDEF CALLDOS} (*
p := dosAlloc(memsize); { $IFDEF DPMI}
{ $ELSE} p := GlobalAllocPtr(gmem_moveable, memsize);
{$ifdef HugeMem} { $ELSE}
GetMemHuge(p, memsize); { $IFDEF CALLDOS}
{ $else} p := dosAlloc(memsize);
{ $ifdef Delphi16} { $ELSE}
Handle := GlobalAlloc(HeapAllocFlags, memsize); {$ifdef HugeMem}
p := GlobalLock(Handle); GetMemHuge(p, memsize);
{ $else} { $else}
{ $IFDEF FPC} { $ifdef Delphi16}
GetMem(p, memsize+SizeOf(uInt)); Handle := GlobalAlloc(HeapAllocFlags, memsize);
puIntf(p)^:= memsize; p := GlobalLock(Handle);
Inc(puIntf(p)); { $else}
{ $ELSE} { $IFDEF FPC}
GetMem(p, memsize); { Delphi: p := AllocMem(memsize); } GetMem(p, memsize+SizeOf(uInt));
{ $ENDIF} puIntf(p)^:= memsize;
{ $endif} Inc(puIntf(p));
{ $endif} { $ELSE}
{ $ENDIF} GetMem(p, memsize); { Delphi: p := AllocMem(memsize); }
{ $ENDIF} { $ENDIF}
*) { $endif}
GetMem(p, memsize); { $endif}
zcalloc := p; { $ENDIF}
end; { $ENDIF}
*)
end. GetMem(p, memsize);
zcalloc := p;
end;
end.

256
Imaging/ZLib/readme.txt
View File

@ -1,129 +1,129 @@
_____________________________________________________________________________ _____________________________________________________________________________
PASZLIB 1.0 May 11th, 1998 PASZLIB 1.0 May 11th, 1998
Based on the zlib 1.1.2, a general purpose data compression library. Based on the zlib 1.1.2, a general purpose data compression library.
Copyright (C) 1998,1999,2000 by NOMSSI NZALI Jacques H. C. Copyright (C) 1998,1999,2000 by NOMSSI NZALI Jacques H. C.
[kn&n DES] See "Legal issues" for conditions of distribution and use. [kn&n DES] See "Legal issues" for conditions of distribution and use.
_____________________________________________________________________________ _____________________________________________________________________________
Introduction Introduction
============ ============
The 'zlib' compression library provides in-memory compression and The 'zlib' compression library provides in-memory compression and
decompression functions, including integrity checks of the uncompressed decompression functions, including integrity checks of the uncompressed
data. This version of the library supports only one compression method data. This version of the library supports only one compression method
(deflation) but other algorithms will be added later and will have the same (deflation) but other algorithms will be added later and will have the same
stream interface. stream interface.
Compression can be done in a single step if the buffers are large Compression can be done in a single step if the buffers are large
enough (for example if an input file is mmap'ed), or can be done by enough (for example if an input file is mmap'ed), or can be done by
repeated calls of the compression function. In the latter case, the repeated calls of the compression function. In the latter case, the
application must provide more input and/or consume the output application must provide more input and/or consume the output
(providing more output space) before each call. (providing more output space) before each call.
The default memory requirements for deflate are 256K plus a few kilobytes The default memory requirements for deflate are 256K plus a few kilobytes
for small objects. The default memory requirements for inflate are 32K for small objects. The default memory requirements for inflate are 32K
plus a few kilobytes for small objects. plus a few kilobytes for small objects.
Change Log Change Log
========== ==========
March 24th 2000 - minizip code by Gilles Vollant ported to Pascal. March 24th 2000 - minizip code by Gilles Vollant ported to Pascal.
z_stream.msg defined as string[255] to avoid problems z_stream.msg defined as string[255] to avoid problems
with Delphi 2+ dynamic string handling. with Delphi 2+ dynamic string handling.
changes to silence Delphi 5 compiler warning. If you changes to silence Delphi 5 compiler warning. If you
have Delphi 5, defines Delphi5 in zconf.inc have Delphi 5, defines Delphi5 in zconf.inc
May 7th 1999 - Some changes for FPC May 7th 1999 - Some changes for FPC
deflateCopy() has new parameters deflateCopy() has new parameters
trees.pas - record constant definition trees.pas - record constant definition
June 17th 1998 - Applied official 1.1.2 patch. June 17th 1998 - Applied official 1.1.2 patch.
Memcheck turned off by default. Memcheck turned off by default.
zutil.pas patch for Delphi 1 memory allocation corrected. zutil.pas patch for Delphi 1 memory allocation corrected.
dzlib.txt file added. dzlib.txt file added.
compress2() is now exported compress2() is now exported
June 25th 1998 - fixed a conversion bug: in inftrees.pas, ZFREE(z, v) was June 25th 1998 - fixed a conversion bug: in inftrees.pas, ZFREE(z, v) was
missing in line 574; missing in line 574;
File list File list
========= =========
Here is a road map to the files in the Paszlib distribution. Here is a road map to the files in the Paszlib distribution.
readme.txt Introduction, Documentation readme.txt Introduction, Documentation
dzlib.txt Changes to Delphi sources for Paszlib stream classes dzlib.txt Changes to Delphi sources for Paszlib stream classes
include file include file
zconf.inc Configuration declarations. zconf.inc Configuration declarations.
Pascal source code files: Pascal source code files:
adler.pas compute the Adler-32 checksum of a data stream adler.pas compute the Adler-32 checksum of a data stream
crc.pas compute the CRC-32 of a data stream crc.pas compute the CRC-32 of a data stream
gzio.pas IO on .gz files gzio.pas IO on .gz files
infblock.pas interpret and process block types to last block infblock.pas interpret and process block types to last block
infcodes.pas process literals and length/distance pairs infcodes.pas process literals and length/distance pairs
inffast.pas process literals and length/distance pairs fast inffast.pas process literals and length/distance pairs fast
inftrees.pas generate Huffman trees for efficient decoding inftrees.pas generate Huffman trees for efficient decoding
infutil.pas types and macros common to blocks and codes infutil.pas types and macros common to blocks and codes
strutils.pas string utilities strutils.pas string utilities
trees.pas output deflated data using Huffman coding trees.pas output deflated data using Huffman coding
zcompres.pas compress a memory buffer zcompres.pas compress a memory buffer
zdeflate.pas compress data using the deflation algorithm zdeflate.pas compress data using the deflation algorithm
zinflate.pas zlib interface to inflate modules zinflate.pas zlib interface to inflate modules
zlib.pas zlib data structures. read the comments there! zlib.pas zlib data structures. read the comments there!
zuncompr.pas decompress a memory buffer zuncompr.pas decompress a memory buffer
zutil.pas zutil.pas
minizip/ziputils.pas data structure and IO on .zip file minizip/ziputils.pas data structure and IO on .zip file
minizip/unzip.pas minizip/unzip.pas
minizip/zip.pas minizip/zip.pas
Test applications Test applications
example.pas usage example of the zlib compression library example.pas usage example of the zlib compression library
minigzip.pas simulate gzip using the zlib compression library minigzip.pas simulate gzip using the zlib compression library
minizip/miniunz.pas simulates unzip using the zlib compression library minizip/miniunz.pas simulates unzip using the zlib compression library
minizip/minizip.pas simulates zip using the zlib compression library minizip/minizip.pas simulates zip using the zlib compression library
Legal issues Legal issues
============ ============
Copyright (C) 1998,1999,2000 by Jacques Nomssi Nzali Copyright (C) 1998,1999,2000 by Jacques Nomssi Nzali
This software is provided 'as-is', without any express or implied This software is provided 'as-is', without any express or implied
warranty. In no event will the author be held liable for any damages warranty. In no event will the author be held liable for any damages
arising from the use of this software. arising from the use of this software.
Permission is granted to anyone to use this software for any purpose, Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions: freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not 1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software claim that you wrote the original software. If you use this software
in a product, an acknowledgment in the product documentation would be in a product, an acknowledgment in the product documentation would be
appreciated but is not required. appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be 2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software. misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution. 3. This notice may not be removed or altered from any source distribution.
Archive Locations: Archive Locations:
================== ==================
Check the Paszlib home page with links Check the Paszlib home page with links
http://www.tu-chemnitz.de/~nomssi/paszlib.html http://www.tu-chemnitz.de/~nomssi/paszlib.html
The data format used by the zlib library is described by RFCs (Request for The data format used by the zlib library is described by RFCs (Request for
Comments) 1950 to 1952 in the files ftp://ds.internic.net/rfc/rfc1950.txt Comments) 1950 to 1952 in the files ftp://ds.internic.net/rfc/rfc1950.txt
(zlib format), rfc1951.txt (deflate format) and rfc1952.txt (gzip format). (zlib format), rfc1951.txt (deflate format) and rfc1952.txt (gzip format).
These documents are also available in other formats from These documents are also available in other formats from
ftp://ftp.uu.net/graphics/png/documents/zlib/zdoc-index.html. ftp://ftp.uu.net/graphics/png/documents/zlib/zdoc-index.html.
____________________________________________________________________________ ____________________________________________________________________________
Jacques Nomssi Nzali <mailto:nomssi@physik.tu-chemnitz.de> March 24th, 2000 Jacques Nomssi Nzali <mailto:nomssi@physik.tu-chemnitz.de> March 24th, 2000

2
UOLib/ULight.pas
View File

@ -84,7 +84,7 @@ begin
color32.A := 255 color32.A := 255
else else
color32.A := 0; color32.A := 0;
PColor32(FGraphic.PixelPointers[x, y])^ := color32.Color; PColor32(FGraphic.PixelPointer[x, y])^ := color32.Color;
end; end;
buffer.Free; buffer.Free;
end; end;