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

6
Client/UfrmRadar.pas
View File

@ -113,7 +113,7 @@ begin
SetLength(radarMap, FRadar.Width * FRadar.Height);
for x := 0 to FRadar.Width - 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',
fmCreate);
@ -213,7 +213,7 @@ begin
begin
x := ABuffer.ReadWord;
y := ABuffer.ReadWord;
PInteger(FRadar.PixelPointers[x, y])^ := DecodeUOColor(ABuffer.ReadWord);
PInteger(FRadar.PixelPointer[x, y])^ := DecodeUOColor(ABuffer.ReadWord);
RepaintRadar;
end;
end;
@ -225,7 +225,7 @@ var
begin
for x := 0 to FRadar.Width - 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;
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
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 unit contains functions for manipulating and converting color values.}
unit ImagingColors;
interface
{$I ImagingOptions.inc}
uses
SysUtils, ImagingTypes, ImagingUtility;
{ Converts RGB color to YUV.}
procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte);
{ Converts YIV to RGB color.}
procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte);
{ Converts RGB color to YCbCr as used in JPEG.}
procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte);
{ Converts YCbCr as used in JPEG to RGB color.}
procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte);
{ Converts RGB color to YCbCr as used in JPEG.}
procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word);
{ Converts YCbCr as used in JPEG to RGB color.}
procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word);
{ Converts RGB color to CMY.}
procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte);
{ Converts CMY to RGB color.}
procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte);
{ Converts RGB color to CMY.}
procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word);
{ Converts CMY to RGB color.}
procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word);
{ Converts RGB color to CMYK.}
procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte);
{ Converts CMYK to RGB color.}
procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte);
{ Converts RGB color to CMYK.}
procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word);
{ Converts CMYK to RGB color.}
procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word);
{ Converts RGB color to YCoCg.}
procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte);
{ Converts YCoCg to RGB color.}
procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte);
implementation
procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte);
begin
Y := ClampToByte(Round( 0.257 * R + 0.504 * G + 0.098 * B) + 16);
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);
end;
procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte);
var
CY, CU, CV: LongInt;
begin
CY := Y - 16;
CU := U - 128;
CV := V - 128;
R := ClampToByte(Round(1.164 * CY - 0.002 * CU + 1.596 * CV));
G := ClampToByte(Round(1.164 * CY - 0.391 * CU - 0.813 * CV));
B := ClampToByte(Round(1.164 * CY + 2.018 * CU - 0.001 * CV));
end;
procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte);
begin
Y := ClampToByte(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B));
Cb := ClampToByte(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B + 128));
Cr := ClampToByte(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B + 128));
end;
procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte);
begin
R := ClampToByte(Round(Y + 1.40200 * (Cr - 128)));
G := ClampToByte(Round(Y - 0.34414 * (Cb - 128) - 0.71414 * (Cr - 128)));
B := ClampToByte(Round(Y + 1.77200 * (Cb - 128)));
end;
procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word);
begin
Y := ClampToWord(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B));
Cb := ClampToWord(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B + 32768));
Cr := ClampToWord(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B + 32768));
end;
procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word);
begin
R := ClampToWord(Round(Y + 1.40200 * (Cr - 32768)));
G := ClampToWord(Round(Y - 0.34414 * (Cb - 32768) - 0.71414 * (Cr - 32768)));
B := ClampToWord(Round(Y + 1.77200 * (Cb - 32768)));
end;
procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte);
begin
C := 255 - R;
M := 255 - G;
Y := 255 - B;
end;
procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte);
begin
R := 255 - C;
G := 255 - M;
B := 255 - Y;
end;
procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word);
begin
C := 65535 - R;
M := 65535 - G;
Y := 65535 - B;
end;
procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word);
begin
R := 65535 - C;
G := 65535 - M;
B := 65535 - Y;
end;
procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte);
begin
RGBToCMY(R, G, B, C, M, Y);
K := Min(C, Min(M, Y));
if K = 255 then
begin
C := 0;
M := 0;
Y := 0;
end
else
begin
C := ClampToByte(Round((C - K) / (255 - K) * 255));
M := ClampToByte(Round((M - K) / (255 - K) * 255));
Y := ClampToByte(Round((Y - K) / (255 - K) * 255));
end;
end;
procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte);
begin
R := (255 - (C - MulDiv(C, K, 255) + K));
G := (255 - (M - MulDiv(M, K, 255) + K));
B := (255 - (Y - MulDiv(Y, K, 255) + K));
end;
procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word);
begin
RGBToCMY16(R, G, B, C, M, Y);
K := Min(C, Min(M, Y));
if K = 65535 then
begin
C := 0;
M := 0;
Y := 0;
end
else
begin
C := ClampToWord(Round((C - K) / (65535 - K) * 65535));
M := ClampToWord(Round((M - K) / (65535 - K) * 65535));
Y := ClampToWord(Round((Y - K) / (65535 - K) * 65535));
end;
end;
procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word);
begin
R := 65535 - (C - MulDiv(C, K, 65535) + K);
G := 65535 - (M - MulDiv(M, K, 65535) + K);
B := 65535 - (Y - MulDiv(Y, K, 65535) + K);
end;
procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte);
begin
// C and Delphi's SHR behaviour differs for negative numbers, use div instead.
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);
end;
procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte);
var
CoInt, CgInt: Integer;
begin
CoInt := Co - 128;
CgInt := Cg - 128;
R := ClampToByte(Y + CoInt - CgInt);
G := ClampToByte(Y + CgInt);
B := ClampToByte(Y - CoInt - CgInt);
end;
{
File Notes:
-- TODOS ----------------------------------------------------
- nothing now
-- 0.26.3 Changes/Bug Fixes ---------------------------------
- Added RGB<>YCoCg conversion functions.
- 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.
{
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 functions for manipulating and converting color values.}
unit ImagingColors;
interface
{$I ImagingOptions.inc}
uses
SysUtils, ImagingTypes, ImagingUtility;
{ Converts RGB color to YUV.}
procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte);
{ Converts YIV to RGB color.}
procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte);
{ Converts RGB color to YCbCr as used in JPEG.}
procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte);
{ Converts YCbCr as used in JPEG to RGB color.}
procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte);
{ Converts RGB color to YCbCr as used in JPEG.}
procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word);
{ Converts YCbCr as used in JPEG to RGB color.}
procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word);
{ Converts RGB color to CMY.}
procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte);
{ Converts CMY to RGB color.}
procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte);
{ Converts RGB color to CMY.}
procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word);
{ Converts CMY to RGB color.}
procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word);
{ Converts RGB color to CMYK.}
procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte);
{ Converts CMYK to RGB color.}
procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte);
{ Converts RGB color to CMYK.}
procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word);
{ Converts CMYK to RGB color.}
procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word);
{ Converts RGB color to YCoCg.}
procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte);
{ Converts YCoCg to RGB color.}
procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte);
//procedure RGBToHSL(R, G, B: Byte; var H, S, L: Byte);
//procedure HSLToRGB(H, S, L: Byte; var R, G, B: Byte);
implementation
procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte);
begin
Y := ClampToByte(Round( 0.257 * R + 0.504 * G + 0.098 * B) + 16);
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);
end;
procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte);
var
CY, CU, CV: LongInt;
begin
CY := Y - 16;
CU := U - 128;
CV := V - 128;
R := ClampToByte(Round(1.164 * CY - 0.002 * CU + 1.596 * CV));
G := ClampToByte(Round(1.164 * CY - 0.391 * CU - 0.813 * CV));
B := ClampToByte(Round(1.164 * CY + 2.018 * CU - 0.001 * CV));
end;
procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte);
begin
Y := ClampToByte(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B));
Cb := ClampToByte(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B + 128));
Cr := ClampToByte(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B + 128));
end;
procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte);
begin
R := ClampToByte(Round(Y + 1.40200 * (Cr - 128)));
G := ClampToByte(Round(Y - 0.34414 * (Cb - 128) - 0.71414 * (Cr - 128)));
B := ClampToByte(Round(Y + 1.77200 * (Cb - 128)));
end;
procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word);
begin
Y := ClampToWord(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B));
Cb := ClampToWord(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B + 32768));
Cr := ClampToWord(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B + 32768));
end;
procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word);
begin
R := ClampToWord(Round(Y + 1.40200 * (Cr - 32768)));
G := ClampToWord(Round(Y - 0.34414 * (Cb - 32768) - 0.71414 * (Cr - 32768)));
B := ClampToWord(Round(Y + 1.77200 * (Cb - 32768)));
end;
procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte);
begin
C := 255 - R;
M := 255 - G;
Y := 255 - B;
end;
procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte);
begin
R := 255 - C;
G := 255 - M;
B := 255 - Y;
end;
procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word);
begin
C := 65535 - R;
M := 65535 - G;
Y := 65535 - B;
end;
procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word);
begin
R := 65535 - C;
G := 65535 - M;
B := 65535 - Y;
end;
procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte);
begin
RGBToCMY(R, G, B, C, M, Y);
K := Min(C, Min(M, Y));
if K = 255 then
begin
C := 0;
M := 0;
Y := 0;
end
else
begin
C := ClampToByte(Round((C - K) / (255 - K) * 255));
M := ClampToByte(Round((M - K) / (255 - K) * 255));
Y := ClampToByte(Round((Y - K) / (255 - K) * 255));
end;
end;
procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte);
begin
R := (255 - (C - MulDiv(C, K, 255) + K));
G := (255 - (M - MulDiv(M, K, 255) + K));
B := (255 - (Y - MulDiv(Y, K, 255) + K));
end;
procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word);
begin
RGBToCMY16(R, G, B, C, M, Y);
K := Min(C, Min(M, Y));
if K = 65535 then
begin
C := 0;
M := 0;
Y := 0;
end
else
begin
C := ClampToWord(Round((C - K) / (65535 - K) * 65535));
M := ClampToWord(Round((M - K) / (65535 - K) * 65535));
Y := ClampToWord(Round((Y - K) / (65535 - K) * 65535));
end;
end;
procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word);
begin
R := 65535 - (C - MulDiv(C, K, 65535) + K);
G := 65535 - (M - MulDiv(M, K, 65535) + K);
B := 65535 - (Y - MulDiv(Y, K, 65535) + K);
end;
procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte);
begin
// C and Delphi's SHR behaviour differs for negative numbers, use div instead.
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);
end;
procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte);
var
CoInt, CgInt: Integer;
begin
CoInt := Co - 128;
CgInt := Cg - 128;
R := ClampToByte(Y + CoInt - CgInt);
G := ClampToByte(Y + CgInt);
B := ClampToByte(Y - CoInt - CgInt);
end;
{
File Notes:
-- TODOS ----------------------------------------------------
- nothing now
-- 0.26.3 Changes/Bug Fixes ---------------------------------
- Added RGB<>YCoCg conversion functions.
- Fixed RGB>>CMYK conversions.
-- 0.23 Changes/Bug Fixes -----------------------------------
- Added RGB<>CMY(K) conversion 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.
}
{ Source options }
{$DEFINE USE_INLINE} // Use function inlining for some functions
// works in Free Pascal and Delphi 9+.
{.$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.
{ $DEFINE IMAGING_DEBUG} // If defined, debug info, range/IO/overflow
// checking, stack frames, assertions, and
// other debugging options will be turned on.
{$DEFINE IMAGING_RELEASE} // If defined, all debug info is off.
(* File format support linking options.
Define formats which you don't want to be registred automatically.
Default: all 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_TARGA} // link support for Targa images
{.$DEFINE DONT_LINK_BITMAP} // link support for Windows Bitmap images
{$DEFINE DONT_LINK_DDS} // link support for DDS images
{$DEFINE DONT_LINK_GIF} // link support for GIF images
{$DEFINE DONT_LINK_MNG} // link support for MNG images
{$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
// Extras package. Exactly which formats will be
// registered depends on settings in
// ImagingExtras.pas unit.
{ Component set used in ImagignComponents.pas unit. You usually don't need
to be concerned with this - proper component library is selected automatically
according to your compiler. }
{ $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
anything here if you don't know what you are doing.
}
{ Compiler options }
{$ALIGN ON} // Field alignment: 8 Bytes (in D6+)
{$BOOLEVAL OFF} // Boolean eval: off
{$EXTENDEDSYNTAX ON} // Extended syntax: on
{$LONGSTRINGS ON} // string = AnsiString: on
{$MINENUMSIZE 4} // Min enum size: 4 B
{$TYPEDADDRESS OFF} // Typed pointers: off
{$WRITEABLECONST OFF} // Writeable constants: off
{$IFNDEF FPC}
{$DEFINE DCC} // if not using FPC then DCC compiler is used (Delphi/Kylix)
// others are not supported
{$ENDIF}
{$IFDEF DCC}
{$IFDEF LINUX}
{$DEFINE KYLIX} // using Kylix
{$ENDIF}
{$ENDIF}
{$IFDEF DCC}
{$IFNDEF KYLIX}
{$DEFINE DELPHI} // using Delphi
{$ENDIF}
{$ENDIF}
{$IF Defined(IMAGING_DEBUG)}
{$ASSERTIONS ON}
{$DEBUGINFO ON}
{$RANGECHECKS ON}
{$IOCHECKS ON}
{$OVERFLOWCHECKS ON}
{$IFDEF DCC}
{$OPTIMIZATION OFF}
{$STACKFRAMES ON}
{$LOCALSYMBOLS ON}
{$DEFINE MEMCHECK}
{$ENDIF}
{$IFDEF FPC}
{$S+}
{$CHECKPOINTER ON}
{$ENDIF}
{$ELSEIF Defined(IMAGING_RELEASE)}
{$ASSERTIONS OFF}
{$DEBUGINFO OFF}
{$RANGECHECKS OFF}
{$IOCHECKS OFF}
{$OVERFLOWCHECKS OFF}
{$IFDEF DCC}
{$OPTIMIZATION ON}
{$STACKFRAMES OFF}
{$LOCALSYMBOLS OFF}
{$ENDIF}
{$IFDEF FPC}
{$S-}
{$ENDIF}
{$IFEND}
{ Compiler capabilities }
// Define if compiler supports inlining of functions and procedures
// Note that FPC inline support crashed in older versions (1.9.8)
{$IF (Defined(FPC) and Defined(CPU86))}
{$DEFINE HAS_INLINE}
{$IFEND}
// Define if compiler supports operator overloading
// (unfortunately Delphi and FPC operator overloaing is not compatible)
{$IF Defined(FPC)}
{$DEFINE HAS_OPERATOR_OVERLOADING}
{$IFEND}
{ Imaging options check}
{$IFNDEF HAS_INLINE}
{$UNDEF USE_INLINE}
{$ENDIF}
{$IFDEF FPC}
{$IFNDEF CPU86}
{$UNDEF USE_ASM}
{$ENDIF}
{$ENDIF}
{$IFDEF FPC}
{$DEFINE COMPONENT_SET_LCL}
{$UNDEF COMPONENT_SET_VCL}
{$ENDIF}
{$IFDEF DELPHI}
{$UNDEF COMPONENT_SET_LCL}
{$DEFINE COMPONENT_SET_VCL}
{$ENDIF}
{ Platform options }
{$IFDEF WIN32}
{$DEFINE MSWINDOWS}
{$ENDIF}
{$IFDEF DPMI}
{$DEFINE MSDOS}
{$ENDIF}
{$IFDEF LINUX}
{$DEFINE UNIX}
{$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
{$CALLING REGISTER} // default calling convention is register
{$IFDEF CPU86}
{$ASMMODE INTEL} // intel assembler mode
{$ENDIF}
{$ENDIF}
{$IFDEF HAS_INLINE}
{$INLINE ON} // turns inlining on for compilers that support it
{$ENDIF}
{
User Options
Following defines and options can be changed by user.
}
{ Source options }
{$DEFINE USE_INLINE} // Use function inlining for some functions
// works in Free Pascal and Delphi 9+.
{$DEFINE USE_ASM} // If 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.
{.$DEFINE IMAGING_DEBUG} // If defined, debug info, range/IO/overflow
// checking, stack frames, assertions, and
// 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.
Define formats which you don't want to be registered automatically (by adding
Imaging.pas unit to your uses clause).
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_TARGA} // link support for Targa images
{.$DEFINE DONT_LINK_BITMAP} // link support for Windows Bitmap images
{$DEFINE DONT_LINK_DDS} // link support for DDS images
{$DEFINE DONT_LINK_GIF} // link support for GIF images
{$DEFINE DONT_LINK_MNG} // link support for MNG images
{$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_RADHDR} // link support for Radiance HDR/RGBE file format
{$DEFINE DONT_LINK_EXTRAS} // link support for file formats defined in
// Extensions package. Exactly which formats will be
// registered depends on settings in
// ImagingExtFileFormats.pas unit.
{.$DEFINE DONT_LINK_FILE_FORMATS} // no auto link support of any file format
{
Auto Options
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+)
{$BOOLEVAL OFF} // Boolean eval: off
{$EXTENDEDSYNTAX ON} // Extended syntax: on
{$LONGSTRINGS ON} // string = AnsiString: on
{$MINENUMSIZE 1} // Min enum size: 1 B
{$TYPEDADDRESS OFF} // Typed pointers: off
{$WRITEABLECONST OFF} // Writeable constants: off
{$IFNDEF FPC}
{$DEFINE DCC} // if not using FPC then DCC compiler is used (Delphi/BCB)
// others are not supported
{$ENDIF}
{$IFDEF DCC}
{$DEFINE DELPHI}
{$IF (Defined(DCC) and (CompilerVersion >= 25.0))}
{$LEGACYIFEND ON}
{$IFEND}
{$ENDIF}
{$IF (Defined(DCC) and (CompilerVersion >= 18.5))}
{$IFDEF RELEASE}
{$UNDEF DEBUG} // If we are using Delphi 2007+ where you can set
// DEBUG/RELEASE mode in project options and RELEASE
// is currently set we undef DEBUG mode
{$ENDIF}
{$IFEND}
{$IF Defined(IMAGING_DEBUG)}
{$ASSERTIONS ON}
{$DEBUGINFO ON}
{$RANGECHECKS ON}
{$IOCHECKS ON}
{$OVERFLOWCHECKS ON}
{$IFDEF DCC}
{$OPTIMIZATION OFF}
{$STACKFRAMES ON}
{$LOCALSYMBOLS ON}
{$DEFINE MEMCHECK}
{$ENDIF}
{$IFDEF FPC}
{$S+}
{$CHECKPOINTER ON}
{$ENDIF}
{$ELSEIF Defined(IMAGING_RELEASE)}
{$ASSERTIONS OFF}
{$DEBUGINFO OFF}
{$RANGECHECKS OFF}
{$IOCHECKS OFF}
{$OVERFLOWCHECKS OFF}
{$IFDEF DCC}
{$OPTIMIZATION ON}
{$STACKFRAMES OFF}
{$LOCALSYMBOLS OFF}
{$ENDIF}
{$IFDEF FPC}
{$S-}
{$ENDIF}
{$IFEND}
{$IF Defined(CPU86) and not Defined(CPUX86)}
{$DEFINE CPUX86} // Compatibility with Delphi
{$IFEND}
{$IF Defined(CPUX86_64) and not Defined(CPUX64)}
{$DEFINE CPUX64} // Compatibility with Delphi
{$IFEND}
{$IF Defined(DARWIN) and not Defined(MACOS)}
{$DEFINE MACOS} // Compatibility with Delphi
{$IFEND}
{$IF Defined(MACOS)}
{$DEFINE MACOSX}
{$IFEND}
{$IF Defined(DCC) and (CompilerVersion < 23)} // < XE2
{$DEFINE CPUX86} // Compatibility with older Delphi
{$IFEND}
{$IF Defined(WIN32) or Defined(WIN64)}
{$DEFINE MSWINDOWS} // Compatibility with Delphi
{$IFEND}
{$IF Defined(UNIX) and not Defined(POSIX)}
{$DEFINE POSIX} // Compatibility with Delphi
{$IFEND}
{ Compiler capabilities }
// Define if compiler supports inlining of functions and procedures
{$IF (Defined(DCC) and (CompilerVersion >= 17)) or Defined(FPC)}
{$DEFINE HAS_INLINE}
{$IFEND}
// Define if compiler supports advanced records with methods
{$IF (Defined(DCC) and (CompilerVersion >= 18)) or
(Defined(FPC) and (FPC_FULLVERSION >= 20600))}
{$DEFINE HAS_ADVANCED_RECORDS}
{$IFEND}
// Define if compiler supports operator overloading
// (unfortunately Delphi and FPC operator overloading is not compatible).
// FPC supports Delphi compatible operator overloads since 2.6.0
{$IF (Defined(DCC) and (CompilerVersion >= 18)) or
(Defined(FPC) and (FPC_FULLVERSION >= 20600))}
{$DEFINE HAS_OPERATOR_OVERLOADING}
{$IFEND}
// Anonymous methods
{$IF Defined(DCC) and (CompilerVersion >= 20) }
{$DEFINE HAS_ANON_METHODS}
{$IFEND}
// Generic types (Delphi and FPC implementations incompatible).
// Update: FPC supports Delphi compatible generics since 2.6.0
{$IF (Defined(DCC) and (CompilerVersion >= 20)) or
(Defined(FPC) and (FPC_FULLVERSION >= 20600))}
{$DEFINE HAS_GENERICS}
{$IFEND}
{ Compiler pecularities }
// Delphi 64bit POSIX targets
{$IF Defined(DCC) and (SizeOf(Integer) <> SizeOf(LongInt))}
{$DEFINE LONGINT_IS_NOT_INTEGER}
{$IFEND}
// They used to force IFEND, now they warn about it
{$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;
{$N+}
{ This file contains application interface code for the compression half
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
case.
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
parameter-setup helper routines, jcomapi.c for routines shared by
compression and decompression, and jctrans.c for the transcoding case. }
{ jcapimin.c ; Copyright (C) 1994-1998, Thomas G. Lane. }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjinclude,
imjdeferr,
imjerror,
imjpeglib,
imjcomapi,
imjmemmgr,
imjcmarker;
{ Initialization of JPEG compression objects.
Nomssi: This is a macro in the original code.
jpeg_create_compress() and jpeg_create_decompress() are the exported
names that applications should call. These expand to calls on
jpeg_CreateCompress and jpeg_CreateDecompress with additional information
passed for version mismatch checking.
NB: you must set up the error-manager BEFORE calling jpeg_create_xxx. }
procedure jpeg_create_compress(cinfo : j_compress_ptr);
{ Initialization of a JPEG compression object.
The error manager must already be set up (in case memory manager fails). }
{GLOBAL}
procedure jpeg_CreateCompress (cinfo : j_compress_ptr;
version : int;
structsize : size_t);
{ Destruction of a JPEG compression object }
{GLOBAL}
procedure jpeg_destroy_compress (cinfo : j_compress_ptr);
{ Abort processing of a JPEG compression operation,
but don't destroy the object itself. }
{GLOBAL}
procedure jpeg_abort_compress (cinfo : j_compress_ptr);
{ Forcibly suppress or un-suppress all quantization and Huffman tables.
Marks all currently defined tables as already written (if suppress)
or not written (if !suppress). This will control whether they get emitted
by a subsequent jpeg_start_compress call.
This routine is exported for use by applications that want to produce
abbreviated JPEG datastreams. It logically belongs in jcparam.c, but
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. }
{GLOBAL}
procedure jpeg_suppress_tables (cinfo : j_compress_ptr;
suppress : boolean);
{ Finish JPEG compression.
If a multipass operating mode was selected, this may do a great deal of
work including most of the actual output. }
{GLOBAL}
procedure jpeg_finish_compress (cinfo : j_compress_ptr);
{ Write a special marker.
This is only recommended for writing COM or APPn markers.
Must be called after jpeg_start_compress() and before
first call to jpeg_write_scanlines() or jpeg_write_raw_data(). }
{GLOBAL}
procedure jpeg_write_marker (cinfo : j_compress_ptr;
marker : int;
dataptr : JOCTETptr;
datalen : uInt);
{GLOBAL}
procedure jpeg_write_m_header (cinfo : j_compress_ptr;
marker : int;
datalen : uint);
{GLOBAL}
procedure jpeg_write_m_byte (cinfo : j_compress_ptr; val : int);
{ Alternate compression function: just write an abbreviated table file.
Before calling this, all parameters and a data destination must be set up.
To produce a pair of files containing abbreviated tables and abbreviated
image data, one would proceed as follows:
initialize JPEG object
set JPEG parameters
set destination to table file
jpeg_write_tables(cinfo);
set destination to image file
jpeg_start_compress(cinfo, FALSE);
write data...
jpeg_finish_compress(cinfo);
jpeg_write_tables has the side effect of marking all tables written
(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. }
{GLOBAL}
procedure jpeg_write_tables (cinfo : j_compress_ptr);
implementation
procedure jpeg_create_compress(cinfo : j_compress_ptr);
begin
jpeg_CreateCompress(cinfo, JPEG_LIB_VERSION,
size_t(sizeof(jpeg_compress_struct)));
end;
{ Initialization of a JPEG compression object.
The error manager must already be set up (in case memory manager fails). }
{GLOBAL}
procedure jpeg_CreateCompress (cinfo : j_compress_ptr;
version : int;
structsize : size_t);
var
i : int;
var
err : jpeg_error_mgr_ptr;
client_data : voidp;
begin
{ Guard against version mismatches between library and caller. }
cinfo^.mem := NIL; { so jpeg_destroy knows mem mgr not called }
if (version <> JPEG_LIB_VERSION) then
ERREXIT2(j_common_ptr(cinfo), JERR_BAD_LIB_VERSION, JPEG_LIB_VERSION, version);
if (structsize <> SIZEOF(jpeg_compress_struct)) then
ERREXIT2(j_common_ptr(cinfo), JERR_BAD_STRUCT_SIZE,
int(SIZEOF(jpeg_compress_struct)), int(structsize));
{ For debugging purposes, we zero the whole master structure.
But the application has already set the err pointer, and may have set
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; { ignore Purify complaint here }
MEMZERO(cinfo, SIZEOF(jpeg_compress_struct));
cinfo^.err := err;
cinfo^.is_decompressor := FALSE;
{ Initialize a memory manager instance for this object }
jinit_memory_mgr(j_common_ptr(cinfo));
{ Zero out pointers to permanent structures. }
cinfo^.progress := NIL;
cinfo^.dest := NIL;
cinfo^.comp_info := NIL;
for i := 0 to pred(NUM_QUANT_TBLS) do
cinfo^.quant_tbl_ptrs[i] := NIL;
for i := 0 to pred(NUM_HUFF_TBLS) do
begin
cinfo^.dc_huff_tbl_ptrs[i] := NIL;
cinfo^.ac_huff_tbl_ptrs[i] := NIL;
end;
cinfo^.script_space := NIL;
cinfo^.input_gamma := 1.0; { in case application forgets }
{ OK, I'm ready }
cinfo^.global_state := CSTATE_START;
end;
{ Destruction of a JPEG compression object }
{GLOBAL}
procedure jpeg_destroy_compress (cinfo : j_compress_ptr);
begin
jpeg_destroy(j_common_ptr(cinfo)); { use common routine }
end;
{ Abort processing of a JPEG compression operation,
but don't destroy the object itself. }
{GLOBAL}
procedure jpeg_abort_compress (cinfo : j_compress_ptr);
begin
jpeg_abort(j_common_ptr(cinfo)); { use common routine }
end;
{ Forcibly suppress or un-suppress all quantization and Huffman tables.
Marks all currently defined tables as already written (if suppress)
or not written (if !suppress). This will control whether they get emitted
by a subsequent jpeg_start_compress call.
This routine is exported for use by applications that want to produce
abbreviated JPEG datastreams. It logically belongs in jcparam.c, but
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. }
{GLOBAL}
procedure jpeg_suppress_tables (cinfo : j_compress_ptr;
suppress : boolean);
var
i : int;
qtbl : JQUANT_TBL_PTR;
htbl : JHUFF_TBL_PTR;
begin
for i := 0 to pred(NUM_QUANT_TBLS) do
begin
qtbl := cinfo^.quant_tbl_ptrs[i];
if (qtbl <> NIL) then
qtbl^.sent_table := suppress;
end;
for i := 0 to pred(NUM_HUFF_TBLS) do
begin
htbl := cinfo^.dc_huff_tbl_ptrs[i];
if (htbl <> NIL) then
htbl^.sent_table := suppress;
htbl := cinfo^.ac_huff_tbl_ptrs[i];
if (htbl <> NIL) then
htbl^.sent_table := suppress;
end;
end;
{ Finish JPEG compression.
If a multipass operating mode was selected, this may do a great deal of
work including most of the actual output. }
{GLOBAL}
procedure jpeg_finish_compress (cinfo : j_compress_ptr);
var
iMCU_row : JDIMENSION;
begin
if (cinfo^.global_state = CSTATE_SCANNING) or
(cinfo^.global_state = CSTATE_RAW_OK) then
begin
{ Terminate first pass }
if (cinfo^.next_scanline < cinfo^.image_height) then
ERREXIT(j_common_ptr(cinfo), JERR_TOO_LITTLE_DATA);
cinfo^.master^.finish_pass (cinfo);
end
else
if (cinfo^.global_state <> CSTATE_WRCOEFS) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
{ Perform any remaining passes }
while (not cinfo^.master^.is_last_pass) do
begin
cinfo^.master^.prepare_for_pass (cinfo);
for iMCU_row := 0 to pred(cinfo^.total_iMCU_rows) do
begin
if (cinfo^.progress <> NIL) then
begin
cinfo^.progress^.pass_counter := long (iMCU_row);
cinfo^.progress^.pass_limit := long (cinfo^.total_iMCU_rows);
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
end;
{ We bypass the main controller and invoke coef controller directly;
all work is being done from the coefficient buffer. }
if (not cinfo^.coef^.compress_data (cinfo, JSAMPIMAGE(NIL))) then
ERREXIT(j_common_ptr(cinfo), JERR_CANT_SUSPEND);
end;
cinfo^.master^.finish_pass (cinfo);
end;
{ Write EOI, do final cleanup }
cinfo^.marker^.write_file_trailer (cinfo);
cinfo^.dest^.term_destination (cinfo);
{ We can use jpeg_abort to release memory and reset global_state }
jpeg_abort(j_common_ptr(cinfo));
end;
{ Write a special marker.
This is only recommended for writing COM or APPn markers.
Must be called after jpeg_start_compress() and before
first call to jpeg_write_scanlines() or jpeg_write_raw_data(). }
{GLOBAL}
procedure jpeg_write_marker (cinfo : j_compress_ptr;
marker : int;
dataptr : JOCTETptr;
datalen : uInt);
var
write_marker_byte : procedure(info : j_compress_ptr; val : int);
begin
if (cinfo^.next_scanline <> 0) or
((cinfo^.global_state <> CSTATE_SCANNING) and
(cinfo^.global_state <> CSTATE_RAW_OK) and
(cinfo^.global_state <> CSTATE_WRCOEFS)) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
cinfo^.marker^.write_marker_header (cinfo, marker, datalen);
write_marker_byte := cinfo^.marker^.write_marker_byte; { copy for speed }
while (datalen <> 0) do
begin
Dec(datalen);
write_marker_byte (cinfo, dataptr^);
Inc(dataptr);
end;
end;
{ Same, but piecemeal. }
{GLOBAL}
procedure jpeg_write_m_header (cinfo : j_compress_ptr;
marker : int;
datalen : uint);
begin
if (cinfo^.next_scanline <> 0) or
((cinfo^.global_state <> CSTATE_SCANNING) and
(cinfo^.global_state <> CSTATE_RAW_OK) and
(cinfo^.global_state <> CSTATE_WRCOEFS)) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
cinfo^.marker^.write_marker_header (cinfo, marker, datalen);
end;
{GLOBAL}
procedure jpeg_write_m_byte (cinfo : j_compress_ptr; val : int);
begin
cinfo^.marker^.write_marker_byte (cinfo, val);
end;
{ Alternate compression function: just write an abbreviated table file.
Before calling this, all parameters and a data destination must be set up.
To produce a pair of files containing abbreviated tables and abbreviated
image data, one would proceed as follows:
initialize JPEG object
set JPEG parameters
set destination to table file
jpeg_write_tables(cinfo);
set destination to image file
jpeg_start_compress(cinfo, FALSE);
write data...
jpeg_finish_compress(cinfo);
jpeg_write_tables has the side effect of marking all tables written
(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. }
{GLOBAL}
procedure jpeg_write_tables (cinfo : j_compress_ptr);
begin
if (cinfo^.global_state <> CSTATE_START) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
{ (Re)initialize error mgr and destination modules }
cinfo^.err^.reset_error_mgr (j_common_ptr(cinfo));
cinfo^.dest^.init_destination (cinfo);
{ Initialize the marker writer ... bit of a crock to do it here. }
jinit_marker_writer(cinfo);
{ Write them tables! }
cinfo^.marker^.write_tables_only (cinfo);
{ And clean up. }
cinfo^.dest^.term_destination (cinfo);
{ In library releases up through v6a, we called jpeg_abort() here to free
any working memory allocated by the destination manager and marker
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
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
compression cycle or otherwise resetting the JPEG object. However, that
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
each call to jpeg_write_tables(). }
end;
end.
unit imjcapimin;
{ This file contains application interface code for the compression half
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
case.
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
parameter-setup helper routines, jcomapi.c for routines shared by
compression and decompression, and jctrans.c for the transcoding case. }
{ jcapimin.c ; Copyright (C) 1994-1998, Thomas G. Lane. }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjinclude,
imjdeferr,
imjerror,
imjpeglib,
imjcomapi,
imjmemmgr,
imjcmarker;
{ Initialization of JPEG compression objects.
Nomssi: This is a macro in the original code.
jpeg_create_compress() and jpeg_create_decompress() are the exported
names that applications should call. These expand to calls on
jpeg_CreateCompress and jpeg_CreateDecompress with additional information
passed for version mismatch checking.
NB: you must set up the error-manager BEFORE calling jpeg_create_xxx. }
procedure jpeg_create_compress(cinfo : j_compress_ptr);
{ Initialization of a JPEG compression object.
The error manager must already be set up (in case memory manager fails). }
{GLOBAL}
procedure jpeg_CreateCompress (cinfo : j_compress_ptr;
version : int;
structsize : size_t);
{ Destruction of a JPEG compression object }
{GLOBAL}
procedure jpeg_destroy_compress (cinfo : j_compress_ptr);
{ Abort processing of a JPEG compression operation,
but don't destroy the object itself. }
{GLOBAL}
procedure jpeg_abort_compress (cinfo : j_compress_ptr);
{ Forcibly suppress or un-suppress all quantization and Huffman tables.
Marks all currently defined tables as already written (if suppress)
or not written (if !suppress). This will control whether they get emitted
by a subsequent jpeg_start_compress call.
This routine is exported for use by applications that want to produce
abbreviated JPEG datastreams. It logically belongs in jcparam.c, but
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. }
{GLOBAL}
procedure jpeg_suppress_tables (cinfo : j_compress_ptr;
suppress : boolean);
{ Finish JPEG compression.
If a multipass operating mode was selected, this may do a great deal of
work including most of the actual output. }
{GLOBAL}
procedure jpeg_finish_compress (cinfo : j_compress_ptr);
{ Write a special marker.
This is only recommended for writing COM or APPn markers.
Must be called after jpeg_start_compress() and before
first call to jpeg_write_scanlines() or jpeg_write_raw_data(). }
{GLOBAL}
procedure jpeg_write_marker (cinfo : j_compress_ptr;
marker : int;
dataptr : JOCTETptr;
datalen : uInt);
{GLOBAL}
procedure jpeg_write_m_header (cinfo : j_compress_ptr;
marker : int;
datalen : uint);
{GLOBAL}
procedure jpeg_write_m_byte (cinfo : j_compress_ptr; val : int);
{ Alternate compression function: just write an abbreviated table file.
Before calling this, all parameters and a data destination must be set up.
To produce a pair of files containing abbreviated tables and abbreviated
image data, one would proceed as follows:
initialize JPEG object
set JPEG parameters
set destination to table file
jpeg_write_tables(cinfo);
set destination to image file
jpeg_start_compress(cinfo, FALSE);
write data...
jpeg_finish_compress(cinfo);
jpeg_write_tables has the side effect of marking all tables written
(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. }
{GLOBAL}
procedure jpeg_write_tables (cinfo : j_compress_ptr);
implementation
procedure jpeg_create_compress(cinfo : j_compress_ptr);
begin
jpeg_CreateCompress(cinfo, JPEG_LIB_VERSION,
size_t(sizeof(jpeg_compress_struct)));
end;
{ Initialization of a JPEG compression object.
The error manager must already be set up (in case memory manager fails). }
{GLOBAL}
procedure jpeg_CreateCompress (cinfo : j_compress_ptr;
version : int;
structsize : size_t);
var
i : int;
var
err : jpeg_error_mgr_ptr;
client_data : voidp;
begin
{ Guard against version mismatches between library and caller. }
cinfo^.mem := NIL; { so jpeg_destroy knows mem mgr not called }
if (version <> JPEG_LIB_VERSION) then
ERREXIT2(j_common_ptr(cinfo), JERR_BAD_LIB_VERSION, JPEG_LIB_VERSION, version);
if (structsize <> SIZEOF(jpeg_compress_struct)) then
ERREXIT2(j_common_ptr(cinfo), JERR_BAD_STRUCT_SIZE,
int(SIZEOF(jpeg_compress_struct)), int(structsize));
{ For debugging purposes, we zero the whole master structure.
But the application has already set the err pointer, and may have set
client_data, so we have to save and restore those fields. }
err := cinfo^.err;
client_data := cinfo^.client_data;
MEMZERO(cinfo, SIZEOF(jpeg_compress_struct));
cinfo^.err := err;
cinfo^.is_decompressor := FALSE;
cinfo^.client_data := client_data;
{ Initialize a memory manager instance for this object }
jinit_memory_mgr(j_common_ptr(cinfo));
{ Zero out pointers to permanent structures. }
cinfo^.progress := NIL;
cinfo^.dest := NIL;
cinfo^.comp_info := NIL;
for i := 0 to pred(NUM_QUANT_TBLS) do
cinfo^.quant_tbl_ptrs[i] := NIL;
for i := 0 to pred(NUM_HUFF_TBLS) do
begin
cinfo^.dc_huff_tbl_ptrs[i] := NIL;
cinfo^.ac_huff_tbl_ptrs[i] := NIL;
end;
cinfo^.script_space := NIL;
cinfo^.input_gamma := 1.0; { in case application forgets }
{ OK, I'm ready }
cinfo^.global_state := CSTATE_START;
end;
{ Destruction of a JPEG compression object }
{GLOBAL}
procedure jpeg_destroy_compress (cinfo : j_compress_ptr);
begin
jpeg_destroy(j_common_ptr(cinfo)); { use common routine }
end;
{ Abort processing of a JPEG compression operation,
but don't destroy the object itself. }
{GLOBAL}
procedure jpeg_abort_compress (cinfo : j_compress_ptr);
begin
jpeg_abort(j_common_ptr(cinfo)); { use common routine }
end;
{ Forcibly suppress or un-suppress all quantization and Huffman tables.
Marks all currently defined tables as already written (if suppress)
or not written (if !suppress). This will control whether they get emitted
by a subsequent jpeg_start_compress call.
This routine is exported for use by applications that want to produce
abbreviated JPEG datastreams. It logically belongs in jcparam.c, but
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. }
{GLOBAL}
procedure jpeg_suppress_tables (cinfo : j_compress_ptr;
suppress : boolean);
var
i : int;
qtbl : JQUANT_TBL_PTR;
htbl : JHUFF_TBL_PTR;
begin
for i := 0 to pred(NUM_QUANT_TBLS) do
begin
qtbl := cinfo^.quant_tbl_ptrs[i];
if (qtbl <> NIL) then
qtbl^.sent_table := suppress;
end;
for i := 0 to pred(NUM_HUFF_TBLS) do
begin
htbl := cinfo^.dc_huff_tbl_ptrs[i];
if (htbl <> NIL) then
htbl^.sent_table := suppress;
htbl := cinfo^.ac_huff_tbl_ptrs[i];
if (htbl <> NIL) then
htbl^.sent_table := suppress;
end;
end;
{ Finish JPEG compression.
If a multipass operating mode was selected, this may do a great deal of
work including most of the actual output. }
{GLOBAL}
procedure jpeg_finish_compress (cinfo : j_compress_ptr);
var
iMCU_row : JDIMENSION;
begin
if (cinfo^.global_state = CSTATE_SCANNING) or
(cinfo^.global_state = CSTATE_RAW_OK) then
begin
{ Terminate first pass }
if (cinfo^.next_scanline < cinfo^.image_height) then
ERREXIT(j_common_ptr(cinfo), JERR_TOO_LITTLE_DATA);
cinfo^.master^.finish_pass (cinfo);
end
else
if (cinfo^.global_state <> CSTATE_WRCOEFS) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
{ Perform any remaining passes }
while (not cinfo^.master^.is_last_pass) do
begin
cinfo^.master^.prepare_for_pass (cinfo);
for iMCU_row := 0 to pred(cinfo^.total_iMCU_rows) do
begin
if (cinfo^.progress <> NIL) then
begin
cinfo^.progress^.pass_counter := long (iMCU_row);
cinfo^.progress^.pass_limit := long (cinfo^.total_iMCU_rows);
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
end;
{ We bypass the main controller and invoke coef controller directly;
all work is being done from the coefficient buffer. }
if (not cinfo^.coef^.compress_data (cinfo, JSAMPIMAGE(NIL))) then
ERREXIT(j_common_ptr(cinfo), JERR_CANT_SUSPEND);
end;
cinfo^.master^.finish_pass (cinfo);
end;
{ Write EOI, do final cleanup }
cinfo^.marker^.write_file_trailer (cinfo);
cinfo^.dest^.term_destination (cinfo);
{ We can use jpeg_abort to release memory and reset global_state }
jpeg_abort(j_common_ptr(cinfo));
end;
{ Write a special marker.
This is only recommended for writing COM or APPn markers.
Must be called after jpeg_start_compress() and before
first call to jpeg_write_scanlines() or jpeg_write_raw_data(). }
{GLOBAL}
procedure jpeg_write_marker (cinfo : j_compress_ptr;
marker : int;
dataptr : JOCTETptr;
datalen : uInt);
var
write_marker_byte : procedure(info : j_compress_ptr; val : int);
begin
if (cinfo^.next_scanline <> 0) or
((cinfo^.global_state <> CSTATE_SCANNING) and
(cinfo^.global_state <> CSTATE_RAW_OK) and
(cinfo^.global_state <> CSTATE_WRCOEFS)) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
cinfo^.marker^.write_marker_header (cinfo, marker, datalen);
write_marker_byte := cinfo^.marker^.write_marker_byte; { copy for speed }
while (datalen <> 0) do
begin
Dec(datalen);
write_marker_byte (cinfo, dataptr^);
Inc(dataptr);
end;
end;
{ Same, but piecemeal. }
{GLOBAL}
procedure jpeg_write_m_header (cinfo : j_compress_ptr;
marker : int;
datalen : uint);
begin
if (cinfo^.next_scanline <> 0) or
((cinfo^.global_state <> CSTATE_SCANNING) and
(cinfo^.global_state <> CSTATE_RAW_OK) and
(cinfo^.global_state <> CSTATE_WRCOEFS)) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
cinfo^.marker^.write_marker_header (cinfo, marker, datalen);
end;
{GLOBAL}
procedure jpeg_write_m_byte (cinfo : j_compress_ptr; val : int);
begin
cinfo^.marker^.write_marker_byte (cinfo, val);
end;
{ Alternate compression function: just write an abbreviated table file.
Before calling this, all parameters and a data destination must be set up.
To produce a pair of files containing abbreviated tables and abbreviated
image data, one would proceed as follows:
initialize JPEG object
set JPEG parameters
set destination to table file
jpeg_write_tables(cinfo);
set destination to image file
jpeg_start_compress(cinfo, FALSE);
write data...
jpeg_finish_compress(cinfo);
jpeg_write_tables has the side effect of marking all tables written
(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. }
{GLOBAL}
procedure jpeg_write_tables (cinfo : j_compress_ptr);
begin
if (cinfo^.global_state <> CSTATE_START) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
{ (Re)initialize error mgr and destination modules }
cinfo^.err^.reset_error_mgr (j_common_ptr(cinfo));
cinfo^.dest^.init_destination (cinfo);
{ Initialize the marker writer ... bit of a crock to do it here. }
jinit_marker_writer(cinfo);
{ Write them tables! }
cinfo^.marker^.write_tables_only (cinfo);
{ And clean up. }
cinfo^.dest^.term_destination (cinfo);
{ In library releases up through v6a, we called jpeg_abort() here to free
any working memory allocated by the destination manager and marker
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
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
compression cycle or otherwise resetting the JPEG object. However, that
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
each call to jpeg_write_tables(). }
end;
end.

444
Imaging/JpegLib/imjcapistd.pas
View File

@ -1,222 +1,222 @@
unit imjcapistd;
{ Original : jcapistd.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
{ This file is part of the Independent JPEG Group's software.
For conditions of distribution and use, see the accompanying README file.
This file contains application interface code for the compression half
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
transcoding-only application. Note that if an application links in
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
whole compression library into a transcoder. }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjinclude,
imjdeferr,
imjerror,
imjpeglib,
imjcapimin, imjcinit;
{ Compression initialization.
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
multiple datastreams from the same compression object. Since prior runs
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
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
images. Therefore the documentation and examples should encourage people
to pass write_all_tables=TRUE; then it will take active thought to do the
wrong thing. }
{GLOBAL}
procedure jpeg_start_compress (cinfo : j_compress_ptr;
write_all_tables : boolean);
{ Write some scanlines of data to the JPEG compressor.
The return value will be the number of lines actually written.
This should be less than the supplied num_lines only in case that
the data destination module has requested suspension of the compressor,
or if more than image_height scanlines are passed in.
Note: we warn about excess calls to jpeg_write_scanlines() since
this likely signals an application programmer error. However,
excess scanlines passed in the last valid call are *silently* ignored,
so that the application need not adjust num_lines for end-of-image
when using a multiple-scanline buffer. }
{GLOBAL}
function jpeg_write_scanlines (cinfo : j_compress_ptr;
scanlines : JSAMPARRAY;
num_lines : JDIMENSION) : JDIMENSION;
{ Alternate entry point to write raw data.
Processes exactly one iMCU row per call, unless suspended. }
{GLOBAL}
function jpeg_write_raw_data (cinfo : j_compress_ptr;
data : JSAMPIMAGE;
num_lines : JDIMENSION) : JDIMENSION;
implementation
{ Compression initialization.
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
multiple datastreams from the same compression object. Since prior runs
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
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
images. Therefore the documentation and examples should encourage people
to pass write_all_tables=TRUE; then it will take active thought to do the
wrong thing. }
{GLOBAL}
procedure jpeg_start_compress (cinfo : j_compress_ptr;
write_all_tables : boolean);
begin
if (cinfo^.global_state <> CSTATE_START) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
if (write_all_tables) then
jpeg_suppress_tables(cinfo, FALSE); { mark all tables to be written }
{ (Re)initialize error mgr and destination modules }
cinfo^.err^.reset_error_mgr (j_common_ptr(cinfo));
cinfo^.dest^.init_destination (cinfo);
{ Perform master selection of active modules }
jinit_compress_master(cinfo);
{ Set up for the first pass }
cinfo^.master^.prepare_for_pass (cinfo);
{ Ready for application to drive first pass through jpeg_write_scanlines
or jpeg_write_raw_data. }
cinfo^.next_scanline := 0;
if cinfo^.raw_data_in then
cinfo^.global_state := CSTATE_RAW_OK
else
cinfo^.global_state := CSTATE_SCANNING;
end;
{ Write some scanlines of data to the JPEG compressor.
The return value will be the number of lines actually written.
This should be less than the supplied num_lines only in case that
the data destination module has requested suspension of the compressor,
or if more than image_height scanlines are passed in.
Note: we warn about excess calls to jpeg_write_scanlines() since
this likely signals an application programmer error. However,
excess scanlines passed in the last valid call are *silently* ignored,
so that the application need not adjust num_lines for end-of-image
when using a multiple-scanline buffer. }
{GLOBAL}
function jpeg_write_scanlines (cinfo : j_compress_ptr;
scanlines : JSAMPARRAY;
num_lines : JDIMENSION) : JDIMENSION;
var
row_ctr, rows_left : JDIMENSION;
begin
if (cinfo^.global_state <> CSTATE_SCANNING) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
if (cinfo^.next_scanline >= cinfo^.image_height) then
WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA);
{ Call progress monitor hook if present }
if (cinfo^.progress <> NIL) then
begin
cinfo^.progress^.pass_counter := long (cinfo^.next_scanline);
cinfo^.progress^.pass_limit := long (cinfo^.image_height);
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
end;
{ Give master control module another chance if this is first call to
jpeg_write_scanlines. This lets output of the frame/scan headers be
delayed so that application can write COM, etc, markers between
jpeg_start_compress and jpeg_write_scanlines. }
if (cinfo^.master^.call_pass_startup) then
cinfo^.master^.pass_startup (cinfo);
{ Ignore any extra scanlines at bottom of image. }
rows_left := cinfo^.image_height - cinfo^.next_scanline;
if (num_lines > rows_left) then
num_lines := rows_left;
row_ctr := 0;
cinfo^.main^.process_data (cinfo, scanlines, {var}row_ctr, num_lines);
Inc(cinfo^.next_scanline, row_ctr);
jpeg_write_scanlines := row_ctr;
end;
{ Alternate entry point to write raw data.
Processes exactly one iMCU row per call, unless suspended. }
{GLOBAL}
function jpeg_write_raw_data (cinfo : j_compress_ptr;
data : JSAMPIMAGE;
num_lines : JDIMENSION) : JDIMENSION;
var
lines_per_iMCU_row : JDIMENSION;
begin
if (cinfo^.global_state <> CSTATE_RAW_OK) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
if (cinfo^.next_scanline >= cinfo^.image_height) then
begin
WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA);
jpeg_write_raw_data := 0;
exit;
end;
{ Call progress monitor hook if present }
if (cinfo^.progress <> NIL) then
begin
cinfo^.progress^.pass_counter := long(cinfo^.next_scanline);
cinfo^.progress^.pass_limit := long(cinfo^.image_height);
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
end;
{ 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
delayed so that application can write COM, etc, markers between
jpeg_start_compress and jpeg_write_raw_data. }
if (cinfo^.master^.call_pass_startup) then
cinfo^.master^.pass_startup (cinfo);
{ Verify that at least one iMCU row has been passed. }
lines_per_iMCU_row := cinfo^.max_v_samp_factor * DCTSIZE;
if (num_lines < lines_per_iMCU_row) then
ERREXIT(j_common_ptr(cinfo), JERR_BUFFER_SIZE);
{ Directly compress the row. }
if (not cinfo^.coef^.compress_data (cinfo, data)) then
begin
{ If compressor did not consume the whole row, suspend processing. }
jpeg_write_raw_data := 0;
exit;
end;
{ OK, we processed one iMCU row. }
Inc(cinfo^.next_scanline, lines_per_iMCU_row);
jpeg_write_raw_data := lines_per_iMCU_row;
end;
end.
unit imjcapistd;
{ Original : jcapistd.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
{ This file is part of the Independent JPEG Group's software.
For conditions of distribution and use, see the accompanying README file.
This file contains application interface code for the compression half
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
transcoding-only application. Note that if an application links in
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
whole compression library into a transcoder. }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjinclude,
imjdeferr,
imjerror,
imjpeglib,
imjcapimin, imjcinit;
{ Compression initialization.
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
multiple datastreams from the same compression object. Since prior runs
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
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
images. Therefore the documentation and examples should encourage people
to pass write_all_tables=TRUE; then it will take active thought to do the
wrong thing. }
{GLOBAL}
procedure jpeg_start_compress (cinfo : j_compress_ptr;
write_all_tables : boolean);
{ Write some scanlines of data to the JPEG compressor.
The return value will be the number of lines actually written.
This should be less than the supplied num_lines only in case that
the data destination module has requested suspension of the compressor,
or if more than image_height scanlines are passed in.
Note: we warn about excess calls to jpeg_write_scanlines() since
this likely signals an application programmer error. However,
excess scanlines passed in the last valid call are *silently* ignored,
so that the application need not adjust num_lines for end-of-image
when using a multiple-scanline buffer. }
{GLOBAL}
function jpeg_write_scanlines (cinfo : j_compress_ptr;
scanlines : JSAMPARRAY;
num_lines : JDIMENSION) : JDIMENSION;
{ Alternate entry point to write raw data.
Processes exactly one iMCU row per call, unless suspended. }
{GLOBAL}
function jpeg_write_raw_data (cinfo : j_compress_ptr;
data : JSAMPIMAGE;
num_lines : JDIMENSION) : JDIMENSION;
implementation
{ Compression initialization.
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
multiple datastreams from the same compression object. Since prior runs
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
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
images. Therefore the documentation and examples should encourage people
to pass write_all_tables=TRUE; then it will take active thought to do the
wrong thing. }
{GLOBAL}
procedure jpeg_start_compress (cinfo : j_compress_ptr;
write_all_tables : boolean);
begin
if (cinfo^.global_state <> CSTATE_START) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
if (write_all_tables) then
jpeg_suppress_tables(cinfo, FALSE); { mark all tables to be written }
{ (Re)initialize error mgr and destination modules }
cinfo^.err^.reset_error_mgr (j_common_ptr(cinfo));
cinfo^.dest^.init_destination (cinfo);
{ Perform master selection of active modules }
jinit_compress_master(cinfo);
{ Set up for the first pass }
cinfo^.master^.prepare_for_pass (cinfo);
{ Ready for application to drive first pass through jpeg_write_scanlines
or jpeg_write_raw_data. }
cinfo^.next_scanline := 0;
if cinfo^.raw_data_in then
cinfo^.global_state := CSTATE_RAW_OK
else
cinfo^.global_state := CSTATE_SCANNING;
end;
{ Write some scanlines of data to the JPEG compressor.
The return value will be the number of lines actually written.
This should be less than the supplied num_lines only in case that
the data destination module has requested suspension of the compressor,
or if more than image_height scanlines are passed in.
Note: we warn about excess calls to jpeg_write_scanlines() since
this likely signals an application programmer error. However,
excess scanlines passed in the last valid call are *silently* ignored,
so that the application need not adjust num_lines for end-of-image
when using a multiple-scanline buffer. }
{GLOBAL}
function jpeg_write_scanlines (cinfo : j_compress_ptr;
scanlines : JSAMPARRAY;
num_lines : JDIMENSION) : JDIMENSION;
var
row_ctr, rows_left : JDIMENSION;
begin
if (cinfo^.global_state <> CSTATE_SCANNING) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
if (cinfo^.next_scanline >= cinfo^.image_height) then
WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA);
{ Call progress monitor hook if present }
if (cinfo^.progress <> NIL) then
begin
cinfo^.progress^.pass_counter := long (cinfo^.next_scanline);
cinfo^.progress^.pass_limit := long (cinfo^.image_height);
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
end;
{ Give master control module another chance if this is first call to
jpeg_write_scanlines. This lets output of the frame/scan headers be
delayed so that application can write COM, etc, markers between
jpeg_start_compress and jpeg_write_scanlines. }
if (cinfo^.master^.call_pass_startup) then
cinfo^.master^.pass_startup (cinfo);
{ Ignore any extra scanlines at bottom of image. }
rows_left := cinfo^.image_height - cinfo^.next_scanline;
if (num_lines > rows_left) then
num_lines := rows_left;
row_ctr := 0;
cinfo^.main^.process_data (cinfo, scanlines, {var}row_ctr, num_lines);
Inc(cinfo^.next_scanline, row_ctr);
jpeg_write_scanlines := row_ctr;
end;
{ Alternate entry point to write raw data.
Processes exactly one iMCU row per call, unless suspended. }
{GLOBAL}
function jpeg_write_raw_data (cinfo : j_compress_ptr;
data : JSAMPIMAGE;
num_lines : JDIMENSION) : JDIMENSION;
var
lines_per_iMCU_row : JDIMENSION;
begin
if (cinfo^.global_state <> CSTATE_RAW_OK) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
if (cinfo^.next_scanline >= cinfo^.image_height) then
begin
WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA);
jpeg_write_raw_data := 0;
exit;
end;
{ Call progress monitor hook if present }
if (cinfo^.progress <> NIL) then
begin
cinfo^.progress^.pass_counter := long(cinfo^.next_scanline);
cinfo^.progress^.pass_limit := long(cinfo^.image_height);
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
end;
{ 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
delayed so that application can write COM, etc, markers between
jpeg_start_compress and jpeg_write_raw_data. }
if (cinfo^.master^.call_pass_startup) then
cinfo^.master^.pass_startup (cinfo);
{ Verify that at least one iMCU row has been passed. }
lines_per_iMCU_row := cinfo^.max_v_samp_factor * DCTSIZE;
if (num_lines < lines_per_iMCU_row) then
ERREXIT(j_common_ptr(cinfo), JERR_BUFFER_SIZE);
{ Directly compress the row. }
if (not cinfo^.coef^.compress_data (cinfo, data)) then
begin
{ If compressor did not consume the whole row, suspend processing. }
jpeg_write_raw_data := 0;
exit;
end;
{ OK, we processed one iMCU row. }
Inc(cinfo^.next_scanline, lines_per_iMCU_row);
jpeg_write_raw_data := lines_per_iMCU_row;
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;
{ Original: jcinit.c ; Copyright (C) 1991-1997, Thomas G. Lane. }
{ This file contains initialization logic for the JPEG compressor.
This routine is in charge of selecting the modules to be executed and
making an initialization call to each one.
Logically, this code belongs in jcmaster.c. It's split out because
linking this routine implies linking the entire compression library.
For a transcoding-only application, we want to be able to use jcmaster.c
without linking in the whole library. }
interface
{$I imjconfig.inc}
uses
imjinclude,
imjdeferr,
imjerror,
imjpeglib,
{$ifdef C_PROGRESSIVE_SUPPORTED}
imjcphuff,
{$endif}
imjchuff, imjcmaster, imjccolor, imjcsample, imjcprepct,
imjcdctmgr, imjccoefct, imjcmainct, imjcmarker;
{ Master selection of compression modules.
This is done once at the start of processing an image. We determine
which modules will be used and give them appropriate initialization calls. }
{GLOBAL}
procedure jinit_compress_master (cinfo : j_compress_ptr);
implementation
{ Master selection of compression modules.
This is done once at the start of processing an image. We determine
which modules will be used and give them appropriate initialization calls. }
{GLOBAL}
procedure jinit_compress_master (cinfo : j_compress_ptr);
begin
{ Initialize master control (includes parameter checking/processing) }
jinit_c_master_control(cinfo, FALSE { full compression });
{ Preprocessing }
if (not cinfo^.raw_data_in) then
begin
jinit_color_converter(cinfo);
jinit_downsampler(cinfo);
jinit_c_prep_controller(cinfo, FALSE { never need full buffer here });
end;
{ Forward DCT }
jinit_forward_dct(cinfo);
{ Entropy encoding: either Huffman or arithmetic coding. }
if (cinfo^.arith_code) then
begin
ERREXIT(j_common_ptr(cinfo), JERR_ARITH_NOTIMPL);
end
else
begin
if (cinfo^.progressive_mode) then
begin
{$ifdef C_PROGRESSIVE_SUPPORTED}
jinit_phuff_encoder(cinfo);
{$else}
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
{$endif}
end
else
jinit_huff_encoder(cinfo);
end;
{ Need a full-image coefficient buffer in any multi-pass mode. }
jinit_c_coef_controller(cinfo,
(cinfo^.num_scans > 1) or (cinfo^.optimize_coding));
jinit_c_main_controller(cinfo, FALSE { never need full buffer here });
jinit_marker_writer(cinfo);
{ We can now tell the memory manager to allocate virtual arrays. }
cinfo^.mem^.realize_virt_arrays (j_common_ptr(cinfo));
{ Write the datastream header (SOI) immediately.
Frame and scan headers are postponed till later.
This lets application insert special markers after the SOI. }
cinfo^.marker^.write_file_header (cinfo);
end;
end.
unit imjcinit;
{ Original: jcinit.c ; Copyright (C) 1991-1997, Thomas G. Lane. }
{ This file contains initialization logic for the JPEG compressor.
This routine is in charge of selecting the modules to be executed and
making an initialization call to each one.
Logically, this code belongs in jcmaster.c. It's split out because
linking this routine implies linking the entire compression library.
For a transcoding-only application, we want to be able to use jcmaster.c
without linking in the whole library. }
interface
{$I imjconfig.inc}
uses
imjinclude,
imjdeferr,
imjerror,
imjpeglib,
{$ifdef C_PROGRESSIVE_SUPPORTED}
imjcphuff,
{$endif}
imjchuff, imjcmaster, imjccolor, imjcsample, imjcprepct,
imjcdctmgr, imjccoefct, imjcmainct, imjcmarker;
{ Master selection of compression modules.
This is done once at the start of processing an image. We determine
which modules will be used and give them appropriate initialization calls. }
{GLOBAL}
procedure jinit_compress_master (cinfo : j_compress_ptr);
implementation
{ Master selection of compression modules.
This is done once at the start of processing an image. We determine
which modules will be used and give them appropriate initialization calls. }
{GLOBAL}
procedure jinit_compress_master (cinfo : j_compress_ptr);
begin
{ Initialize master control (includes parameter checking/processing) }
jinit_c_master_control(cinfo, FALSE { full compression });
{ Preprocessing }
if (not cinfo^.raw_data_in) then
begin
jinit_color_converter(cinfo);
jinit_downsampler(cinfo);
jinit_c_prep_controller(cinfo, FALSE { never need full buffer here });
end;
{ Forward DCT }
jinit_forward_dct(cinfo);
{ Entropy encoding: either Huffman or arithmetic coding. }
if (cinfo^.arith_code) then
begin
ERREXIT(j_common_ptr(cinfo), JERR_ARITH_NOTIMPL);
end
else
begin
if (cinfo^.progressive_mode) then
begin
{$ifdef C_PROGRESSIVE_SUPPORTED}
jinit_phuff_encoder(cinfo);
{$else}
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
{$endif}
end
else
jinit_huff_encoder(cinfo);
end;
{ Need a full-image coefficient buffer in any multi-pass mode. }
jinit_c_coef_controller(cinfo,
(cinfo^.num_scans > 1) or (cinfo^.optimize_coding));
jinit_c_main_controller(cinfo, FALSE { never need full buffer here });
jinit_marker_writer(cinfo);
{ We can now tell the memory manager to allocate virtual arrays. }
cinfo^.mem^.realize_virt_arrays (j_common_ptr(cinfo));
{ Write the datastream header (SOI) immediately.
Frame and scan headers are postponed till later.
This lets application insert special markers after the SOI. }
cinfo^.marker^.write_file_header (cinfo);
end;
end.

686
Imaging/JpegLib/imjcmainct.pas
View File

@ -1,343 +1,343 @@
unit imjcmainct;
{ This file contains the main buffer controller for compression.
The main buffer lies between the pre-processor and the JPEG
compressor proper; it holds downsampled data in the JPEG colorspace. }
{ Original : jcmainct.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
interface
{$I imjconfig.inc}
{ 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
"raw data" input, since this module is bypassed in that case. However,
we've left the code here for possible use in special applications. }
{$undef FULL_MAIN_BUFFER_SUPPORTED}
uses
imjmorecfg,
imjinclude,
imjdeferr,
imjerror,
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
imjutils,
{$endif}
imjpeglib;
{ Initialize main buffer controller. }
{GLOBAL}
procedure jinit_c_main_controller (cinfo : j_compress_ptr;
need_full_buffer : boolean);
implementation
{ Private buffer controller object }
type
my_main_ptr = ^my_main_controller;
my_main_controller = record
pub : jpeg_c_main_controller; { public fields }
cur_iMCU_row : JDIMENSION; { number of current iMCU row }
rowgroup_ctr : JDIMENSION; { counts row groups received in iMCU row }
suspended : boolean; { remember if we suspended output }
pass_mode : J_BUF_MODE; { current operating mode }
{ 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
points to the currently accessible strips of the virtual arrays. }
buffer : array[0..MAX_COMPONENTS-1] of JSAMPARRAY;
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
{ If using full-image storage, this array holds pointers to virtual-array
control blocks for each component. Unused if not full-image storage. }
whole_image : array[0..MAX_COMPONENTS-1] of jvirt_sarray_ptr;
{$endif}
end; {my_main_controller}
{ Forward declarations }
{METHODDEF}
procedure process_data_simple_main(cinfo : j_compress_ptr;
input_buf : JSAMPARRAY;
var in_row_ctr: JDIMENSION;
in_rows_avail : JDIMENSION); forward;
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
{METHODDEF}
procedure process_data_buffer_main(cinfo : j_compress_ptr;
input_buf : JSAMPARRAY;
var in_row_ctr : JDIMENSION;
in_rows_avail : JDIMENSION); forward;
{$endif}
{ Initialize for a processing pass. }
{METHODDEF}
procedure start_pass_main (cinfo : j_compress_ptr;
pass_mode : J_BUF_MODE);
var
main : my_main_ptr;
begin
main := my_main_ptr (cinfo^.main);
{ Do nothing in raw-data mode. }
if (cinfo^.raw_data_in) then
exit;
main^.cur_iMCU_row := 0; { initialize counters }
main^.rowgroup_ctr := 0;
main^.suspended := FALSE;
main^.pass_mode := pass_mode; { save mode for use by process_data }
case (pass_mode) of
JBUF_PASS_THRU:
begin
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
if (main^.whole_image[0] <> NIL) then
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
{$endif}
main^.pub.process_data := process_data_simple_main;
end;
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
JBUF_SAVE_SOURCE,
JBUF_CRANK_DEST,
JBUF_SAVE_AND_PASS:
begin
if (main^.whole_image[0] = NIL) then
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
main^.pub.process_data := process_data_buffer_main;
end;
{$endif}
else
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
end;
end;
{ Process some data.
This routine handles the simple pass-through mode,
where we have only a strip buffer. }
{METHODDEF}
procedure process_data_simple_main (cinfo : j_compress_ptr;
input_buf : JSAMPARRAY;
var in_row_ctr : JDIMENSION;
in_rows_avail : JDIMENSION);
var
main : my_main_ptr;
begin
main := my_main_ptr (cinfo^.main);
while (main^.cur_iMCU_row < cinfo^.total_iMCU_rows) do
begin
{ Read input data if we haven't filled the main buffer yet }
if (main^.rowgroup_ctr < DCTSIZE) then
cinfo^.prep^.pre_process_data (cinfo,
input_buf,
in_row_ctr,
in_rows_avail,
JSAMPIMAGE(@main^.buffer),
main^.rowgroup_ctr,
JDIMENSION(DCTSIZE));
{ 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
at the bottom of the image. }
if (main^.rowgroup_ctr <> DCTSIZE) then
exit;
{ Send the completed row to the compressor }
if (not cinfo^.coef^.compress_data (cinfo, JSAMPIMAGE(@main^.buffer))) then
begin
{ If compressor did not consume the whole row, then we must need to
suspend processing and return to the application. In this situation
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
think we were done. }
if (not main^.suspended) then
begin
Dec(in_row_ctr);
main^.suspended := TRUE;
end;
exit;
end;
{ We did finish the row. Undo our little suspension hack if a previous
call suspended; then mark the main buffer empty. }
if (main^.suspended) then
begin
Inc(in_row_ctr);
main^.suspended := FALSE;
end;
main^.rowgroup_ctr := 0;
Inc(main^.cur_iMCU_row);
end;
end;
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
{ Process some data.
This routine handles all of the modes that use a full-size buffer. }
{METHODDEF}
procedure process_data_buffer_main (cinfo : j_compress_ptr;
input_buf : JSAMPARRAY;
var in_row_ctr : JDIMENSION;
in_rows_avail : JDIMENSION);
var
main : my_main_ptr;
ci : int;
compptr : jpeg_component_info_ptr;
writing : boolean;
begin
main := my_main_ptr (cinfo^.main);
writing := (main^.pass_mode <> JBUF_CRANK_DEST);
while (main^.cur_iMCU_row < cinfo^.total_iMCU_rows) do
begin
{ Realign the virtual buffers if at the start of an iMCU row. }
if (main^.rowgroup_ctr = 0) then
begin
compptr := cinfo^.comp_info;
for ci := 0 to pred(cinfo^.num_components) do
begin
main^.buffer[ci] := cinfo^.mem^.access_virt_sarray
(j_common_ptr (cinfo), main^.whole_image[ci],
main^.cur_iMCU_row * (compptr^.v_samp_factor * DCTSIZE),
JDIMENSION (compptr^.v_samp_factor * DCTSIZE), writing);
Inc(compptr);
end;
{ In a read pass, pretend we just read some source data. }
if (not writing) then
begin
Inc(in_row_ctr, cinfo^.max_v_samp_factor * DCTSIZE);
main^.rowgroup_ctr := DCTSIZE;
end;
end;
{ 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. }
if (writing) then
begin
cinfo^.prep^.pre_process_data (cinfo,
input_buf, in_row_ctr, in_rows_avail,
JSAMPIMAGE(@main^.buffer),
main^.rowgroup_ctr,
JDIMENSION (DCTSIZE));
{ Return to application if we need more data to fill the iMCU row. }
if (main^.rowgroup_ctr < DCTSIZE) then
exit;
end;
{ Emit data, unless this is a sink-only pass. }
if (main^.pass_mode <> JBUF_SAVE_SOURCE) then
begin
if (not cinfo^.coef^.compress_data (cinfo,
JSAMPIMAGE(@main^.buffer))) then
begin
{ If compressor did not consume the whole row, then we must need to
suspend processing and return to the application. In this situation
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
think we were done. }
if (not main^.suspended) then
begin
Dec(in_row_ctr);
main^.suspended := TRUE;
end;
exit;
end;
{ We did finish the row. Undo our little suspension hack if a previous
call suspended; then mark the main buffer empty. }
if (main^.suspended) then
begin
Inc(in_row_ctr);
main^.suspended := FALSE;
end;
end;
{ If get here, we are done with this iMCU row. Mark buffer empty. }
main^.rowgroup_ctr := 0;
Inc(main^.cur_iMCU_row);
end;
end;
{$endif} { FULL_MAIN_BUFFER_SUPPORTED }
{ Initialize main buffer controller. }
{GLOBAL}
procedure jinit_c_main_controller (cinfo : j_compress_ptr;
need_full_buffer : boolean);
var
main : my_main_ptr;
ci : int;
compptr : jpeg_component_info_ptr;
begin
main := my_main_ptr(
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
SIZEOF(my_main_controller)) );
cinfo^.main := jpeg_c_main_controller_ptr(main);
main^.pub.start_pass := start_pass_main;
{ We don't need to create a buffer in raw-data mode. }
if (cinfo^.raw_data_in) then
exit;
{ Create the buffer. It holds downsampled data, so each component
may be of a different size. }
if (need_full_buffer) then
begin
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
{ Allocate a full-image virtual array for each component }
{ Note we pad the bottom to a multiple of the iMCU height }
compptr := cinfo^.comp_info;
for ci := 0 to pred(cinfo^.num_components) do
begin
main^.whole_image[ci] := cinfo^.mem^.request_virt_sarray
(j_common_ptr(cinfo), JPOOL_IMAGE, FALSE,
compptr^.width_in_blocks * DCTSIZE,
JDIMENSION (jround_up( long (compptr^.height_in_blocks),
long (compptr^.v_samp_factor)) * DCTSIZE),
JDIMENSION (compptr^.v_samp_factor * DCTSIZE));
Inc(compptr);
end;
{$else}
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
{$endif}
end
else
begin
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
main^.whole_image[0] := NIL; { flag for no virtual arrays }
{$endif}
{ Allocate a strip buffer for each component }
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
for ci := 0 to pred(cinfo^.num_components) do
begin
main^.buffer[ci] := cinfo^.mem^.alloc_sarray
(j_common_ptr(cinfo), JPOOL_IMAGE,
compptr^.width_in_blocks * DCTSIZE,
JDIMENSION (compptr^.v_samp_factor * DCTSIZE));
Inc(compptr);
end;
end;
end;
end.
unit imjcmainct;
{ This file contains the main buffer controller for compression.
The main buffer lies between the pre-processor and the JPEG
compressor proper; it holds downsampled data in the JPEG colorspace. }
{ Original : jcmainct.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
interface
{$I imjconfig.inc}
{ 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
"raw data" input, since this module is bypassed in that case. However,
we've left the code here for possible use in special applications. }
{$undef FULL_MAIN_BUFFER_SUPPORTED}
uses
imjmorecfg,
imjinclude,
imjdeferr,
imjerror,
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
imjutils,
{$endif}
imjpeglib;
{ Initialize main buffer controller. }
{GLOBAL}
procedure jinit_c_main_controller (cinfo : j_compress_ptr;
need_full_buffer : boolean);
implementation
{ Private buffer controller object }
type
my_main_ptr = ^my_main_controller;
my_main_controller = record
pub : jpeg_c_main_controller; { public fields }
cur_iMCU_row : JDIMENSION; { number of current iMCU row }
rowgroup_ctr : JDIMENSION; { counts row groups received in iMCU row }
suspended : boolean; { remember if we suspended output }
pass_mode : J_BUF_MODE; { current operating mode }
{ 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
points to the currently accessible strips of the virtual arrays. }
buffer : array[0..MAX_COMPONENTS-1] of JSAMPARRAY;
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
{ If using full-image storage, this array holds pointers to virtual-array
control blocks for each component. Unused if not full-image storage. }
whole_image : array[0..MAX_COMPONENTS-1] of jvirt_sarray_ptr;
{$endif}
end; {my_main_controller}
{ Forward declarations }
{METHODDEF}
procedure process_data_simple_main(cinfo : j_compress_ptr;
input_buf : JSAMPARRAY;
var in_row_ctr: JDIMENSION;
in_rows_avail : JDIMENSION); forward;
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
{METHODDEF}
procedure process_data_buffer_main(cinfo : j_compress_ptr;
input_buf : JSAMPARRAY;
var in_row_ctr : JDIMENSION;
in_rows_avail : JDIMENSION); forward;
{$endif}
{ Initialize for a processing pass. }
{METHODDEF}
procedure start_pass_main (cinfo : j_compress_ptr;
pass_mode : J_BUF_MODE);
var
main : my_main_ptr;
begin
main := my_main_ptr (cinfo^.main);
{ Do nothing in raw-data mode. }
if (cinfo^.raw_data_in) then
exit;
main^.cur_iMCU_row := 0; { initialize counters }
main^.rowgroup_ctr := 0;
main^.suspended := FALSE;
main^.pass_mode := pass_mode; { save mode for use by process_data }
case (pass_mode) of
JBUF_PASS_THRU:
begin
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
if (main^.whole_image[0] <> NIL) then
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
{$endif}
main^.pub.process_data := process_data_simple_main;
end;
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
JBUF_SAVE_SOURCE,
JBUF_CRANK_DEST,
JBUF_SAVE_AND_PASS:
begin
if (main^.whole_image[0] = NIL) then
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
main^.pub.process_data := process_data_buffer_main;
end;
{$endif}
else
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
end;
end;
{ Process some data.
This routine handles the simple pass-through mode,
where we have only a strip buffer. }
{METHODDEF}
procedure process_data_simple_main (cinfo : j_compress_ptr;
input_buf : JSAMPARRAY;
var in_row_ctr : JDIMENSION;
in_rows_avail : JDIMENSION);
var
main : my_main_ptr;
begin
main := my_main_ptr (cinfo^.main);
while (main^.cur_iMCU_row < cinfo^.total_iMCU_rows) do
begin
{ Read input data if we haven't filled the main buffer yet }
if (main^.rowgroup_ctr < DCTSIZE) then
cinfo^.prep^.pre_process_data (cinfo,
input_buf,
in_row_ctr,
in_rows_avail,
JSAMPIMAGE(@main^.buffer),
main^.rowgroup_ctr,
JDIMENSION(DCTSIZE));
{ 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
at the bottom of the image. }
if (main^.rowgroup_ctr <> DCTSIZE) then
exit;
{ Send the completed row to the compressor }
if (not cinfo^.coef^.compress_data (cinfo, JSAMPIMAGE(@main^.buffer))) then
begin
{ If compressor did not consume the whole row, then we must need to
suspend processing and return to the application. In this situation
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
think we were done. }
if (not main^.suspended) then
begin
Dec(in_row_ctr);
main^.suspended := TRUE;
end;
exit;
end;
{ We did finish the row. Undo our little suspension hack if a previous
call suspended; then mark the main buffer empty. }
if (main^.suspended) then
begin
Inc(in_row_ctr);
main^.suspended := FALSE;
end;
main^.rowgroup_ctr := 0;
Inc(main^.cur_iMCU_row);
end;
end;
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
{ Process some data.
This routine handles all of the modes that use a full-size buffer. }
{METHODDEF}
procedure process_data_buffer_main (cinfo : j_compress_ptr;
input_buf : JSAMPARRAY;
var in_row_ctr : JDIMENSION;
in_rows_avail : JDIMENSION);
var
main : my_main_ptr;
ci : int;
compptr : jpeg_component_info_ptr;
writing : boolean;
begin
main := my_main_ptr (cinfo^.main);
writing := (main^.pass_mode <> JBUF_CRANK_DEST);
while (main^.cur_iMCU_row < cinfo^.total_iMCU_rows) do
begin
{ Realign the virtual buffers if at the start of an iMCU row. }
if (main^.rowgroup_ctr = 0) then
begin
compptr := cinfo^.comp_info;
for ci := 0 to pred(cinfo^.num_components) do
begin
main^.buffer[ci] := cinfo^.mem^.access_virt_sarray
(j_common_ptr (cinfo), main^.whole_image[ci],
main^.cur_iMCU_row * (compptr^.v_samp_factor * DCTSIZE),
JDIMENSION (compptr^.v_samp_factor * DCTSIZE), writing);
Inc(compptr);
end;
{ In a read pass, pretend we just read some source data. }
if (not writing) then
begin
Inc(in_row_ctr, cinfo^.max_v_samp_factor * DCTSIZE);
main^.rowgroup_ctr := DCTSIZE;
end;
end;
{ 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. }
if (writing) then
begin
cinfo^.prep^.pre_process_data (cinfo,
input_buf, in_row_ctr, in_rows_avail,
JSAMPIMAGE(@main^.buffer),
main^.rowgroup_ctr,
JDIMENSION (DCTSIZE));
{ Return to application if we need more data to fill the iMCU row. }
if (main^.rowgroup_ctr < DCTSIZE) then
exit;
end;
{ Emit data, unless this is a sink-only pass. }
if (main^.pass_mode <> JBUF_SAVE_SOURCE) then
begin
if (not cinfo^.coef^.compress_data (cinfo,
JSAMPIMAGE(@main^.buffer))) then
begin
{ If compressor did not consume the whole row, then we must need to
suspend processing and return to the application. In this situation
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
think we were done. }
if (not main^.suspended) then
begin
Dec(in_row_ctr);
main^.suspended := TRUE;
end;
exit;
end;
{ We did finish the row. Undo our little suspension hack if a previous
call suspended; then mark the main buffer empty. }
if (main^.suspended) then
begin
Inc(in_row_ctr);
main^.suspended := FALSE;
end;
end;
{ If get here, we are done with this iMCU row. Mark buffer empty. }
main^.rowgroup_ctr := 0;
Inc(main^.cur_iMCU_row);
end;
end;
{$endif} { FULL_MAIN_BUFFER_SUPPORTED }
{ Initialize main buffer controller. }
{GLOBAL}
procedure jinit_c_main_controller (cinfo : j_compress_ptr;
need_full_buffer : boolean);
var
main : my_main_ptr;
ci : int;
compptr : jpeg_component_info_ptr;
begin
main := my_main_ptr(
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
SIZEOF(my_main_controller)) );
cinfo^.main := jpeg_c_main_controller_ptr(main);
main^.pub.start_pass := start_pass_main;
{ We don't need to create a buffer in raw-data mode. }
if (cinfo^.raw_data_in) then
exit;
{ Create the buffer. It holds downsampled data, so each component
may be of a different size. }
if (need_full_buffer) then
begin
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
{ Allocate a full-image virtual array for each component }
{ Note we pad the bottom to a multiple of the iMCU height }
compptr := cinfo^.comp_info;
for ci := 0 to pred(cinfo^.num_components) do
begin
main^.whole_image[ci] := cinfo^.mem^.request_virt_sarray
(j_common_ptr(cinfo), JPOOL_IMAGE, FALSE,
compptr^.width_in_blocks * DCTSIZE,
JDIMENSION (jround_up( long (compptr^.height_in_blocks),
long (compptr^.v_samp_factor)) * DCTSIZE),
JDIMENSION (compptr^.v_samp_factor * DCTSIZE));
Inc(compptr);
end;
{$else}
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
{$endif}
end
else
begin
{$ifdef FULL_MAIN_BUFFER_SUPPORTED}
main^.whole_image[0] := NIL; { flag for no virtual arrays }
{$endif}
{ Allocate a strip buffer for each component }
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
for ci := 0 to pred(cinfo^.num_components) do
begin
main^.buffer[ci] := cinfo^.mem^.alloc_sarray
(j_common_ptr(cinfo), JPOOL_IMAGE,
compptr^.width_in_blocks * DCTSIZE,
JDIMENSION (compptr^.v_samp_factor * DCTSIZE));
Inc(compptr);
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;
{ This file contains application interface routines that are used for both
compression and decompression. }
{ Original: jcomapi.c; Copyright (C) 1994-1997, Thomas G. Lane. }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjinclude,
imjpeglib;
{ Abort processing of a JPEG compression or decompression operation,
but don't destroy the object itself. }
{GLOBAL}
procedure jpeg_abort (cinfo : j_common_ptr);
{ Destruction of a JPEG object. }
{GLOBAL}
procedure jpeg_destroy (cinfo : j_common_ptr);
{GLOBAL}
function jpeg_alloc_quant_table (cinfo : j_common_ptr) : JQUANT_TBL_PTR;
{GLOBAL}
function jpeg_alloc_huff_table (cinfo : j_common_ptr) : JHUFF_TBL_PTR;
implementation
{ Abort processing of a JPEG compression or decompression operation,
but don't destroy the object itself.
For this, we merely clean up all the nonpermanent memory pools.
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.
Closing a data source or destination, if necessary, is the application's
responsibility. }
{GLOBAL}
procedure jpeg_abort (cinfo : j_common_ptr);
var
pool : int;
begin
{ Do nothing if called on a not-initialized or destroyed JPEG object. }
if (cinfo^.mem = NIL) then
exit;
{ Releasing pools in reverse order might help avoid fragmentation
with some (brain-damaged) malloc libraries. }
for pool := JPOOL_NUMPOOLS-1 downto JPOOL_PERMANENT+1 do
begin
cinfo^.mem^.free_pool (cinfo, pool);
end;
{ Reset overall state for possible reuse of object }
if (cinfo^.is_decompressor) then
begin
cinfo^.global_state := DSTATE_START;
{ Try to keep application from accessing now-deleted marker list.
A bit kludgy to do it here, but this is the most central place. }
j_decompress_ptr(cinfo)^.marker_list := NIL;
end
else
begin
cinfo^.global_state := CSTATE_START;
end;
end;
{ Destruction of a JPEG object.
Everything gets deallocated except the master jpeg_compress_struct itself
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
the stack and so don't need to be freed anyway.)
Closing a data source or destination, if necessary, is the application's
responsibility. }
{GLOBAL}
procedure jpeg_destroy (cinfo : j_common_ptr);
begin
{ We need only tell the memory manager to release everything. }
{ NB: mem pointer is NIL if memory mgr failed to initialize. }
if (cinfo^.mem <> NIL) then
cinfo^.mem^.self_destruct (cinfo);
cinfo^.mem := NIL; { be safe if jpeg_destroy is called twice }
cinfo^.global_state := 0; { mark it destroyed }
end;
{ Convenience routines for allocating quantization and Huffman tables.
(Would jutils.c be a more reasonable place to put these?) }
{GLOBAL}
function jpeg_alloc_quant_table (cinfo : j_common_ptr) : JQUANT_TBL_PTR;
var
tbl : JQUANT_TBL_PTR;
begin
tbl := JQUANT_TBL_PTR(
cinfo^.mem^.alloc_small (cinfo, JPOOL_PERMANENT, SIZEOF(JQUANT_TBL))
);
tbl^.sent_table := FALSE; { make sure this is false in any new table }
jpeg_alloc_quant_table := tbl;
end;
{GLOBAL}
function jpeg_alloc_huff_table (cinfo : j_common_ptr) : JHUFF_TBL_PTR;
var
tbl : JHUFF_TBL_PTR;
begin
tbl := JHUFF_TBL_PTR(
cinfo^.mem^.alloc_small (cinfo, JPOOL_PERMANENT, SIZEOF(JHUFF_TBL))
);
tbl^.sent_table := FALSE; { make sure this is false in any new table }
jpeg_alloc_huff_table := tbl;
end;
end.
unit imjcomapi;
{ This file contains application interface routines that are used for both
compression and decompression. }
{ Original: jcomapi.c; Copyright (C) 1994-1997, Thomas G. Lane. }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjinclude,
imjpeglib;
{ Abort processing of a JPEG compression or decompression operation,
but don't destroy the object itself. }
{GLOBAL}
procedure jpeg_abort (cinfo : j_common_ptr);
{ Destruction of a JPEG object. }
{GLOBAL}
procedure jpeg_destroy (cinfo : j_common_ptr);
{GLOBAL}
function jpeg_alloc_quant_table (cinfo : j_common_ptr) : JQUANT_TBL_PTR;
{GLOBAL}
function jpeg_alloc_huff_table (cinfo : j_common_ptr) : JHUFF_TBL_PTR;
implementation
{ Abort processing of a JPEG compression or decompression operation,
but don't destroy the object itself.
For this, we merely clean up all the nonpermanent memory pools.
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.
Closing a data source or destination, if necessary, is the application's
responsibility. }
{GLOBAL}
procedure jpeg_abort (cinfo : j_common_ptr);
var
pool : int;
begin
{ Do nothing if called on a not-initialized or destroyed JPEG object. }
if (cinfo^.mem = NIL) then
exit;
{ Releasing pools in reverse order might help avoid fragmentation
with some (brain-damaged) malloc libraries. }
for pool := JPOOL_NUMPOOLS-1 downto JPOOL_PERMANENT+1 do
begin
cinfo^.mem^.free_pool (cinfo, pool);
end;
{ Reset overall state for possible reuse of object }
if (cinfo^.is_decompressor) then
begin
cinfo^.global_state := DSTATE_START;
{ Try to keep application from accessing now-deleted marker list.
A bit kludgy to do it here, but this is the most central place. }
j_decompress_ptr(cinfo)^.marker_list := NIL;
end
else
begin
cinfo^.global_state := CSTATE_START;
end;
end;
{ Destruction of a JPEG object.
Everything gets deallocated except the master jpeg_compress_struct itself
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
the stack and so don't need to be freed anyway.)
Closing a data source or destination, if necessary, is the application's
responsibility. }
{GLOBAL}
procedure jpeg_destroy (cinfo : j_common_ptr);
begin
{ We need only tell the memory manager to release everything. }
{ NB: mem pointer is NIL if memory mgr failed to initialize. }
if (cinfo^.mem <> NIL) then
cinfo^.mem^.self_destruct (cinfo);
cinfo^.mem := NIL; { be safe if jpeg_destroy is called twice }
cinfo^.global_state := 0; { mark it destroyed }
end;
{ Convenience routines for allocating quantization and Huffman tables.
(Would jutils.c be a more reasonable place to put these?) }
{GLOBAL}
function jpeg_alloc_quant_table (cinfo : j_common_ptr) : JQUANT_TBL_PTR;
var
tbl : JQUANT_TBL_PTR;
begin
tbl := JQUANT_TBL_PTR(
cinfo^.mem^.alloc_small (cinfo, JPOOL_PERMANENT, SIZEOF(JQUANT_TBL))
);
tbl^.sent_table := FALSE; { make sure this is false in any new table }
jpeg_alloc_quant_table := tbl;
end;
{GLOBAL}
function jpeg_alloc_huff_table (cinfo : j_common_ptr) : JHUFF_TBL_PTR;
var
tbl : JHUFF_TBL_PTR;
begin
tbl := JHUFF_TBL_PTR(
cinfo^.mem^.alloc_small (cinfo, JPOOL_PERMANENT, SIZEOF(JHUFF_TBL))
);
tbl^.sent_table := FALSE; { make sure this is false in any new table }
jpeg_alloc_huff_table := tbl;
end;
end.

250
Imaging/JpegLib/imjconfig.inc
View File

@ -1,124 +1,126 @@
{ ----------------------- JPEG_INTERNAL_OPTIONS ---------------------- }
{ These defines indicate whether to include various optional functions.
Undefining some of these symbols will produce a smaller but less capable
library. Note that you can leave certain source files out of the
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.)}
{ Arithmetic coding is unsupported for legal reasons. Complaints to IBM. }
{ Capability options common to encoder and decoder: }
{$define DCT_ISLOW_SUPPORTED} { slow but accurate integer algorithm }
{$define DCT_IFAST_SUPPORTED} { faster, less accurate integer method }
{$define DCT_FLOAT_SUPPORTED} { floating-point: accurate, fast on fast HW }
{ Encoder capability options: }
{$undef C_ARITH_CODING_SUPPORTED} { Arithmetic coding back end? }
{$define C_MULTISCAN_FILES_SUPPORTED} { Multiple-scan JPEG files? }
{$define C_PROGRESSIVE_SUPPORTED} { Progressive JPEG? (Requires MULTISCAN)}
{$define ENTROPY_OPT_SUPPORTED} { Optimization of entropy coding parms? }
{ 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
precision, so jchuff.c normally uses entropy optimization to compute
usable tables for higher precision. If you don't want to do optimization,
you'll have to supply different default Huffman tables.
The exact same statements apply for progressive JPEG: the default tables
don't work for progressive mode. (This may get fixed, however.) }
{$define INPUT_SMOOTHING_SUPPORTED} { Input image smoothing option? }
{ Decoder capability options: }
{$undef D_ARITH_CODING_SUPPORTED} { Arithmetic coding back end? }
{$define D_MULTISCAN_FILES_SUPPORTED} { Multiple-scan JPEG files? }
{$define D_PROGRESSIVE_SUPPORTED} { Progressive JPEG? (Requires MULTISCAN)}
{$define SAVE_MARKERS_SUPPORTED} { jpeg_save_markers() needed? }
{$define BLOCK_SMOOTHING_SUPPORTED} { Block smoothing? (Progressive only) }
{$define IDCT_SCALING_SUPPORTED} { Output rescaling via IDCT? }
{$undef UPSAMPLE_SCALING_SUPPORTED} { Output rescaling at upsample stage? }
{$define UPSAMPLE_MERGING_SUPPORTED} { Fast path for sloppy upsampling? }
{$define QUANT_1PASS_SUPPORTED} { 1-pass color quantization? }
{$define QUANT_2PASS_SUPPORTED} { 2-pass color quantization? }
{ If you happen not to want the image transform support, disable it here }
{$define TRANSFORMS_SUPPORTED}
{ more capability options later, no doubt }
{$ifopt I+} {$define IOcheck} {$endif}
{ ------------------------------------------------------------------------ }
{$define USE_FMEM} { Borland has _fmemcpy() and _fmemset() }
{$define FMEMCOPY}
{$define FMEMZERO}
{$define DCTSIZE_IS_8} { e.g. unroll the inner loop }
{$define RIGHT_SHIFT_IS_UNSIGNED}
{$undef AVOID_TABLES}
{$undef FAST_DIVIDE}
{$define BITS_IN_JSAMPLE_IS_8}
{----------------------------------------------------------------}
{ for test of 12 bit JPEG code only. !! }
{-- $undef BITS_IN_JSAMPLE_IS_8}
{----------------------------------------------------------------}
//{$define RGB_RED_IS_0}
{ !CHANGE: This must be defined for Delphi/Kylix/FPC }
{$define RGB_RED_IS_2} { RGB byte order }
{$define RGB_PIXELSIZE_IS_3}
{$define SLOW_SHIFT_32}
{$undef NO_ZERO_ROW_TEST}
{$define USE_MSDOS_MEMMGR} { Define this if you use jmemdos.c }
{$define XMS_SUPPORTED}
{$define EMS_SUPPORTED}
{$undef MEM_STATS} { Write out memory usage }
{$define AM_MEMORY_MANAGER} { we define jvirt_Xarray_control structs }
{$undef FULL_MAIN_BUFFER_SUPPORTED}
{$define PROGRESS_REPORT}
{$define TWO_FILE_COMMANDLINE}
{$undef BMP_SUPPORTED}
{$undef PPM_SUPPORTED}
{$undef GIF_SUPPORTED}
{$undef RLE_SUPPORTED}
{$undef TARGA_SUPPORTED}
{$define EXT_SWITCH}
{$ifndef BITS_IN_JSAMPLE_IS_8} { for 12 bit samples }
{$undef BMP_SUPPORTED}
{$undef RLE_SUPPORTED}
{$undef TARGA_SUPPORTED}
{$endif}
{!CHANGE: Allowed only for Delphi}
{$undef BASM16} { for TP7 - use BASM for fast multiply }
{$ifdef Win32}
{$ifndef FPC}
{$define BASM} { jidctint with BASM for Delphi 2/3 }
{$undef RGB_RED_IS_0} { BGR byte order in JQUANT2 }
{$endif}
{$endif}
{$ifdef FPC}
{$MODE DELPHI}
{$endif}
{!CHANGE: Added this}
{$define Delphi_Stream}
{$Q-}
{ ----------------------- JPEG_INTERNAL_OPTIONS ---------------------- }
{ These defines indicate whether to include various optional functions.
Undefining some of these symbols will produce a smaller but less capable
library. Note that you can leave certain source files out of the
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.)}
{ Arithmetic coding is unsupported for legal reasons. Complaints to IBM. }
{ Capability options common to encoder and decoder: }
{$define DCT_ISLOW_SUPPORTED} { slow but accurate integer algorithm }
{$define DCT_IFAST_SUPPORTED} { faster, less accurate integer method }
{$define DCT_FLOAT_SUPPORTED} { floating-point: accurate, fast on fast HW }
{ Encoder capability options: }
{$undef C_ARITH_CODING_SUPPORTED} { Arithmetic coding back end? }
{$define C_MULTISCAN_FILES_SUPPORTED} { Multiple-scan JPEG files? }
{$define C_PROGRESSIVE_SUPPORTED} { Progressive JPEG? (Requires MULTISCAN)}
{$define ENTROPY_OPT_SUPPORTED} { Optimization of entropy coding parms? }
{ 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
precision, so jchuff.c normally uses entropy optimization to compute
usable tables for higher precision. If you don't want to do optimization,
you'll have to supply different default Huffman tables.
The exact same statements apply for progressive JPEG: the default tables
don't work for progressive mode. (This may get fixed, however.) }
{$define INPUT_SMOOTHING_SUPPORTED} { Input image smoothing option? }
{ Decoder capability options: }
{$undef D_ARITH_CODING_SUPPORTED} { Arithmetic coding back end? }
{$define D_MULTISCAN_FILES_SUPPORTED} { Multiple-scan JPEG files? }
{$define D_PROGRESSIVE_SUPPORTED} { Progressive JPEG? (Requires MULTISCAN)}
{$define SAVE_MARKERS_SUPPORTED} { jpeg_save_markers() needed? }
{$define BLOCK_SMOOTHING_SUPPORTED} { Block smoothing? (Progressive only) }
{$define IDCT_SCALING_SUPPORTED} { Output rescaling via IDCT? }
{$undef UPSAMPLE_SCALING_SUPPORTED} { Output rescaling at upsample stage? }
{$define UPSAMPLE_MERGING_SUPPORTED} { Fast path for sloppy upsampling? }
{$define QUANT_1PASS_SUPPORTED} { 1-pass color quantization? }
{$define QUANT_2PASS_SUPPORTED} { 2-pass color quantization? }
{ If you happen not to want the image transform support, disable it here }
{$define TRANSFORMS_SUPPORTED}
{ more capability options later, no doubt }
{$ifopt I+} {$define IOcheck} {$endif}
{ ------------------------------------------------------------------------ }
{$define USE_FMEM} { Borland has _fmemcpy() and _fmemset() }
{$define FMEMCOPY}
{$define FMEMZERO}
{$define DCTSIZE_IS_8} { e.g. unroll the inner loop }
{$define RIGHT_SHIFT_IS_UNSIGNED}
{$undef AVOID_TABLES}
{$undef FAST_DIVIDE}
{$define BITS_IN_JSAMPLE_IS_8}
{----------------------------------------------------------------}
{ for test of 12 bit JPEG code only. !! }
{-- $undef BITS_IN_JSAMPLE_IS_8}
{----------------------------------------------------------------}
//{$define RGB_RED_IS_0}
{ !CHANGE: This must be defined for Delphi/Kylix/FPC }
{$define RGB_RED_IS_2} { RGB byte order }
{$define RGB_PIXELSIZE_IS_3}
{$define SLOW_SHIFT_32}
{$undef NO_ZERO_ROW_TEST}
{$define USE_MSDOS_MEMMGR} { Define this if you use jmemdos.c }
{$define XMS_SUPPORTED}
{$define EMS_SUPPORTED}
{$undef MEM_STATS} { Write out memory usage }
{$define AM_MEMORY_MANAGER} { we define jvirt_Xarray_control structs }
{$undef FULL_MAIN_BUFFER_SUPPORTED}
{$define PROGRESS_REPORT}
{$define TWO_FILE_COMMANDLINE}
{$undef BMP_SUPPORTED}
{$undef PPM_SUPPORTED}
{$undef GIF_SUPPORTED}
{$undef RLE_SUPPORTED}
{$undef TARGA_SUPPORTED}
{$define EXT_SWITCH}
{$ifndef BITS_IN_JSAMPLE_IS_8} { for 12 bit samples }
{$undef BMP_SUPPORTED}
{$undef RLE_SUPPORTED}
{$undef TARGA_SUPPORTED}
{$endif}
{!CHANGE: Allowed only for Delphi}
{$undef BASM16} { for TP7 - use BASM for fast multiply }
{$ifdef Win32}
{$ifndef FPC}
{$define BASM} { jidctint with BASM for Delphi 2/3 }
{$undef RGB_RED_IS_0} { BGR byte order in JQUANT2 }
{$endif}
{$endif}
{$ifdef FPC}
{$MODE DELPHI}
{$endif}
{!CHANGE: Added this}
{$define Delphi_Stream}
{$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;
{ Original : jcprepct.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
{ This file contains the compression preprocessing controller.
This controller manages the color conversion, downsampling,
and edge expansion steps.
Most of the complexity here is associated with buffering input rows
as required by the downsampler. See the comments at the head of
jcsample.c for the downsampler's needs. }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjpeglib,
imjdeferr,
imjerror,
imjinclude,
imjutils;
{GLOBAL}
procedure jinit_c_prep_controller (cinfo : j_compress_ptr;
need_full_buffer : boolean);
implementation
{ At present, jcsample.c can request context rows only for smoothing.
In the future, we might also need context rows for CCIR601 sampling
or other more-complex downsampling procedures. The code to support
context rows should be compiled only if needed. }
{$ifdef INPUT_SMOOTHING_SUPPORTED}
{$define CONTEXT_ROWS_SUPPORTED}
{$endif}
{ 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
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
out to a full iMCU row.
When providing context rows, we must buffer three row groups' worth of
pixels. Three row groups are physically allocated, but the row pointer
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.
This allows the downsampler to access the proper context rows.
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
by pointer hacking as is done in jdmainct.c, but it doesn't seem worth the
trouble on the compression side. }
{ Private buffer controller object }
type
my_prep_ptr = ^my_prep_controller;
my_prep_controller = record
pub : jpeg_c_prep_controller; { public fields }
{ Downsampling input buffer. This buffer holds color-converted data
until we have enough to do a downsample step. }
color_buf : array[0..MAX_COMPONENTS-1] of JSAMPARRAY;
rows_to_go : JDIMENSION; { counts rows remaining in source image }
next_buf_row : int; { index of next row to store in color_buf }
{$ifdef CONTEXT_ROWS_SUPPORTED} { only needed for context case }
this_row_group : int; { starting row index of group to process }
next_buf_stop : int; { downsample when we reach this index }
{$endif}
end; {my_prep_controller;}
{ Initialize for a processing pass. }
{METHODDEF}
procedure start_pass_prep (cinfo : j_compress_ptr;
pass_mode : J_BUF_MODE );
var
prep : my_prep_ptr;
begin
prep := my_prep_ptr (cinfo^.prep);
if (pass_mode <> JBUF_PASS_THRU) then
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
{ Initialize total-height counter for detecting bottom of image }
prep^.rows_to_go := cinfo^.image_height;
{ Mark the conversion buffer empty }
prep^.next_buf_row := 0;
{$ifdef CONTEXT_ROWS_SUPPORTED}
{ Preset additional state variables for context mode.
These aren't used in non-context mode, so we needn't test which mode. }
prep^.this_row_group := 0;
{ Set next_buf_stop to stop after two row groups have been read in. }
prep^.next_buf_stop := 2 * cinfo^.max_v_samp_factor;
{$endif}
end;
{ Expand an image vertically from height input_rows to height output_rows,
by duplicating the bottom row. }
{LOCAL}
procedure expand_bottom_edge (image_data : JSAMPARRAY;
num_cols : JDIMENSION;
input_rows : int;
output_rows : int);
var
{register} row : int;
begin
for row := input_rows to pred(output_rows) do
begin
jcopy_sample_rows(image_data, input_rows-1, image_data, row,
1, num_cols);
end;
end;
{ Process some data in the simple no-context case.
Preprocessor output data is counted in "row groups". A row group
is defined to be v_samp_factor sample rows of each component.
Downsampling will produce this much data from each max_v_samp_factor
input rows. }
{METHODDEF}
procedure pre_process_data (cinfo : j_compress_ptr;
input_buf : JSAMPARRAY;
var in_row_ctr : JDIMENSION;
in_rows_avail : JDIMENSION;
output_buf : JSAMPIMAGE;
var out_row_group_ctr : JDIMENSION;
out_row_groups_avail : JDIMENSION);
var
prep : my_prep_ptr;
numrows, ci : int;
inrows : JDIMENSION;
compptr : jpeg_component_info_ptr;
var
local_input_buf : JSAMPARRAY;
begin
prep := my_prep_ptr (cinfo^.prep);
while (in_row_ctr < in_rows_avail) and
(out_row_group_ctr < out_row_groups_avail) do
begin
{ Do color conversion to fill the conversion buffer. }
inrows := in_rows_avail - in_row_ctr;
numrows := cinfo^.max_v_samp_factor - prep^.next_buf_row;
{numrows := int( MIN(JDIMENSION(numrows), inrows) );}
if inrows < JDIMENSION(numrows) then
numrows := int(inrows);
local_input_buf := JSAMPARRAY(@(input_buf^[in_row_ctr]));
cinfo^.cconvert^.color_convert (cinfo, local_input_buf,
JSAMPIMAGE(@prep^.color_buf),
JDIMENSION(prep^.next_buf_row),
numrows);
Inc(in_row_ctr, numrows);
Inc(prep^.next_buf_row, numrows);
Dec(prep^.rows_to_go, numrows);
{ If at bottom of image, pad to fill the conversion buffer. }
if (prep^.rows_to_go = 0) and
(prep^.next_buf_row < cinfo^.max_v_samp_factor) then
begin
for ci := 0 to pred(cinfo^.num_components) do
begin
expand_bottom_edge(prep^.color_buf[ci], cinfo^.image_width,
prep^.next_buf_row, cinfo^.max_v_samp_factor);
end;
prep^.next_buf_row := cinfo^.max_v_samp_factor;
end;
{ If we've filled the conversion buffer, empty it. }
if (prep^.next_buf_row = cinfo^.max_v_samp_factor) then
begin
cinfo^.downsample^.downsample (cinfo,
JSAMPIMAGE(@prep^.color_buf),
JDIMENSION (0),
output_buf,
out_row_group_ctr);
prep^.next_buf_row := 0;
Inc(out_row_group_ctr);;
end;
{ 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! }
if (prep^.rows_to_go = 0) and
(out_row_group_ctr < out_row_groups_avail) then
begin
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
for ci := 0 to pred(cinfo^.num_components) do
begin
expand_bottom_edge(output_buf^[ci],
compptr^.width_in_blocks * DCTSIZE,
int (out_row_group_ctr) * compptr^.v_samp_factor,
int (out_row_groups_avail) * compptr^.v_samp_factor);
Inc(compptr);
end;
out_row_group_ctr := out_row_groups_avail;
break; { can exit outer loop without test }
end;
end;
end;
{$ifdef CONTEXT_ROWS_SUPPORTED}
{ Process some data in the context case. }
{METHODDEF}
procedure pre_process_context (cinfo : j_compress_ptr;
input_buf : JSAMPARRAY;
var in_row_ctr : JDIMENSION;
in_rows_avail : JDIMENSION;
output_buf : JSAMPIMAGE;
var out_row_group_ctr : JDIMENSION;
out_row_groups_avail : JDIMENSION);
var
prep : my_prep_ptr;
numrows, ci : int;
buf_height : int;
inrows : JDIMENSION;
var
row : int;
begin
prep := my_prep_ptr (cinfo^.prep);
buf_height := cinfo^.max_v_samp_factor * 3;
while (out_row_group_ctr < out_row_groups_avail) do
begin
if (in_row_ctr < in_rows_avail) then
begin
{ Do color conversion to fill the conversion buffer. }
inrows := in_rows_avail - in_row_ctr;
numrows := prep^.next_buf_stop - prep^.next_buf_row;
{numrows := int ( MIN( JDIMENSION(numrows), inrows) );}
if inrows < JDIMENSION(numrows) then
numrows := int(inrows);
cinfo^.cconvert^.color_convert (cinfo,
JSAMPARRAY(@input_buf^[in_row_ctr]),
JSAMPIMAGE(@prep^.color_buf),
JDIMENSION (prep^.next_buf_row),
numrows);
{ Pad at top of image, if first time through }
if (prep^.rows_to_go = cinfo^.image_height) then
begin
for ci := 0 to pred(cinfo^.num_components) do
begin
for row := 1 to cinfo^.max_v_samp_factor do
begin
jcopy_sample_rows(prep^.color_buf[ci], 0,
prep^.color_buf[ci], -row,
1, cinfo^.image_width);
end;
end;
end;
Inc(in_row_ctr, numrows);
Inc(prep^.next_buf_row, numrows);
Dec(prep^.rows_to_go, numrows);
end
else
begin
{ Return for more data, unless we are at the bottom of the image. }
if (prep^.rows_to_go <> 0) then
break;
{ When at bottom of image, pad to fill the conversion buffer. }
if (prep^.next_buf_row < prep^.next_buf_stop) then
begin
for ci := 0 to pred(cinfo^.num_components) do
begin
expand_bottom_edge(prep^.color_buf[ci], cinfo^.image_width,
prep^.next_buf_row, prep^.next_buf_stop);
end;
prep^.next_buf_row := prep^.next_buf_stop;
end;
end;
{ If we've gotten enough data, downsample a row group. }
if (prep^.next_buf_row = prep^.next_buf_stop) then
begin
cinfo^.downsample^.downsample (cinfo,
JSAMPIMAGE(@prep^.color_buf),
JDIMENSION(prep^.this_row_group),
output_buf,
out_row_group_ctr);
Inc(out_row_group_ctr);
{ Advance pointers with wraparound as necessary. }
Inc(prep^.this_row_group, cinfo^.max_v_samp_factor);
if (prep^.this_row_group >= buf_height) then
prep^.this_row_group := 0;
if (prep^.next_buf_row >= buf_height) then
prep^.next_buf_row := 0;
prep^.next_buf_stop := prep^.next_buf_row + cinfo^.max_v_samp_factor;
end;
end;
end;
{ Create the wrapped-around downsampling input buffer needed for context mode. }
{LOCAL}
procedure create_context_buffer (cinfo : j_compress_ptr);
var
prep : my_prep_ptr;
rgroup_height : int;
ci, i : int;
compptr : jpeg_component_info_ptr;
true_buffer, fake_buffer : JSAMPARRAY;
begin
prep := my_prep_ptr (cinfo^.prep);
rgroup_height := cinfo^.max_v_samp_factor;
{ Grab enough space for fake row pointers for all the components;
we need five row groups' worth of pointers for each component. }
fake_buffer := JSAMPARRAY(
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
(cinfo^.num_components * 5 * rgroup_height) *
SIZEOF(JSAMPROW)) );
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
for ci := 0 to pred(cinfo^.num_components) do
begin
{ Allocate the actual buffer space (3 row groups) for this component.
We make the buffer wide enough to allow the downsampler to edge-expand
horizontally within the buffer, if it so chooses. }
true_buffer := cinfo^.mem^.alloc_sarray
(j_common_ptr(cinfo), JPOOL_IMAGE,
JDIMENSION (( long(compptr^.width_in_blocks) * DCTSIZE *
cinfo^.max_h_samp_factor) div compptr^.h_samp_factor),
JDIMENSION (3 * rgroup_height));
{ Copy true buffer row pointers into the middle of the fake row array }
MEMCOPY(JSAMPARRAY(@ fake_buffer^[rgroup_height]), true_buffer,
3 * rgroup_height * SIZEOF(JSAMPROW));
{ Fill in the above and below wraparound pointers }
for i := 0 to pred(rgroup_height) do
begin
fake_buffer^[i] := true_buffer^[2 * rgroup_height + i];
fake_buffer^[4 * rgroup_height + i] := true_buffer^[i];
end;
prep^.color_buf[ci] := JSAMPARRAY(@ fake_buffer^[rgroup_height]);
Inc(JSAMPROW_PTR(fake_buffer), 5 * rgroup_height); { point to space for next component }
Inc(compptr);
end;
end;
{$endif} { CONTEXT_ROWS_SUPPORTED }
{ Initialize preprocessing controller. }
{GLOBAL}
procedure jinit_c_prep_controller (cinfo : j_compress_ptr;
need_full_buffer : boolean);
var
prep : my_prep_ptr;
ci : int;
compptr : jpeg_component_info_ptr;
begin
if (need_full_buffer) then { safety check }
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
prep := my_prep_ptr(
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
SIZEOF(my_prep_controller)) );
cinfo^.prep := jpeg_c_prep_controller_ptr(prep);
prep^.pub.start_pass := start_pass_prep;
{ Allocate the color conversion buffer.
We make the buffer wide enough to allow the downsampler to edge-expand
horizontally within the buffer, if it so chooses. }
if (cinfo^.downsample^.need_context_rows) then
begin
{ Set up to provide context rows }
{$ifdef CONTEXT_ROWS_SUPPORTED}
prep^.pub.pre_process_data := pre_process_context;
create_context_buffer(cinfo);
{$else}
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
{$endif}
end
else
begin
{ No context, just make it tall enough for one row group }
prep^.pub.pre_process_data := pre_process_data;
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
for ci := 0 to pred(cinfo^.num_components) do
begin
prep^.color_buf[ci] := cinfo^.mem^.alloc_sarray
(j_common_ptr(cinfo), JPOOL_IMAGE,
JDIMENSION (( long(compptr^.width_in_blocks) * DCTSIZE *
cinfo^.max_h_samp_factor) div compptr^.h_samp_factor),
JDIMENSION(cinfo^.max_v_samp_factor) );
Inc(compptr);
end;
end;
end;
end.
unit imjcprepct;
{ Original : jcprepct.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
{ This file contains the compression preprocessing controller.
This controller manages the color conversion, downsampling,
and edge expansion steps.
Most of the complexity here is associated with buffering input rows
as required by the downsampler. See the comments at the head of
jcsample.c for the downsampler's needs. }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjpeglib,
imjdeferr,
imjerror,
imjinclude,
imjutils;
{GLOBAL}
procedure jinit_c_prep_controller (cinfo : j_compress_ptr;
need_full_buffer : boolean);
implementation
{ At present, jcsample.c can request context rows only for smoothing.
In the future, we might also need context rows for CCIR601 sampling
or other more-complex downsampling procedures. The code to support
context rows should be compiled only if needed. }
{$ifdef INPUT_SMOOTHING_SUPPORTED}
{$define CONTEXT_ROWS_SUPPORTED}
{$endif}
{ 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
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
out to a full iMCU row.
When providing context rows, we must buffer three row groups' worth of
pixels. Three row groups are physically allocated, but the row pointer
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.
This allows the downsampler to access the proper context rows.
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
by pointer hacking as is done in jdmainct.c, but it doesn't seem worth the
trouble on the compression side. }
{ Private buffer controller object }
type
my_prep_ptr = ^my_prep_controller;
my_prep_controller = record
pub : jpeg_c_prep_controller; { public fields }
{ Downsampling input buffer. This buffer holds color-converted data
until we have enough to do a downsample step. }
color_buf : array[0..MAX_COMPONENTS-1] of JSAMPARRAY;
rows_to_go : JDIMENSION; { counts rows remaining in source image }
next_buf_row : int; { index of next row to store in color_buf }
{$ifdef CONTEXT_ROWS_SUPPORTED} { only needed for context case }
this_row_group : int; { starting row index of group to process }
next_buf_stop : int; { downsample when we reach this index }
{$endif}
end; {my_prep_controller;}
{ Initialize for a processing pass. }
{METHODDEF}
procedure start_pass_prep (cinfo : j_compress_ptr;
pass_mode : J_BUF_MODE );
var
prep : my_prep_ptr;
begin
prep := my_prep_ptr (cinfo^.prep);
if (pass_mode <> JBUF_PASS_THRU) then
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
{ Initialize total-height counter for detecting bottom of image }
prep^.rows_to_go := cinfo^.image_height;
{ Mark the conversion buffer empty }
prep^.next_buf_row := 0;
{$ifdef CONTEXT_ROWS_SUPPORTED}
{ Preset additional state variables for context mode.
These aren't used in non-context mode, so we needn't test which mode. }
prep^.this_row_group := 0;
{ Set next_buf_stop to stop after two row groups have been read in. }
prep^.next_buf_stop := 2 * cinfo^.max_v_samp_factor;
{$endif}
end;
{ Expand an image vertically from height input_rows to height output_rows,
by duplicating the bottom row. }
{LOCAL}
procedure expand_bottom_edge (image_data : JSAMPARRAY;
num_cols : JDIMENSION;
input_rows : int;
output_rows : int);
var
{register} row : int;
begin
for row := input_rows to pred(output_rows) do
begin
jcopy_sample_rows(image_data, input_rows-1, image_data, row,
1, num_cols);
end;
end;
{ Process some data in the simple no-context case.
Preprocessor output data is counted in "row groups". A row group
is defined to be v_samp_factor sample rows of each component.
Downsampling will produce this much data from each max_v_samp_factor
input rows. }
{METHODDEF}
procedure pre_process_data (cinfo : j_compress_ptr;
input_buf : JSAMPARRAY;
var in_row_ctr : JDIMENSION;
in_rows_avail : JDIMENSION;
output_buf : JSAMPIMAGE;
var out_row_group_ctr : JDIMENSION;
out_row_groups_avail : JDIMENSION);
var
prep : my_prep_ptr;
numrows, ci : int;
inrows : JDIMENSION;
compptr : jpeg_component_info_ptr;
var
local_input_buf : JSAMPARRAY;
begin
prep := my_prep_ptr (cinfo^.prep);
while (in_row_ctr < in_rows_avail) and
(out_row_group_ctr < out_row_groups_avail) do
begin
{ Do color conversion to fill the conversion buffer. }
inrows := in_rows_avail - in_row_ctr;
numrows := cinfo^.max_v_samp_factor - prep^.next_buf_row;
{numrows := int( MIN(JDIMENSION(numrows), inrows) );}
if inrows < JDIMENSION(numrows) then
numrows := int(inrows);
local_input_buf := JSAMPARRAY(@(input_buf^[in_row_ctr]));
cinfo^.cconvert^.color_convert (cinfo, local_input_buf,
JSAMPIMAGE(@prep^.color_buf),
JDIMENSION(prep^.next_buf_row),
numrows);
Inc(in_row_ctr, numrows);
Inc(prep^.next_buf_row, numrows);
Dec(prep^.rows_to_go, numrows);
{ If at bottom of image, pad to fill the conversion buffer. }
if (prep^.rows_to_go = 0) and
(prep^.next_buf_row < cinfo^.max_v_samp_factor) then
begin
for ci := 0 to pred(cinfo^.num_components) do
begin
expand_bottom_edge(prep^.color_buf[ci], cinfo^.image_width,
prep^.next_buf_row, cinfo^.max_v_samp_factor);
end;
prep^.next_buf_row := cinfo^.max_v_samp_factor;
end;
{ If we've filled the conversion buffer, empty it. }
if (prep^.next_buf_row = cinfo^.max_v_samp_factor) then
begin
cinfo^.downsample^.downsample (cinfo,
JSAMPIMAGE(@prep^.color_buf),
JDIMENSION (0),
output_buf,
out_row_group_ctr);
prep^.next_buf_row := 0;
Inc(out_row_group_ctr);;
end;
{ 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! }
if (prep^.rows_to_go = 0) and
(out_row_group_ctr < out_row_groups_avail) then
begin
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
for ci := 0 to pred(cinfo^.num_components) do
begin
expand_bottom_edge(output_buf^[ci],
compptr^.width_in_blocks * DCTSIZE,
int (out_row_group_ctr) * compptr^.v_samp_factor,
int (out_row_groups_avail) * compptr^.v_samp_factor);
Inc(compptr);
end;
out_row_group_ctr := out_row_groups_avail;
break; { can exit outer loop without test }
end;
end;
end;
{$ifdef CONTEXT_ROWS_SUPPORTED}
{ Process some data in the context case. }
{METHODDEF}
procedure pre_process_context (cinfo : j_compress_ptr;
input_buf : JSAMPARRAY;
var in_row_ctr : JDIMENSION;
in_rows_avail : JDIMENSION;
output_buf : JSAMPIMAGE;
var out_row_group_ctr : JDIMENSION;
out_row_groups_avail : JDIMENSION);
var
prep : my_prep_ptr;
numrows, ci : int;
buf_height : int;
inrows : JDIMENSION;
var
row : int;
begin
prep := my_prep_ptr (cinfo^.prep);
buf_height := cinfo^.max_v_samp_factor * 3;
while (out_row_group_ctr < out_row_groups_avail) do
begin
if (in_row_ctr < in_rows_avail) then
begin
{ Do color conversion to fill the conversion buffer. }
inrows := in_rows_avail - in_row_ctr;
numrows := prep^.next_buf_stop - prep^.next_buf_row;
{numrows := int ( MIN( JDIMENSION(numrows), inrows) );}
if inrows < JDIMENSION(numrows) then
numrows := int(inrows);
cinfo^.cconvert^.color_convert (cinfo,
JSAMPARRAY(@input_buf^[in_row_ctr]),
JSAMPIMAGE(@prep^.color_buf),
JDIMENSION (prep^.next_buf_row),
numrows);
{ Pad at top of image, if first time through }
if (prep^.rows_to_go = cinfo^.image_height) then
begin
for ci := 0 to pred(cinfo^.num_components) do
begin
for row := 1 to cinfo^.max_v_samp_factor do
begin
jcopy_sample_rows(prep^.color_buf[ci], 0,
prep^.color_buf[ci], -row,
1, cinfo^.image_width);
end;
end;
end;
Inc(in_row_ctr, numrows);
Inc(prep^.next_buf_row, numrows);
Dec(prep^.rows_to_go, numrows);
end
else
begin
{ Return for more data, unless we are at the bottom of the image. }
if (prep^.rows_to_go <> 0) then
break;
{ When at bottom of image, pad to fill the conversion buffer. }
if (prep^.next_buf_row < prep^.next_buf_stop) then
begin
for ci := 0 to pred(cinfo^.num_components) do
begin
expand_bottom_edge(prep^.color_buf[ci], cinfo^.image_width,
prep^.next_buf_row, prep^.next_buf_stop);
end;
prep^.next_buf_row := prep^.next_buf_stop;
end;
end;
{ If we've gotten enough data, downsample a row group. }
if (prep^.next_buf_row = prep^.next_buf_stop) then
begin
cinfo^.downsample^.downsample (cinfo,
JSAMPIMAGE(@prep^.color_buf),
JDIMENSION(prep^.this_row_group),
output_buf,
out_row_group_ctr);
Inc(out_row_group_ctr);
{ Advance pointers with wraparound as necessary. }
Inc(prep^.this_row_group, cinfo^.max_v_samp_factor);
if (prep^.this_row_group >= buf_height) then
prep^.this_row_group := 0;
if (prep^.next_buf_row >= buf_height) then
prep^.next_buf_row := 0;
prep^.next_buf_stop := prep^.next_buf_row + cinfo^.max_v_samp_factor;
end;
end;
end;
{ Create the wrapped-around downsampling input buffer needed for context mode. }
{LOCAL}
procedure create_context_buffer (cinfo : j_compress_ptr);
var
prep : my_prep_ptr;
rgroup_height : int;
ci, i : int;
compptr : jpeg_component_info_ptr;
true_buffer, fake_buffer : JSAMPARRAY;
begin
prep := my_prep_ptr (cinfo^.prep);
rgroup_height := cinfo^.max_v_samp_factor;
{ Grab enough space for fake row pointers for all the components;
we need five row groups' worth of pointers for each component. }
fake_buffer := JSAMPARRAY(
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
(cinfo^.num_components * 5 * rgroup_height) *
SIZEOF(JSAMPROW)) );
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
for ci := 0 to pred(cinfo^.num_components) do
begin
{ Allocate the actual buffer space (3 row groups) for this component.
We make the buffer wide enough to allow the downsampler to edge-expand
horizontally within the buffer, if it so chooses. }
true_buffer := cinfo^.mem^.alloc_sarray
(j_common_ptr(cinfo), JPOOL_IMAGE,
JDIMENSION (( long(compptr^.width_in_blocks) * DCTSIZE *
cinfo^.max_h_samp_factor) div compptr^.h_samp_factor),
JDIMENSION (3 * rgroup_height));
{ Copy true buffer row pointers into the middle of the fake row array }
MEMCOPY(JSAMPARRAY(@ fake_buffer^[rgroup_height]), true_buffer,
3 * rgroup_height * SIZEOF(JSAMPROW));
{ Fill in the above and below wraparound pointers }
for i := 0 to pred(rgroup_height) do
begin
fake_buffer^[i] := true_buffer^[2 * rgroup_height + i];
fake_buffer^[4 * rgroup_height + i] := true_buffer^[i];
end;
prep^.color_buf[ci] := JSAMPARRAY(@ fake_buffer^[rgroup_height]);
Inc(JSAMPROW_PTR(fake_buffer), 5 * rgroup_height); { point to space for next component }
Inc(compptr);
end;
end;
{$endif} { CONTEXT_ROWS_SUPPORTED }
{ Initialize preprocessing controller. }
{GLOBAL}
procedure jinit_c_prep_controller (cinfo : j_compress_ptr;
need_full_buffer : boolean);
var
prep : my_prep_ptr;
ci : int;
compptr : jpeg_component_info_ptr;
begin
if (need_full_buffer) then { safety check }
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
prep := my_prep_ptr(
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
SIZEOF(my_prep_controller)) );
cinfo^.prep := jpeg_c_prep_controller_ptr(prep);
prep^.pub.start_pass := start_pass_prep;
{ Allocate the color conversion buffer.
We make the buffer wide enough to allow the downsampler to edge-expand
horizontally within the buffer, if it so chooses. }
if (cinfo^.downsample^.need_context_rows) then
begin
{ Set up to provide context rows }
{$ifdef CONTEXT_ROWS_SUPPORTED}
prep^.pub.pre_process_data := pre_process_context;
create_context_buffer(cinfo);
{$else}
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
{$endif}
end
else
begin
{ No context, just make it tall enough for one row group }
prep^.pub.pre_process_data := pre_process_data;
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
for ci := 0 to pred(cinfo^.num_components) do
begin
prep^.color_buf[ci] := cinfo^.mem^.alloc_sarray
(j_common_ptr(cinfo), JPOOL_IMAGE,
JDIMENSION (( long(compptr^.width_in_blocks) * DCTSIZE *
cinfo^.max_h_samp_factor) div compptr^.h_samp_factor),
JDIMENSION(cinfo^.max_v_samp_factor) );
Inc(compptr);
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;
{ Original : jdapistd.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
{ This file is part of the Independent JPEG Group's software.
For conditions of distribution and use, see the accompanying README file.
This file contains application interface code for the decompression half
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
transcoding-only application. Note that if an application links in
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
whole decompression library into a transcoder. }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjinclude,
imjdeferr,
imjerror,
imjpeglib,
imjdmaster;
{ Read some scanlines of data from the JPEG decompressor.
The return value will be the number of lines actually read.
This may be less than the number requested in several cases,
including bottom of image, data source suspension, and operating
modes that emit multiple scanlines at a time.
Note: we warn about excess calls to jpeg_read_scanlines() since
this likely signals an application programmer error. However,
an oversize buffer (max_lines > scanlines remaining) is not an error. }
{GLOBAL}
function jpeg_read_scanlines (cinfo : j_decompress_ptr;
scanlines : JSAMPARRAY;
max_lines : JDIMENSION) : JDIMENSION;
{ Alternate entry point to read raw data.
Processes exactly one iMCU row per call, unless suspended. }
{GLOBAL}
function jpeg_read_raw_data (cinfo : j_decompress_ptr;
data : JSAMPIMAGE;
max_lines : JDIMENSION) : JDIMENSION;
{$ifdef D_MULTISCAN_FILES_SUPPORTED}
{ Initialize for an output pass in buffered-image mode. }
{GLOBAL}
function jpeg_start_output (cinfo : j_decompress_ptr;
scan_number : int) : boolean;
{ Finish up after an output pass in buffered-image mode.
Returns FALSE if suspended. The return value need be inspected only if
a suspending data source is used. }
{GLOBAL}
function jpeg_finish_output (cinfo : j_decompress_ptr) : boolean;
{$endif} { D_MULTISCAN_FILES_SUPPORTED }
{ Decompression initialization.
jpeg_read_header must be completed before calling this.
If a multipass operating mode was selected, this will do all but the
last pass, and thus may take a great deal of time.
Returns FALSE if suspended. The return value need be inspected only if
a suspending data source is used. }
{GLOBAL}
function jpeg_start_decompress (cinfo : j_decompress_ptr) : boolean;
implementation
{ Forward declarations }
{LOCAL}
function output_pass_setup (cinfo : j_decompress_ptr) : boolean; forward;
{ Decompression initialization.
jpeg_read_header must be completed before calling this.
If a multipass operating mode was selected, this will do all but the
last pass, and thus may take a great deal of time.
Returns FALSE if suspended. The return value need be inspected only if
a suspending data source is used. }
{GLOBAL}
function jpeg_start_decompress (cinfo : j_decompress_ptr) : boolean;
var
retcode : int;
begin
if (cinfo^.global_state = DSTATE_READY) then
begin
{ First call: initialize master control, select active modules }
jinit_master_decompress(cinfo);
if (cinfo^.buffered_image) then
begin
{ No more work here; expecting jpeg_start_output next }
cinfo^.global_state := DSTATE_BUFIMAGE;
jpeg_start_decompress := TRUE;
exit;
end;
cinfo^.global_state := DSTATE_PRELOAD;
end;
if (cinfo^.global_state = DSTATE_PRELOAD) then
begin
{ If file has multiple scans, absorb them all into the coef buffer }
if (cinfo^.inputctl^.has_multiple_scans) then
begin
{$ifdef D_MULTISCAN_FILES_SUPPORTED}
while TRUE do
begin
{ Call progress monitor hook if present }
if (cinfo^.progress <> NIL) then
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
{ Absorb some more input }
retcode := cinfo^.inputctl^.consume_input (cinfo);
if (retcode = JPEG_SUSPENDED) then
begin
jpeg_start_decompress := FALSE;
exit;
end;
if (retcode = JPEG_REACHED_EOI) then
break;
{ Advance progress counter if appropriate }
if (cinfo^.progress <> NIL) and
((retcode = JPEG_ROW_COMPLETED) or (retcode = JPEG_REACHED_SOS)) then
begin
Inc(cinfo^.progress^.pass_counter);
if (cinfo^.progress^.pass_counter >= cinfo^.progress^.pass_limit) then
begin
{ jdmaster underestimated number of scans; ratchet up one scan }
Inc(cinfo^.progress^.pass_limit, long(cinfo^.total_iMCU_rows));
end;
end;
end;
{$else}
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
{$endif} { D_MULTISCAN_FILES_SUPPORTED }
end;
cinfo^.output_scan_number := cinfo^.input_scan_number;
end
else
if (cinfo^.global_state <> DSTATE_PRESCAN) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
{ Perform any dummy output passes, and set up for the final pass }
jpeg_start_decompress := output_pass_setup(cinfo);
end;
{ Set up for an output pass, and perform any dummy pass(es) needed.
Common subroutine for jpeg_start_decompress and jpeg_start_output.
Entry: global_state := DSTATE_PRESCAN only if previously suspended.
Exit: If done, returns TRUE and sets global_state for proper output mode.
If suspended, returns FALSE and sets global_state := DSTATE_PRESCAN. }
{LOCAL}
function output_pass_setup (cinfo : j_decompress_ptr) : boolean;
var
last_scanline : JDIMENSION;
begin
if (cinfo^.global_state <> DSTATE_PRESCAN) then
begin
{ First call: do pass setup }
cinfo^.master^.prepare_for_output_pass (cinfo);
cinfo^.output_scanline := 0;
cinfo^.global_state := DSTATE_PRESCAN;
end;
{ Loop over any required dummy passes }
while (cinfo^.master^.is_dummy_pass) do
begin
{$ifdef QUANT_2PASS_SUPPORTED}
{ Crank through the dummy pass }
while (cinfo^.output_scanline < cinfo^.output_height) do
begin
{ Call progress monitor hook if present }
if (cinfo^.progress <> NIL) then
begin
cinfo^.progress^.pass_counter := long (cinfo^.output_scanline);
cinfo^.progress^.pass_limit := long (cinfo^.output_height);
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
end;
{ Process some data }
last_scanline := cinfo^.output_scanline;
cinfo^.main^.process_data (cinfo, JSAMPARRAY(NIL),
cinfo^.output_scanline, {var}
JDIMENSION(0));
if (cinfo^.output_scanline = last_scanline) then
begin
output_pass_setup := FALSE; { No progress made, must suspend }
exit;
end;
end;
{ Finish up dummy pass, and set up for another one }
cinfo^.master^.finish_output_pass (cinfo);
cinfo^.master^.prepare_for_output_pass (cinfo);
cinfo^.output_scanline := 0;
{$else}
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
{$endif} { QUANT_2PASS_SUPPORTED }
end;
{ Ready for application to drive output pass through
jpeg_read_scanlines or jpeg_read_raw_data. }
if cinfo^.raw_data_out then
cinfo^.global_state := DSTATE_RAW_OK
else
cinfo^.global_state := DSTATE_SCANNING;
output_pass_setup := TRUE;
end;
{ Read some scanlines of data from the JPEG decompressor.
The return value will be the number of lines actually read.
This may be less than the number requested in several cases,
including bottom of image, data source suspension, and operating
modes that emit multiple scanlines at a time.
Note: we warn about excess calls to jpeg_read_scanlines() since
this likely signals an application programmer error. However,
an oversize buffer (max_lines > scanlines remaining) is not an error. }
{GLOBAL}
function jpeg_read_scanlines (cinfo : j_decompress_ptr;
scanlines : JSAMPARRAY;
max_lines : JDIMENSION) : JDIMENSION;
var
row_ctr : JDIMENSION;
begin
if (cinfo^.global_state <> DSTATE_SCANNING) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
if (cinfo^.output_scanline >= cinfo^.output_height) then
begin
WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA);
jpeg_read_scanlines := 0;
exit;
end;
{ Call progress monitor hook if present }
if (cinfo^.progress <> NIL) then
begin
cinfo^.progress^.pass_counter := long (cinfo^.output_scanline);
cinfo^.progress^.pass_limit := long (cinfo^.output_height);
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
end;
{ Process some data }
row_ctr := 0;
cinfo^.main^.process_data (cinfo, scanlines, {var}row_ctr, max_lines);
Inc(cinfo^.output_scanline, row_ctr);
jpeg_read_scanlines := row_ctr;
end;
{ Alternate entry point to read raw data.
Processes exactly one iMCU row per call, unless suspended. }
{GLOBAL}
function jpeg_read_raw_data (cinfo : j_decompress_ptr;
data : JSAMPIMAGE;
max_lines : JDIMENSION) : JDIMENSION;
var
lines_per_iMCU_row : JDIMENSION;
begin
if (cinfo^.global_state <> DSTATE_RAW_OK) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
if (cinfo^.output_scanline >= cinfo^.output_height) then
begin
WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA);
jpeg_read_raw_data := 0;
exit;
end;
{ Call progress monitor hook if present }
if (cinfo^.progress <> NIL) then
begin
cinfo^.progress^.pass_counter := long (cinfo^.output_scanline);
cinfo^.progress^.pass_limit := long (cinfo^.output_height);
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
end;
{ Verify that at least one iMCU row can be returned. }
lines_per_iMCU_row := cinfo^.max_v_samp_factor * cinfo^.min_DCT_scaled_size;
if (max_lines < lines_per_iMCU_row) then
ERREXIT(j_common_ptr(cinfo), JERR_BUFFER_SIZE);
{ Decompress directly into user's buffer. }
if (cinfo^.coef^.decompress_data (cinfo, data) = 0) then
begin
jpeg_read_raw_data := 0; { suspension forced, can do nothing more }
exit;
end;
{ OK, we processed one iMCU row. }
Inc(cinfo^.output_scanline, lines_per_iMCU_row);
jpeg_read_raw_data := lines_per_iMCU_row;
end;
{ Additional entry points for buffered-image mode. }
{$ifdef D_MULTISCAN_FILES_SUPPORTED}
{ Initialize for an output pass in buffered-image mode. }
{GLOBAL}
function jpeg_start_output (cinfo : j_decompress_ptr;
scan_number : int) : boolean;
begin
if (cinfo^.global_state <> DSTATE_BUFIMAGE) and
(cinfo^.global_state <> DSTATE_PRESCAN) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
{ Limit scan number to valid range }
if (scan_number <= 0) then
scan_number := 1;
if (cinfo^.inputctl^.eoi_reached) and
(scan_number > cinfo^.input_scan_number) then
scan_number := cinfo^.input_scan_number;
cinfo^.output_scan_number := scan_number;
{ Perform any dummy output passes, and set up for the real pass }
jpeg_start_output := output_pass_setup(cinfo);
end;
{ Finish up after an output pass in buffered-image mode.
Returns FALSE if suspended. The return value need be inspected only if
a suspending data source is used. }
{GLOBAL}
function jpeg_finish_output (cinfo : j_decompress_ptr) : boolean;
begin
if ((cinfo^.global_state = DSTATE_SCANNING) or
(cinfo^.global_state = DSTATE_RAW_OK) and cinfo^.buffered_image) then
begin
{ Terminate this pass. }
{ We do not require the whole pass to have been completed. }
cinfo^.master^.finish_output_pass (cinfo);
cinfo^.global_state := DSTATE_BUFPOST;
end
else
if (cinfo^.global_state <> DSTATE_BUFPOST) then
begin
{ BUFPOST := repeat call after a suspension, anything else is error }
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
end;
{ Read markers looking for SOS or EOI }
while (cinfo^.input_scan_number <= cinfo^.output_scan_number) and
(not cinfo^.inputctl^.eoi_reached) do
begin
if (cinfo^.inputctl^.consume_input (cinfo) = JPEG_SUSPENDED) then
begin
jpeg_finish_output := FALSE; { Suspend, come back later }
exit;
end;
end;
cinfo^.global_state := DSTATE_BUFIMAGE;
jpeg_finish_output := TRUE;
end;
{$endif} { D_MULTISCAN_FILES_SUPPORTED }
end.
unit imjdapistd;
{ Original : jdapistd.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
{ This file is part of the Independent JPEG Group's software.
For conditions of distribution and use, see the accompanying README file.
This file contains application interface code for the decompression half
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
transcoding-only application. Note that if an application links in
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
whole decompression library into a transcoder. }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjinclude,
imjdeferr,
imjerror,
imjpeglib,
imjdmaster;
{ Read some scanlines of data from the JPEG decompressor.
The return value will be the number of lines actually read.
This may be less than the number requested in several cases,
including bottom of image, data source suspension, and operating
modes that emit multiple scanlines at a time.
Note: we warn about excess calls to jpeg_read_scanlines() since
this likely signals an application programmer error. However,
an oversize buffer (max_lines > scanlines remaining) is not an error. }
{GLOBAL}
function jpeg_read_scanlines (cinfo : j_decompress_ptr;
scanlines : JSAMPARRAY;
max_lines : JDIMENSION) : JDIMENSION;
{ Alternate entry point to read raw data.
Processes exactly one iMCU row per call, unless suspended. }
{GLOBAL}
function jpeg_read_raw_data (cinfo : j_decompress_ptr;
data : JSAMPIMAGE;
max_lines : JDIMENSION) : JDIMENSION;
{$ifdef D_MULTISCAN_FILES_SUPPORTED}
{ Initialize for an output pass in buffered-image mode. }
{GLOBAL}
function jpeg_start_output (cinfo : j_decompress_ptr;
scan_number : int) : boolean;
{ Finish up after an output pass in buffered-image mode.
Returns FALSE if suspended. The return value need be inspected only if
a suspending data source is used. }
{GLOBAL}
function jpeg_finish_output (cinfo : j_decompress_ptr) : boolean;
{$endif} { D_MULTISCAN_FILES_SUPPORTED }
{ Decompression initialization.
jpeg_read_header must be completed before calling this.
If a multipass operating mode was selected, this will do all but the
last pass, and thus may take a great deal of time.
Returns FALSE if suspended. The return value need be inspected only if
a suspending data source is used. }
{GLOBAL}
function jpeg_start_decompress (cinfo : j_decompress_ptr) : boolean;
implementation
{ Forward declarations }
{LOCAL}
function output_pass_setup (cinfo : j_decompress_ptr) : boolean; forward;
{ Decompression initialization.
jpeg_read_header must be completed before calling this.
If a multipass operating mode was selected, this will do all but the
last pass, and thus may take a great deal of time.
Returns FALSE if suspended. The return value need be inspected only if
a suspending data source is used. }
{GLOBAL}
function jpeg_start_decompress (cinfo : j_decompress_ptr) : boolean;
var
retcode : int;
begin
if (cinfo^.global_state = DSTATE_READY) then
begin
{ First call: initialize master control, select active modules }
jinit_master_decompress(cinfo);
if (cinfo^.buffered_image) then
begin
{ No more work here; expecting jpeg_start_output next }
cinfo^.global_state := DSTATE_BUFIMAGE;
jpeg_start_decompress := TRUE;
exit;
end;
cinfo^.global_state := DSTATE_PRELOAD;
end;
if (cinfo^.global_state = DSTATE_PRELOAD) then
begin
{ If file has multiple scans, absorb them all into the coef buffer }
if (cinfo^.inputctl^.has_multiple_scans) then
begin
{$ifdef D_MULTISCAN_FILES_SUPPORTED}
while TRUE do
begin
{ Call progress monitor hook if present }
if (cinfo^.progress <> NIL) then
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
{ Absorb some more input }
retcode := cinfo^.inputctl^.consume_input (cinfo);
if (retcode = JPEG_SUSPENDED) then
begin
jpeg_start_decompress := FALSE;
exit;
end;
if (retcode = JPEG_REACHED_EOI) then
break;
{ Advance progress counter if appropriate }
if (cinfo^.progress <> NIL) and
((retcode = JPEG_ROW_COMPLETED) or (retcode = JPEG_REACHED_SOS)) then
begin
Inc(cinfo^.progress^.pass_counter);
if (cinfo^.progress^.pass_counter >= cinfo^.progress^.pass_limit) then
begin
{ jdmaster underestimated number of scans; ratchet up one scan }
Inc(cinfo^.progress^.pass_limit, long(cinfo^.total_iMCU_rows));
end;
end;
end;
{$else}
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
{$endif} { D_MULTISCAN_FILES_SUPPORTED }
end;
cinfo^.output_scan_number := cinfo^.input_scan_number;
end
else
if (cinfo^.global_state <> DSTATE_PRESCAN) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
{ Perform any dummy output passes, and set up for the final pass }
jpeg_start_decompress := output_pass_setup(cinfo);
end;
{ Set up for an output pass, and perform any dummy pass(es) needed.
Common subroutine for jpeg_start_decompress and jpeg_start_output.
Entry: global_state := DSTATE_PRESCAN only if previously suspended.
Exit: If done, returns TRUE and sets global_state for proper output mode.
If suspended, returns FALSE and sets global_state := DSTATE_PRESCAN. }
{LOCAL}
function output_pass_setup (cinfo : j_decompress_ptr) : boolean;
var
last_scanline : JDIMENSION;
begin
if (cinfo^.global_state <> DSTATE_PRESCAN) then
begin
{ First call: do pass setup }
cinfo^.master^.prepare_for_output_pass (cinfo);
cinfo^.output_scanline := 0;
cinfo^.global_state := DSTATE_PRESCAN;
end;
{ Loop over any required dummy passes }
while (cinfo^.master^.is_dummy_pass) do
begin
{$ifdef QUANT_2PASS_SUPPORTED}
{ Crank through the dummy pass }
while (cinfo^.output_scanline < cinfo^.output_height) do
begin
{ Call progress monitor hook if present }
if (cinfo^.progress <> NIL) then
begin
cinfo^.progress^.pass_counter := long (cinfo^.output_scanline);
cinfo^.progress^.pass_limit := long (cinfo^.output_height);
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
end;
{ Process some data }
last_scanline := cinfo^.output_scanline;
cinfo^.main^.process_data (cinfo, JSAMPARRAY(NIL),
cinfo^.output_scanline, {var}
JDIMENSION(0));
if (cinfo^.output_scanline = last_scanline) then
begin
output_pass_setup := FALSE; { No progress made, must suspend }
exit;
end;
end;
{ Finish up dummy pass, and set up for another one }
cinfo^.master^.finish_output_pass (cinfo);
cinfo^.master^.prepare_for_output_pass (cinfo);
cinfo^.output_scanline := 0;
{$else}
ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED);
{$endif} { QUANT_2PASS_SUPPORTED }
end;
{ Ready for application to drive output pass through
jpeg_read_scanlines or jpeg_read_raw_data. }
if cinfo^.raw_data_out then
cinfo^.global_state := DSTATE_RAW_OK
else
cinfo^.global_state := DSTATE_SCANNING;
output_pass_setup := TRUE;
end;
{ Read some scanlines of data from the JPEG decompressor.
The return value will be the number of lines actually read.
This may be less than the number requested in several cases,
including bottom of image, data source suspension, and operating
modes that emit multiple scanlines at a time.
Note: we warn about excess calls to jpeg_read_scanlines() since
this likely signals an application programmer error. However,
an oversize buffer (max_lines > scanlines remaining) is not an error. }
{GLOBAL}
function jpeg_read_scanlines (cinfo : j_decompress_ptr;
scanlines : JSAMPARRAY;
max_lines : JDIMENSION) : JDIMENSION;
var
row_ctr : JDIMENSION;
begin
if (cinfo^.global_state <> DSTATE_SCANNING) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
if (cinfo^.output_scanline >= cinfo^.output_height) then
begin
WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA);
jpeg_read_scanlines := 0;
exit;
end;
{ Call progress monitor hook if present }
if (cinfo^.progress <> NIL) then
begin
cinfo^.progress^.pass_counter := long (cinfo^.output_scanline);
cinfo^.progress^.pass_limit := long (cinfo^.output_height);
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
end;
{ Process some data }
row_ctr := 0;
cinfo^.main^.process_data (cinfo, scanlines, {var}row_ctr, max_lines);
Inc(cinfo^.output_scanline, row_ctr);
jpeg_read_scanlines := row_ctr;
end;
{ Alternate entry point to read raw data.
Processes exactly one iMCU row per call, unless suspended. }
{GLOBAL}
function jpeg_read_raw_data (cinfo : j_decompress_ptr;
data : JSAMPIMAGE;
max_lines : JDIMENSION) : JDIMENSION;
var
lines_per_iMCU_row : JDIMENSION;
begin
if (cinfo^.global_state <> DSTATE_RAW_OK) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
if (cinfo^.output_scanline >= cinfo^.output_height) then
begin
WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA);
jpeg_read_raw_data := 0;
exit;
end;
{ Call progress monitor hook if present }
if (cinfo^.progress <> NIL) then
begin
cinfo^.progress^.pass_counter := long (cinfo^.output_scanline);
cinfo^.progress^.pass_limit := long (cinfo^.output_height);
cinfo^.progress^.progress_monitor (j_common_ptr(cinfo));
end;
{ Verify that at least one iMCU row can be returned. }
lines_per_iMCU_row := cinfo^.max_v_samp_factor * cinfo^.min_DCT_scaled_size;
if (max_lines < lines_per_iMCU_row) then
ERREXIT(j_common_ptr(cinfo), JERR_BUFFER_SIZE);
{ Decompress directly into user's buffer. }
if (cinfo^.coef^.decompress_data (cinfo, data) = 0) then
begin
jpeg_read_raw_data := 0; { suspension forced, can do nothing more }
exit;
end;
{ OK, we processed one iMCU row. }
Inc(cinfo^.output_scanline, lines_per_iMCU_row);
jpeg_read_raw_data := lines_per_iMCU_row;
end;
{ Additional entry points for buffered-image mode. }
{$ifdef D_MULTISCAN_FILES_SUPPORTED}
{ Initialize for an output pass in buffered-image mode. }
{GLOBAL}
function jpeg_start_output (cinfo : j_decompress_ptr;
scan_number : int) : boolean;
begin
if (cinfo^.global_state <> DSTATE_BUFIMAGE) and
(cinfo^.global_state <> DSTATE_PRESCAN) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
{ Limit scan number to valid range }
if (scan_number <= 0) then
scan_number := 1;
if (cinfo^.inputctl^.eoi_reached) and
(scan_number > cinfo^.input_scan_number) then
scan_number := cinfo^.input_scan_number;
cinfo^.output_scan_number := scan_number;
{ Perform any dummy output passes, and set up for the real pass }
jpeg_start_output := output_pass_setup(cinfo);
end;
{ Finish up after an output pass in buffered-image mode.
Returns FALSE if suspended. The return value need be inspected only if
a suspending data source is used. }
{GLOBAL}
function jpeg_finish_output (cinfo : j_decompress_ptr) : boolean;
begin
if ((cinfo^.global_state = DSTATE_SCANNING) or
(cinfo^.global_state = DSTATE_RAW_OK) and cinfo^.buffered_image) then
begin
{ Terminate this pass. }
{ We do not require the whole pass to have been completed. }
cinfo^.master^.finish_output_pass (cinfo);
cinfo^.global_state := DSTATE_BUFPOST;
end
else
if (cinfo^.global_state <> DSTATE_BUFPOST) then
begin
{ BUFPOST := repeat call after a suspension, anything else is error }
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state);
end;
{ Read markers looking for SOS or EOI }
while (cinfo^.input_scan_number <= cinfo^.output_scan_number) and
(not cinfo^.inputctl^.eoi_reached) do
begin
if (cinfo^.inputctl^.consume_input (cinfo) = JPEG_SUSPENDED) then
begin
jpeg_finish_output := FALSE; { Suspend, come back later }
exit;
end;
end;
cinfo^.global_state := DSTATE_BUFIMAGE;
jpeg_finish_output := TRUE;
end;
{$endif} { D_MULTISCAN_FILES_SUPPORTED }
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;
{ Orignal: jdct.h; Copyright (C) 1994-1996, Thomas G. Lane. }
{ This include file contains common declarations for the forward and
inverse DCT modules. These declarations are private to the DCT managers
(jcdctmgr.c, jddctmgr.c) and the individual DCT algorithms.
The individual DCT algorithms are kept in separate files to ease
machine-dependent tuning (e.g., assembly coding). }
interface
{$I imjconfig.inc}
uses
imjmorecfg;
{ 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
for 8-bit samples, INT32 for 12-bit samples. (NOTE: Floating-point DCT
implementations use an array of type FAST_FLOAT, instead.)
The DCT inputs are expected to be signed (range +-CENTERJSAMPLE).
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
convention improves accuracy in integer implementations and saves some
work in floating-point ones.
Quantization of the output coefficients is done by jcdctmgr.c. }
{$ifdef BITS_IN_JSAMPLE_IS_8}
type
DCTELEM = int; { 16 or 32 bits is fine }
{$else}
type { must have 32 bits }
DCTELEM = INT32;
{$endif}
type
jTDctElem = 0..(MaxInt div SizeOf(DCTELEM))-1;
DCTELEM_FIELD = array[jTDctElem] of DCTELEM;
DCTELEM_FIELD_PTR = ^DCTELEM_FIELD;
DCTELEMPTR = ^DCTELEM;
type
forward_DCT_method_ptr = procedure(var data : array of DCTELEM);
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
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
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
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
DCT_scaled_size * DCT_scaled_size. }
{ typedef inverse_DCT_method_ptr is declared in jpegint.h }
{ Each IDCT routine has its own ideas about the best dct_table element type. }
type
ISLOW_MULT_TYPE = MULTIPLIER; { short or int, whichever is faster }
{$ifdef BITS_IN_JSAMPLE_IS_8}
type
IFAST_MULT_TYPE = MULTIPLIER; { 16 bits is OK, use short if faster }
const
IFAST_SCALE_BITS = 2; { fractional bits in scale factors }
{$else}
type
IFAST_MULT_TYPE = INT32; { need 32 bits for scaled quantizers }
const
IFAST_SCALE_BITS = 13; { fractional bits in scale factors }
{$endif}
type
FLOAT_MULT_TYPE = FAST_FLOAT; { preferred floating type }
const
RANGE_MASK = (MAXJSAMPLE * 4 + 3); { 2 bits wider than legal samples }
type
jTMultType = 0..(MaxInt div SizeOf(ISLOW_MULT_TYPE))-1;
ISLOW_MULT_TYPE_FIELD = array[jTMultType] of ISLOW_MULT_TYPE;
ISLOW_MULT_TYPE_FIELD_PTR = ^ISLOW_MULT_TYPE_FIELD;
ISLOW_MULT_TYPE_PTR = ^ISLOW_MULT_TYPE;
jTFloatType = 0..(MaxInt div SizeOf(FLOAT_MULT_TYPE))-1;
FLOAT_MULT_TYPE_FIELD = array[jTFloatType] of FLOAT_MULT_TYPE;
FLOAT_MULT_TYPE_FIELD_PTR = ^FLOAT_MULT_TYPE_FIELD;
FLOAT_MULT_TYPE_PTR = ^FLOAT_MULT_TYPE;
jTFastType = 0..(MaxInt div SizeOf(IFAST_MULT_TYPE))-1;
IFAST_MULT_TYPE_FIELD = array[jTFastType] of IFAST_MULT_TYPE;
IFAST_MULT_TYPE_FIELD_PTR = ^IFAST_MULT_TYPE_FIELD;
IFAST_MULT_TYPE_PTR = ^IFAST_MULT_TYPE;
type
jTFastFloat = 0..(MaxInt div SizeOf(FAST_FLOAT))-1;
FAST_FLOAT_FIELD = array[jTFastFloat] of FAST_FLOAT;
FAST_FLOAT_FIELD_PTR = ^FAST_FLOAT_FIELD;
FAST_FLOAT_PTR = ^FAST_FLOAT;
implementation
end.
unit imjdct;
{ Orignal: jdct.h; Copyright (C) 1994-1996, Thomas G. Lane. }
{ This include file contains common declarations for the forward and
inverse DCT modules. These declarations are private to the DCT managers
(jcdctmgr.c, jddctmgr.c) and the individual DCT algorithms.
The individual DCT algorithms are kept in separate files to ease
machine-dependent tuning (e.g., assembly coding). }
interface
{$I imjconfig.inc}
uses
imjmorecfg;
{ 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
for 8-bit samples, INT32 for 12-bit samples. (NOTE: Floating-point DCT
implementations use an array of type FAST_FLOAT, instead.)
The DCT inputs are expected to be signed (range +-CENTERJSAMPLE).
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
convention improves accuracy in integer implementations and saves some
work in floating-point ones.
Quantization of the output coefficients is done by jcdctmgr.c. }
{$ifdef BITS_IN_JSAMPLE_IS_8}
type
DCTELEM = int; { 16 or 32 bits is fine }
{$else}
type { must have 32 bits }
DCTELEM = INT32;
{$endif}
type
jTDctElem = 0..(MaxInt div SizeOf(DCTELEM))-1;
DCTELEM_FIELD = array[jTDctElem] of DCTELEM;
DCTELEM_FIELD_PTR = ^DCTELEM_FIELD;
DCTELEMPTR = ^DCTELEM;
type
forward_DCT_method_ptr = procedure(var data : array of DCTELEM);
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
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
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
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
DCT_scaled_size * DCT_scaled_size. }
{ typedef inverse_DCT_method_ptr is declared in jpegint.h }
{ Each IDCT routine has its own ideas about the best dct_table element type. }
type
ISLOW_MULT_TYPE = MULTIPLIER; { short or int, whichever is faster }
{$ifdef BITS_IN_JSAMPLE_IS_8}
type
IFAST_MULT_TYPE = MULTIPLIER; { 16 bits is OK, use short if faster }
const
IFAST_SCALE_BITS = 2; { fractional bits in scale factors }
{$else}
type
IFAST_MULT_TYPE = INT32; { need 32 bits for scaled quantizers }
const
IFAST_SCALE_BITS = 13; { fractional bits in scale factors }
{$endif}
type
FLOAT_MULT_TYPE = FAST_FLOAT; { preferred floating type }
const
RANGE_MASK = (MAXJSAMPLE * 4 + 3); { 2 bits wider than legal samples }
type
jTMultType = 0..(MaxInt div SizeOf(ISLOW_MULT_TYPE))-1;
ISLOW_MULT_TYPE_FIELD = array[jTMultType] of ISLOW_MULT_TYPE;
ISLOW_MULT_TYPE_FIELD_PTR = ^ISLOW_MULT_TYPE_FIELD;
ISLOW_MULT_TYPE_PTR = ^ISLOW_MULT_TYPE;
jTFloatType = 0..(MaxInt div SizeOf(FLOAT_MULT_TYPE))-1;
FLOAT_MULT_TYPE_FIELD = array[jTFloatType] of FLOAT_MULT_TYPE;
FLOAT_MULT_TYPE_FIELD_PTR = ^FLOAT_MULT_TYPE_FIELD;
FLOAT_MULT_TYPE_PTR = ^FLOAT_MULT_TYPE;
jTFastType = 0..(MaxInt div SizeOf(IFAST_MULT_TYPE))-1;
IFAST_MULT_TYPE_FIELD = array[jTFastType] of IFAST_MULT_TYPE;
IFAST_MULT_TYPE_FIELD_PTR = ^IFAST_MULT_TYPE_FIELD;
IFAST_MULT_TYPE_PTR = ^IFAST_MULT_TYPE;
type
jTFastFloat = 0..(MaxInt div SizeOf(FAST_FLOAT))-1;
FAST_FLOAT_FIELD = array[jTFastFloat] of FAST_FLOAT;
FAST_FLOAT_FIELD_PTR = ^FAST_FLOAT_FIELD;
FAST_FLOAT_PTR = ^FAST_FLOAT;
implementation
end.

658
Imaging/JpegLib/imjddctmgr.pas
View File

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

994
Imaging/JpegLib/imjdeferr.pas
View File

@ -1,497 +1,497 @@
unit imjdeferr;
{ This file defines the error and message codes for the cjpeg/djpeg
applications. These strings are not needed as part of the JPEG library
proper.
Edit this file to add new codes, or to translate the message strings to
some other language. }
{ Original cderror.h ; Copyright (C) 1994, Thomas G. Lane. }
interface
{$I imjconfig.inc}
{ To define the enum list of message codes, include this file without
defining macro JMESSAGE. To create a message string table, include it
again with a suitable JMESSAGE definition (see jerror.c for an example). }
{ Original: jversion.h ; Copyright (C) 1991-1996, Thomas G. Lane. }
{ This file contains software version identification. }
const
JVERSION = '6a 7-Feb-96';
JCOPYRIGHT = 'Copyright (C) 1996, Thomas G. Lane';
JNOTICE = 'Pascal Translation, Copyright (C) 1996, Jacques Nomssi Nzali';
{ Create the message string table.
We do this from the master message list in jerror.h by re-reading
jerror.h with a suitable definition for macro JMESSAGE.
The message table is made an external symbol just in case any applications
want to refer to it directly. }
type
J_MESSAGE_CODE =(
JMSG_NOMESSAGE,
JERR_ARITH_NOTIMPL,
JERR_BAD_ALIGN_TYPE,
JERR_BAD_ALLOC_CHUNK,
JERR_BAD_BUFFER_MODE,
JERR_BAD_COMPONENT_ID,
JERR_BAD_DCT_COEF,
JERR_BAD_DCTSIZE,
JERR_BAD_HUFF_TABLE,
JERR_BAD_IN_COLORSPACE,
JERR_BAD_J_COLORSPACE,
JERR_BAD_LENGTH,
JERR_BAD_LIB_VERSION,
JERR_BAD_MCU_SIZE,
JERR_BAD_POOL_ID,
JERR_BAD_PRECISION,
JERR_BAD_PROGRESSION,
JERR_BAD_PROG_SCRIPT,
JERR_BAD_SAMPLING,
JERR_BAD_SCAN_SCRIPT,
JERR_BAD_STATE,
JERR_BAD_STRUCT_SIZE,
JERR_BAD_VIRTUAL_ACCESS,
JERR_BUFFER_SIZE,
JERR_CANT_SUSPEND,
JERR_CCIR601_NOTIMPL,
JERR_COMPONENT_COUNT,
JERR_CONVERSION_NOTIMPL,
JERR_DAC_INDEX,
JERR_DAC_VALUE,
JERR_DHT_COUNTS,
JERR_DHT_INDEX,
JERR_DQT_INDEX,
JERR_EMPTY_IMAGE,
JERR_EMS_READ,
JERR_EMS_WRITE,
JERR_EOI_EXPECTED,
JERR_FILE_READ,
JERR_FILE_WRITE,
JERR_FRACT_SAMPLE_NOTIMPL,
JERR_HUFF_CLEN_OVERFLOW,
JERR_HUFF_MISSING_CODE,
JERR_IMAGE_TOO_BIG,
JERR_INPUT_EMPTY,
JERR_INPUT_EOF,
JERR_MISMATCHED_QUANT_TABLE,
JERR_MISSING_DATA,
JERR_MODE_CHANGE,
JERR_NOTIMPL,
JERR_NOT_COMPILED,
JERR_NO_BACKING_STORE,
JERR_NO_HUFF_TABLE,
JERR_NO_IMAGE,
JERR_NO_QUANT_TABLE,
JERR_NO_SOI,
JERR_OUT_OF_MEMORY,
JERR_QUANT_COMPONENTS,
JERR_QUANT_FEW_COLORS,
JERR_QUANT_MANY_COLORS,
JERR_SOF_DUPLICATE,
JERR_SOF_NO_SOS,
JERR_SOF_UNSUPPORTED,
JERR_SOI_DUPLICATE,
JERR_SOS_NO_SOF,
JERR_TFILE_CREATE,
JERR_TFILE_READ,
JERR_TFILE_SEEK,
JERR_TFILE_WRITE,
JERR_TOO_LITTLE_DATA,
JERR_UNKNOWN_MARKER,
JERR_VIRTUAL_BUG,
JERR_WIDTH_OVERFLOW,
JERR_XMS_READ,
JERR_XMS_WRITE,
JMSG_COPYRIGHT,
JMSG_VERSION,
JTRC_16BIT_TABLES,
JTRC_ADOBE,
JTRC_APP0,
JTRC_APP14,
JTRC_DAC,
JTRC_DHT,
JTRC_DQT,
JTRC_DRI,
JTRC_EMS_CLOSE,
JTRC_EMS_OPEN,
JTRC_EOI,
JTRC_HUFFBITS,
JTRC_JFIF,
JTRC_JFIF_BADTHUMBNAILSIZE,
JTRC_JFIF_EXTENSION,
JTRC_JFIF_THUMBNAIL,
JTRC_MISC_MARKER,
JTRC_PARMLESS_MARKER,
JTRC_QUANTVALS,
JTRC_QUANT_3_NCOLORS,
JTRC_QUANT_NCOLORS,
JTRC_QUANT_SELECTED,
JTRC_RECOVERY_ACTION,
JTRC_RST,
JTRC_SMOOTH_NOTIMPL,
JTRC_SOF,
JTRC_SOF_COMPONENT,
JTRC_SOI,
JTRC_SOS,
JTRC_SOS_COMPONENT,
JTRC_SOS_PARAMS,
JTRC_TFILE_CLOSE,
JTRC_TFILE_OPEN,
JTRC_THUMB_JPEG,
JTRC_THUMB_PALETTE,
JTRC_THUMB_RGB,
JTRC_UNKNOWN_IDS,
JTRC_XMS_CLOSE,
JTRC_XMS_OPEN,
JWRN_ADOBE_XFORM,
JWRN_BOGUS_PROGRESSION,
JWRN_EXTRANEOUS_DATA,
JWRN_HIT_MARKER,
JWRN_HUFF_BAD_CODE,
JWRN_JFIF_MAJOR,
JWRN_JPEG_EOF,
JWRN_MUST_RESYNC,
JWRN_NOT_SEQUENTIAL,
JWRN_TOO_MUCH_DATA,
JMSG_FIRSTADDONCODE, { Must be first entry! }
{$ifdef BMP_SUPPORTED}
JERR_BMP_BADCMAP, { Unsupported BMP colormap format }
JERR_BMP_BADDEPTH, { Only 8- and 24-bit BMP files are supported }
JERR_BMP_BADHEADER, { Invalid BMP file: bad header length }
JERR_BMP_BADPLANES, { Invalid BMP file: biPlanes not equal to 1 }
JERR_BMP_COLORSPACE, { BMP output must be grayscale or RGB }
JERR_BMP_COMPRESSED, { Sorry, compressed BMPs not yet supported }
JERR_BMP_NOT, { Not a BMP file - does not start with BM }
JTRC_BMP, { %dx%d 24-bit 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_MAPPED, { %dx%d 8-bit colormapped OS2 BMP image }
{$endif} { BMP_SUPPORTED }
{$ifdef GIF_SUPPORTED}
JERR_GIF_BUG, { GIF output got confused }
JERR_GIF_CODESIZE, { Bogus GIF codesize %d }
JERR_GIF_COLORSPACE, { GIF output must be grayscale or RGB }
JERR_GIF_IMAGENOTFOUND, { Too few images in GIF file }
JERR_GIF_NOT, { Not a GIF file }
JTRC_GIF, { %dx%dx%d GIF image }
JTRC_GIF_BADVERSION,
{ Warning: unexpected GIF version number '%c%c%c' }
JTRC_GIF_EXTENSION, { Ignoring GIF extension block of type 0x%02x }
JTRC_GIF_NONSQUARE, { Caution: nonsquare pixels in input }
JWRN_GIF_BADDATA, { Corrupt data in GIF file }
JWRN_GIF_CHAR, { Bogus char 0x%02x in GIF file, ignoring }
JWRN_GIF_ENDCODE, { Premature end of GIF image }
JWRN_GIF_NOMOREDATA, { Ran out of GIF bits }
{$endif} { GIF_SUPPORTED }
{$ifdef PPM_SUPPORTED}
JERR_PPM_COLORSPACE, { PPM output must be grayscale or RGB }
JERR_PPM_NONNUMERIC, { Nonnumeric data in PPM file }
JERR_PPM_NOT, { Not a PPM file }
JTRC_PGM, { %dx%d PGM image }
JTRC_PGM_TEXT, { %dx%d text PGM image }
JTRC_PPM, { %dx%d PPM image }
JTRC_PPM_TEXT, { %dx%d text PPM image }
{$endif} { PPM_SUPPORTED }
{$ifdef RLE_SUPPORTED}
JERR_RLE_BADERROR, { Bogus error code from RLE library }
JERR_RLE_COLORSPACE, { RLE output must be grayscale or RGB }
JERR_RLE_DIMENSIONS, { Image dimensions (%dx%d) too large for RLE }
JERR_RLE_EMPTY, { Empty RLE file }
JERR_RLE_EOF, { Premature EOF in RLE header }
JERR_RLE_MEM, { Insufficient memory for RLE header }
JERR_RLE_NOT, { Not an RLE file }
JERR_RLE_TOOMANYCHANNELS, { Cannot handle %d output channels for RLE }
JERR_RLE_UNSUPPORTED, { Cannot handle this RLE setup }
JTRC_RLE, { %dx%d full-color RLE file }
JTRC_RLE_FULLMAP, { %dx%d full-color RLE file with map of length %d }
JTRC_RLE_GRAY, { %dx%d grayscale RLE file }
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 }
{$endif} { RLE_SUPPORTED }
{$ifdef TARGA_SUPPORTED}
JERR_TGA_BADCMAP, { Unsupported Targa colormap format }
JERR_TGA_BADPARMS, { Invalid or unsupported Targa file }
JERR_TGA_COLORSPACE, { Targa output must be grayscale or RGB }
JTRC_TGA, { %dx%d RGB Targa image }
JTRC_TGA_GRAY, { %dx%d grayscale Targa image }
JTRC_TGA_MAPPED, { %dx%d colormapped Targa image }
{$else}
JERR_TGA_NOTCOMP, { Targa support was not compiled }
{$endif} { TARGA_SUPPORTED }
JERR_BAD_CMAP_FILE,
{ Color map file is invalid or of unsupported format }
JERR_TOO_MANY_COLORS,
{ Output file format cannot handle %d colormap entries }
JERR_UNGETC_FAILED, { ungetc failed }
{$ifdef TARGA_SUPPORTED}
JERR_UNKNOWN_FORMAT,
{ Unrecognized input file format --- perhaps you need -targa }
{$else}
JERR_UNKNOWN_FORMAT, { Unrecognized input file format }
{$endif}
JERR_UNSUPPORTED_FORMAT, { Unsupported output file format }
JMSG_LASTADDONCODE
);
const
JMSG_LASTMSGCODE : J_MESSAGE_CODE = JMSG_LASTADDONCODE;
type
msg_table = Array[J_MESSAGE_CODE] of string[80];
const
jpeg_std_message_table : msg_table = (
{ JMSG_NOMESSAGE } 'Bogus message code %d', { Must be first entry! }
{ For maintenance convenience, list is alphabetical by message code name }
{ JERR_ARITH_NOTIMPL }
'Sorry, there are legal restrictions on arithmetic coding',
{ JERR_BAD_ALIGN_TYPE } 'ALIGN_TYPE 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_COMPONENT_ID } 'Invalid component ID %d in SOS',
{ JERR_BAD_DCT_COEF } 'DCT coefficient out of range',
{ JERR_BAD_DCTSIZE } 'IDCT output block size %d not supported',
{ JERR_BAD_HUFF_TABLE } 'Bogus Huffman table definition',
{ JERR_BAD_IN_COLORSPACE } 'Bogus input colorspace',
{ JERR_BAD_J_COLORSPACE } 'Bogus JPEG colorspace',
{ JERR_BAD_LENGTH } 'Bogus marker length',
{ JERR_BAD_LIB_VERSION }
'Wrong JPEG library version: library is %d, caller expects %d',
{ JERR_BAD_MCU_SIZE } 'Sampling factors too large for interleaved scan',
{ JERR_BAD_POOL_ID } 'Invalid memory pool code %d',
{ JERR_BAD_PRECISION } 'Unsupported JPEG data precision %d',
{ JERR_BAD_PROGRESSION }
'Invalid progressive parameters Ss=%d Se=%d Ah=%d Al=%d',
{ JERR_BAD_PROG_SCRIPT }
'Invalid progressive parameters at scan script entry %d',
{ JERR_BAD_SAMPLING } 'Bogus sampling factors',
{ JERR_BAD_SCAN_SCRIPT } 'Invalid scan script at entry %d',
{ JERR_BAD_STATE } 'Improper call to JPEG library in state %d',
{ JERR_BAD_STRUCT_SIZE }
'JPEG parameter struct mismatch: library thinks size is %d, caller expects %d',
{ JERR_BAD_VIRTUAL_ACCESS } 'Bogus virtual array access',
{ JERR_BUFFER_SIZE } 'Buffer passed to JPEG library is too small',
{ JERR_CANT_SUSPEND } 'Suspension not allowed here',
{ JERR_CCIR601_NOTIMPL } 'CCIR601 sampling not implemented yet',
{ JERR_COMPONENT_COUNT } 'Too many color components: %d, max %d',
{ JERR_CONVERSION_NOTIMPL } 'Unsupported color conversion request',
{ JERR_DAC_INDEX } 'Bogus DAC index %d',
{ JERR_DAC_VALUE } 'Bogus DAC value $%x',
{ JERR_DHT_COUNTS } 'Bogus DHT counts',
{ JERR_DHT_INDEX } 'Bogus DHT index %d',
{ JERR_DQT_INDEX } 'Bogus DQT index %d',
{ JERR_EMPTY_IMAGE } 'Empty JPEG image (DNL not supported)',
{ JERR_EMS_READ } 'Read from EMS failed',
{ JERR_EMS_WRITE } 'Write to EMS failed',
{ JERR_EOI_EXPECTED } 'Didn''t expect more than one scan',
{ JERR_FILE_READ } 'Input file read error',
{ JERR_FILE_WRITE } 'Output file write error --- out of disk space?',
{ JERR_FRACT_SAMPLE_NOTIMPL } 'Fractional sampling not implemented yet',
{ JERR_HUFF_CLEN_OVERFLOW } 'Huffman code size table overflow',
{ JERR_HUFF_MISSING_CODE } 'Missing Huffman code table entry',
{ JERR_IMAGE_TOO_BIG } 'Maximum supported image dimension is %d pixels',
{ JERR_INPUT_EMPTY } 'Empty input file',
{ JERR_INPUT_EOF } 'Premature end of input file',
{ JERR_MISMATCHED_QUANT_TABLE }
'Cannot transcode due to multiple use of quantization table %d',
{ JERR_MISSING_DATA } 'Scan script does not transmit all data',
{ JERR_MODE_CHANGE } 'Invalid color quantization mode change',
{ JERR_NOTIMPL } 'Not implemented yet',
{ JERR_NOT_COMPILED } 'Requested feature was omitted at compile time',
{ JERR_NO_BACKING_STORE } 'Backing store not supported',
{ JERR_NO_HUFF_TABLE } 'Huffman table $%02x was not defined',
{ JERR_NO_IMAGE } 'JPEG datastream contains no image',
{ JERR_NO_QUANT_TABLE } 'Quantization table $%02x was not defined',
{ JERR_NO_SOI } 'Not a JPEG file: starts with $%02x $%02x',
{ JERR_OUT_OF_MEMORY } 'Insufficient memory (case %d)',
{ JERR_QUANT_COMPONENTS }
'Cannot quantize more than %d color components',
{ JERR_QUANT_FEW_COLORS } 'Cannot quantize to fewer 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_NO_SOS } 'Invalid JPEG file structure: missing SOS marker',
{ JERR_SOF_UNSUPPORTED } 'Unsupported JPEG process: SOF type $%02x',
{ JERR_SOI_DUPLICATE } 'Invalid JPEG file structure: two SOI markers',
{ JERR_SOS_NO_SOF } 'Invalid JPEG file structure: SOS before SOF',
{ JERR_TFILE_CREATE } 'Failed to create temporary file %s',
{ JERR_TFILE_READ } 'Read failed on temporary file',
{ JERR_TFILE_SEEK } 'Seek failed on temporary file',
{ JERR_TFILE_WRITE }
'Write failed on temporary file --- out of disk space?',
{ JERR_TOO_LITTLE_DATA } 'Application transferred too few scanlines',
{ JERR_UNKNOWN_MARKER } 'Unsupported marker type $%02x',
{ JERR_VIRTUAL_BUG } 'Virtual array controller messed up',
{ JERR_WIDTH_OVERFLOW } 'Image too wide for this implementation',
{ JERR_XMS_READ } 'Read from XMS failed',
{ JERR_XMS_WRITE } 'Write to XMS failed',
{ JMSG_COPYRIGHT } JCOPYRIGHT,
{ JMSG_VERSION } JVERSION,
{ JTRC_16BIT_TABLES }
'Caution: quantization tables are too coarse for baseline JPEG',
{ JTRC_ADOBE }
'Adobe APP14 marker: version %d, flags $%04x $%04x, transform %d',
{ JTRC_APP0 } 'Unknown APP0 marker (not JFIF), length %d',
{ JTRC_APP14 } 'Unknown APP14 marker (not Adobe), length %d',
{ JTRC_DAC } 'Define Arithmetic Table $%02x: $%02x',
{ JTRC_DHT } 'Define Huffman Table $%02x',
{ JTRC_DQT } 'Define Quantization Table %d precision %d',
{ JTRC_DRI } 'Define Restart Interval %d',
{ JTRC_EMS_CLOSE } 'Freed EMS handle %d',
{ JTRC_EMS_OPEN } 'Obtained EMS handle %d',
{ JTRC_EOI } 'End Of Image',
{ JTRC_HUFFBITS } ' %3d %3d %3d %3d %3d %3d %3d %3d',
{ JTRC_JFIF } 'JFIF APP0 marker, density %dx%d %d',
{ JTRC_JFIF_BADTHUMBNAILSIZE }
'Warning: thumbnail image size does not match data length %d',
{ JTRC_JFIF_EXTENSION } 'JFIF extension marker: type 0x%02x, length %u',
{ JTRC_JFIF_THUMBNAIL } ' with %d x %d thumbnail image',
{ JTRC_MISC_MARKER } 'Skipping marker $%02x, length %d',
{ JTRC_PARMLESS_MARKER } 'Unexpected marker $%02x',
{ JTRC_QUANTVALS } ' %4d %4d %4d %4d %4d %4d %4d %4d',
{ JTRC_QUANT_3_NCOLORS } 'Quantizing to %d = %d*%d*%d colors',
{ JTRC_QUANT_NCOLORS } 'Quantizing to %d colors',
{ JTRC_QUANT_SELECTED } 'Selected %d colors for quantization',
{ JTRC_RECOVERY_ACTION } 'At marker $%02x, recovery action %d',
{ JTRC_RST } 'RST%d',
{ JTRC_SMOOTH_NOTIMPL }
'Smoothing not supported with nonstandard sampling ratios',
{ JTRC_SOF } 'Start Of Frame $%02x: width=%d, height=%d, components=%d',
{ JTRC_SOF_COMPONENT } ' Component %d: %dhx%dv q=%d',
{ JTRC_SOI } 'Start of Image',
{ JTRC_SOS } 'Start Of Scan: %d components',
{ JTRC_SOS_COMPONENT } ' Component %d: dc=%d ac=%d',
{ JTRC_SOS_PARAMS } ' Ss=%d, Se=%d, Ah=%d, Al=%d',
{ JTRC_TFILE_CLOSE } 'Closed temporary file %s',
{ JTRC_TFILE_OPEN } 'Opened temporary file %s',
{ JTRC_THUMB_JPEG }
'JFIF extension marker: JPEG-compressed thumbnail image, length %u',
{ JMESSAGE(JTRC_THUMB_PALETTE }
'JFIF extension marker: palette thumbnail image, length %u',
{ JMESSAGE(JTRC_THUMB_RGB }
'JFIF extension marker: RGB thumbnail image, length %u',
{ JTRC_UNKNOWN_IDS }
'Unrecognized component IDs %d %d %d, assuming YCbCr',
{ JTRC_XMS_CLOSE } 'Freed XMS handle %d',
{ JTRC_XMS_OPEN } 'Obtained XMS handle %d',
{ JWRN_ADOBE_XFORM } 'Unknown Adobe color transform code %d',
{ JWRN_BOGUS_PROGRESSION }
'Inconsistent progression sequence for component %d coefficient %d',
{ JWRN_EXTRANEOUS_DATA }
'Corrupt JPEG data: %d extraneous bytes before marker $%02x',
{ JWRN_HIT_MARKER } 'Corrupt JPEG data: premature end of data segment',
{ JWRN_HUFF_BAD_CODE } 'Corrupt JPEG data: bad Huffman code',
{ JWRN_JFIF_MAJOR } 'Warning: unknown JFIF revision number %d.%02d',
{ JWRN_JPEG_EOF } 'Premature end of JPEG file',
{ JWRN_MUST_RESYNC }
'Corrupt JPEG data: found marker $%02x instead of RST%d',
{ JWRN_NOT_SEQUENTIAL } 'Invalid SOS parameters for sequential JPEG',
{ JWRN_TOO_MUCH_DATA } 'Application transferred too many scanlines',
{ JMSG_FIRSTADDONCODE } '', { Must be first entry! }
{$ifdef BMP_SUPPORTED}
{ JERR_BMP_BADCMAP } 'Unsupported BMP colormap format',
{ JERR_BMP_BADDEPTH } 'Only 8- and 24-bit BMP files are supported',
{ JERR_BMP_BADHEADER } 'Invalid BMP file: bad header length',
{ JERR_BMP_BADPLANES } 'Invalid BMP file: biPlanes not equal to 1',
{ JERR_BMP_COLORSPACE } 'BMP output must be grayscale or RGB',
{ JERR_BMP_COMPRESSED } 'Sorry, compressed BMPs not yet supported',
{ JERR_BMP_NOT } 'Not a BMP file - does not start with BM',
{ JTRC_BMP } '%dx%d 24-bit 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_MAPPED } '%dx%d 8-bit colormapped OS2 BMP image',
{$endif} { BMP_SUPPORTED }
{$ifdef GIF_SUPPORTED}
{ JERR_GIF_BUG } 'GIF output got confused',
{ JERR_GIF_CODESIZE } 'Bogus GIF codesize %d',
{ JERR_GIF_COLORSPACE } 'GIF output must be grayscale or RGB',
{ JERR_GIF_IMAGENOTFOUND } 'Too few images in GIF file',
{ JERR_GIF_NOT } 'Not a GIF file',
{ JTRC_GIF } '%dx%dx%d GIF image',
{ JTRC_GIF_BADVERSION }
'Warning: unexpected GIF version number "%c%c%c"',
{ JTRC_GIF_EXTENSION } 'Ignoring GIF extension block of type 0x%02x',
{ JTRC_GIF_NONSQUARE } 'Caution: nonsquare pixels in input',
{ JWRN_GIF_BADDATA } 'Corrupt data in GIF file',
{ JWRN_GIF_CHAR } 'Bogus char 0x%02x in GIF file, ignoring',
{ JWRN_GIF_ENDCODE } 'Premature end of GIF image',
{ JWRN_GIF_NOMOREDATA } 'Ran out of GIF bits',
{$endif} { GIF_SUPPORTED }
{$ifdef PPM_SUPPORTED}
{ JERR_PPM_COLORSPACE } 'PPM output must be grayscale or RGB',
{ JERR_PPM_NONNUMERIC } 'Nonnumeric data in PPM file',
{ JERR_PPM_NOT } 'Not a PPM file',
{ JTRC_PGM } '%dx%d PGM image',
{ JTRC_PGM_TEXT } '%dx%d text PGM image',
{ JTRC_PPM } '%dx%d PPM image',
{ JTRC_PPM_TEXT } '%dx%d text PPM image',
{$endif} { PPM_SUPPORTED }
{$ifdef RLE_SUPPORTED}
{ JERR_RLE_BADERROR } 'Bogus error code from RLE library',
{ JERR_RLE_COLORSPACE } 'RLE output must be grayscale or RGB',
{ JERR_RLE_DIMENSIONS } 'Image dimensions (%dx%d) too large for RLE',
{ JERR_RLE_EMPTY } 'Empty RLE file',
{ JERR_RLE_EOF } 'Premature EOF in RLE header',
{ JERR_RLE_MEM } 'Insufficient memory for RLE header',
{ JERR_RLE_NOT } 'Not an RLE file',
{ JERR_RLE_TOOMANYCHANNELS } 'Cannot handle %d output channels for RLE',
{ JERR_RLE_UNSUPPORTED } 'Cannot handle this RLE setup',
{ JTRC_RLE } '%dx%d full-color RLE file',
{ JTRC_RLE_FULLMAP } '%dx%d full-color RLE file with map of length %d',
{ JTRC_RLE_GRAY } '%dx%d grayscale RLE file',
{ 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',
{$endif} { RLE_SUPPORTED }
{$ifdef TARGA_SUPPORTED}
{ JERR_TGA_BADCMAP } 'Unsupported Targa colormap format',
{ JERR_TGA_BADPARMS } 'Invalid or unsupported Targa file',
{ JERR_TGA_COLORSPACE } 'Targa output must be grayscale or RGB',
{ JTRC_TGA } '%dx%d RGB Targa image',
{ JTRC_TGA_GRAY } '%dx%d grayscale Targa image',
{ JTRC_TGA_MAPPED } '%dx%d colormapped Targa image',
{$else}
{ JERR_TGA_NOTCOMP } 'Targa support was not compiled',
{$endif} { TARGA_SUPPORTED }
{ JERR_BAD_CMAP_FILE }
'Color map file is invalid or of unsupported format',
{ JERR_TOO_MANY_COLORS }
'Output file format cannot handle %d colormap entries',
{ JERR_UNGETC_FAILED } 'ungetc failed',
{$ifdef TARGA_SUPPORTED}
{ JERR_UNKNOWN_FORMAT }
'Unrecognized input file format --- perhaps you need -targa',
{$else}
{ JERR_UNKNOWN_FORMAT } 'Unrecognized input file format',
{$endif}
{ JERR_UNSUPPORTED_FORMAT } 'Unsupported output file format',
{ JMSG_LASTADDONCODE } '');
implementation
end.
unit imjdeferr;
{ This file defines the error and message codes for the cjpeg/djpeg
applications. These strings are not needed as part of the JPEG library
proper.
Edit this file to add new codes, or to translate the message strings to
some other language. }
{ Original cderror.h ; Copyright (C) 1994, Thomas G. Lane. }
interface
{$I imjconfig.inc}
{ To define the enum list of message codes, include this file without
defining macro JMESSAGE. To create a message string table, include it
again with a suitable JMESSAGE definition (see jerror.c for an example). }
{ Original: jversion.h ; Copyright (C) 1991-1996, Thomas G. Lane. }
{ This file contains software version identification. }
const
JVERSION = '6a 7-Feb-96';
JCOPYRIGHT = 'Copyright (C) 1996, Thomas G. Lane';
JNOTICE = 'Pascal Translation, Copyright (C) 1996, Jacques Nomssi Nzali';
{ Create the message string table.
We do this from the master message list in jerror.h by re-reading
jerror.h with a suitable definition for macro JMESSAGE.
The message table is made an external symbol just in case any applications
want to refer to it directly. }
type
J_MESSAGE_CODE =(
JMSG_NOMESSAGE,
JERR_ARITH_NOTIMPL,
JERR_BAD_ALIGN_TYPE,
JERR_BAD_ALLOC_CHUNK,
JERR_BAD_BUFFER_MODE,
JERR_BAD_COMPONENT_ID,
JERR_BAD_DCT_COEF,
JERR_BAD_DCTSIZE,
JERR_BAD_HUFF_TABLE,
JERR_BAD_IN_COLORSPACE,
JERR_BAD_J_COLORSPACE,
JERR_BAD_LENGTH,
JERR_BAD_LIB_VERSION,
JERR_BAD_MCU_SIZE,
JERR_BAD_POOL_ID,
JERR_BAD_PRECISION,
JERR_BAD_PROGRESSION,
JERR_BAD_PROG_SCRIPT,
JERR_BAD_SAMPLING,
JERR_BAD_SCAN_SCRIPT,
JERR_BAD_STATE,
JERR_BAD_STRUCT_SIZE,
JERR_BAD_VIRTUAL_ACCESS,
JERR_BUFFER_SIZE,
JERR_CANT_SUSPEND,
JERR_CCIR601_NOTIMPL,
JERR_COMPONENT_COUNT,
JERR_CONVERSION_NOTIMPL,
JERR_DAC_INDEX,
JERR_DAC_VALUE,
JERR_DHT_COUNTS,
JERR_DHT_INDEX,
JERR_DQT_INDEX,
JERR_EMPTY_IMAGE,
JERR_EMS_READ,
JERR_EMS_WRITE,
JERR_EOI_EXPECTED,
JERR_FILE_READ,
JERR_FILE_WRITE,
JERR_FRACT_SAMPLE_NOTIMPL,
JERR_HUFF_CLEN_OVERFLOW,
JERR_HUFF_MISSING_CODE,
JERR_IMAGE_TOO_BIG,
JERR_INPUT_EMPTY,
JERR_INPUT_EOF,
JERR_MISMATCHED_QUANT_TABLE,
JERR_MISSING_DATA,
JERR_MODE_CHANGE,
JERR_NOTIMPL,
JERR_NOT_COMPILED,
JERR_NO_BACKING_STORE,
JERR_NO_HUFF_TABLE,
JERR_NO_IMAGE,
JERR_NO_QUANT_TABLE,
JERR_NO_SOI,
JERR_OUT_OF_MEMORY,
JERR_QUANT_COMPONENTS,
JERR_QUANT_FEW_COLORS,
JERR_QUANT_MANY_COLORS,
JERR_SOF_DUPLICATE,
JERR_SOF_NO_SOS,
JERR_SOF_UNSUPPORTED,
JERR_SOI_DUPLICATE,
JERR_SOS_NO_SOF,
JERR_TFILE_CREATE,
JERR_TFILE_READ,
JERR_TFILE_SEEK,
JERR_TFILE_WRITE,
JERR_TOO_LITTLE_DATA,
JERR_UNKNOWN_MARKER,
JERR_VIRTUAL_BUG,
JERR_WIDTH_OVERFLOW,
JERR_XMS_READ,
JERR_XMS_WRITE,
JMSG_COPYRIGHT,
JMSG_VERSION,
JTRC_16BIT_TABLES,
JTRC_ADOBE,
JTRC_APP0,
JTRC_APP14,
JTRC_DAC,
JTRC_DHT,
JTRC_DQT,
JTRC_DRI,
JTRC_EMS_CLOSE,
JTRC_EMS_OPEN,
JTRC_EOI,
JTRC_HUFFBITS,
JTRC_JFIF,
JTRC_JFIF_BADTHUMBNAILSIZE,
JTRC_JFIF_EXTENSION,
JTRC_JFIF_THUMBNAIL,
JTRC_MISC_MARKER,
JTRC_PARMLESS_MARKER,
JTRC_QUANTVALS,
JTRC_QUANT_3_NCOLORS,
JTRC_QUANT_NCOLORS,
JTRC_QUANT_SELECTED,
JTRC_RECOVERY_ACTION,
JTRC_RST,
JTRC_SMOOTH_NOTIMPL,
JTRC_SOF,
JTRC_SOF_COMPONENT,
JTRC_SOI,
JTRC_SOS,
JTRC_SOS_COMPONENT,
JTRC_SOS_PARAMS,
JTRC_TFILE_CLOSE,
JTRC_TFILE_OPEN,
JTRC_THUMB_JPEG,
JTRC_THUMB_PALETTE,
JTRC_THUMB_RGB,
JTRC_UNKNOWN_IDS,
JTRC_XMS_CLOSE,
JTRC_XMS_OPEN,
JWRN_ADOBE_XFORM,
JWRN_BOGUS_PROGRESSION,
JWRN_EXTRANEOUS_DATA,
JWRN_HIT_MARKER,
JWRN_HUFF_BAD_CODE,
JWRN_JFIF_MAJOR,
JWRN_JPEG_EOF,
JWRN_MUST_RESYNC,
JWRN_NOT_SEQUENTIAL,
JWRN_TOO_MUCH_DATA,
JMSG_FIRSTADDONCODE, { Must be first entry! }
{$ifdef BMP_SUPPORTED}
JERR_BMP_BADCMAP, { Unsupported BMP colormap format }
JERR_BMP_BADDEPTH, { Only 8- and 24-bit BMP files are supported }
JERR_BMP_BADHEADER, { Invalid BMP file: bad header length }
JERR_BMP_BADPLANES, { Invalid BMP file: biPlanes not equal to 1 }
JERR_BMP_COLORSPACE, { BMP output must be grayscale or RGB }
JERR_BMP_COMPRESSED, { Sorry, compressed BMPs not yet supported }
JERR_BMP_NOT, { Not a BMP file - does not start with BM }
JTRC_BMP, { %dx%d 24-bit 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_MAPPED, { %dx%d 8-bit colormapped OS2 BMP image }
{$endif} { BMP_SUPPORTED }
{$ifdef GIF_SUPPORTED}
JERR_GIF_BUG, { GIF output got confused }
JERR_GIF_CODESIZE, { Bogus GIF codesize %d }
JERR_GIF_COLORSPACE, { GIF output must be grayscale or RGB }
JERR_GIF_IMAGENOTFOUND, { Too few images in GIF file }
JERR_GIF_NOT, { Not a GIF file }
JTRC_GIF, { %dx%dx%d GIF image }
JTRC_GIF_BADVERSION,
{ Warning: unexpected GIF version number '%c%c%c' }
JTRC_GIF_EXTENSION, { Ignoring GIF extension block of type 0x%02x }
JTRC_GIF_NONSQUARE, { Caution: nonsquare pixels in input }
JWRN_GIF_BADDATA, { Corrupt data in GIF file }
JWRN_GIF_CHAR, { Bogus char 0x%02x in GIF file, ignoring }
JWRN_GIF_ENDCODE, { Premature end of GIF image }
JWRN_GIF_NOMOREDATA, { Ran out of GIF bits }
{$endif} { GIF_SUPPORTED }
{$ifdef PPM_SUPPORTED}
JERR_PPM_COLORSPACE, { PPM output must be grayscale or RGB }
JERR_PPM_NONNUMERIC, { Nonnumeric data in PPM file }
JERR_PPM_NOT, { Not a PPM file }
JTRC_PGM, { %dx%d PGM image }
JTRC_PGM_TEXT, { %dx%d text PGM image }
JTRC_PPM, { %dx%d PPM image }
JTRC_PPM_TEXT, { %dx%d text PPM image }
{$endif} { PPM_SUPPORTED }
{$ifdef RLE_SUPPORTED}
JERR_RLE_BADERROR, { Bogus error code from RLE library }
JERR_RLE_COLORSPACE, { RLE output must be grayscale or RGB }
JERR_RLE_DIMENSIONS, { Image dimensions (%dx%d) too large for RLE }
JERR_RLE_EMPTY, { Empty RLE file }
JERR_RLE_EOF, { Premature EOF in RLE header }
JERR_RLE_MEM, { Insufficient memory for RLE header }
JERR_RLE_NOT, { Not an RLE file }
JERR_RLE_TOOMANYCHANNELS, { Cannot handle %d output channels for RLE }
JERR_RLE_UNSUPPORTED, { Cannot handle this RLE setup }
JTRC_RLE, { %dx%d full-color RLE file }
JTRC_RLE_FULLMAP, { %dx%d full-color RLE file with map of length %d }
JTRC_RLE_GRAY, { %dx%d grayscale RLE file }
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 }
{$endif} { RLE_SUPPORTED }
{$ifdef TARGA_SUPPORTED}
JERR_TGA_BADCMAP, { Unsupported Targa colormap format }
JERR_TGA_BADPARMS, { Invalid or unsupported Targa file }
JERR_TGA_COLORSPACE, { Targa output must be grayscale or RGB }
JTRC_TGA, { %dx%d RGB Targa image }
JTRC_TGA_GRAY, { %dx%d grayscale Targa image }
JTRC_TGA_MAPPED, { %dx%d colormapped Targa image }
{$else}
JERR_TGA_NOTCOMP, { Targa support was not compiled }
{$endif} { TARGA_SUPPORTED }
JERR_BAD_CMAP_FILE,
{ Color map file is invalid or of unsupported format }
JERR_TOO_MANY_COLORS,
{ Output file format cannot handle %d colormap entries }
JERR_UNGETC_FAILED, { ungetc failed }
{$ifdef TARGA_SUPPORTED}
JERR_UNKNOWN_FORMAT,
{ Unrecognized input file format --- perhaps you need -targa }
{$else}
JERR_UNKNOWN_FORMAT, { Unrecognized input file format }
{$endif}
JERR_UNSUPPORTED_FORMAT, { Unsupported output file format }
JMSG_LASTADDONCODE
);
const
JMSG_LASTMSGCODE : J_MESSAGE_CODE = JMSG_LASTADDONCODE;
type
msg_table = Array[J_MESSAGE_CODE] of string[80];
const
jpeg_std_message_table : msg_table = (
{ JMSG_NOMESSAGE } 'Bogus message code %d', { Must be first entry! }
{ For maintenance convenience, list is alphabetical by message code name }
{ JERR_ARITH_NOTIMPL }
'Sorry, there are legal restrictions on arithmetic coding',
{ JERR_BAD_ALIGN_TYPE } 'ALIGN_TYPE 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_COMPONENT_ID } 'Invalid component ID %d in SOS',
{ JERR_BAD_DCT_COEF } 'DCT coefficient out of range',
{ JERR_BAD_DCTSIZE } 'IDCT output block size %d not supported',
{ JERR_BAD_HUFF_TABLE } 'Bogus Huffman table definition',
{ JERR_BAD_IN_COLORSPACE } 'Bogus input colorspace',
{ JERR_BAD_J_COLORSPACE } 'Bogus JPEG colorspace',
{ JERR_BAD_LENGTH } 'Bogus marker length',
{ JERR_BAD_LIB_VERSION }
'Wrong JPEG library version: library is %d, caller expects %d',
{ JERR_BAD_MCU_SIZE } 'Sampling factors too large for interleaved scan',
{ JERR_BAD_POOL_ID } 'Invalid memory pool code %d',
{ JERR_BAD_PRECISION } 'Unsupported JPEG data precision %d',
{ JERR_BAD_PROGRESSION }
'Invalid progressive parameters Ss=%d Se=%d Ah=%d Al=%d',
{ JERR_BAD_PROG_SCRIPT }
'Invalid progressive parameters at scan script entry %d',
{ JERR_BAD_SAMPLING } 'Bogus sampling factors',
{ JERR_BAD_SCAN_SCRIPT } 'Invalid scan script at entry %d',
{ JERR_BAD_STATE } 'Improper call to JPEG library in state %d',
{ JERR_BAD_STRUCT_SIZE }
'JPEG parameter struct mismatch: library thinks size is %d, caller expects %d',
{ JERR_BAD_VIRTUAL_ACCESS } 'Bogus virtual array access',
{ JERR_BUFFER_SIZE } 'Buffer passed to JPEG library is too small',
{ JERR_CANT_SUSPEND } 'Suspension not allowed here',
{ JERR_CCIR601_NOTIMPL } 'CCIR601 sampling not implemented yet',
{ JERR_COMPONENT_COUNT } 'Too many color components: %d, max %d',
{ JERR_CONVERSION_NOTIMPL } 'Unsupported color conversion request',
{ JERR_DAC_INDEX } 'Bogus DAC index %d',
{ JERR_DAC_VALUE } 'Bogus DAC value $%x',
{ JERR_DHT_COUNTS } 'Bogus DHT counts',
{ JERR_DHT_INDEX } 'Bogus DHT index %d',
{ JERR_DQT_INDEX } 'Bogus DQT index %d',
{ JERR_EMPTY_IMAGE } 'Empty JPEG image (DNL not supported)',
{ JERR_EMS_READ } 'Read from EMS failed',
{ JERR_EMS_WRITE } 'Write to EMS failed',
{ JERR_EOI_EXPECTED } 'Didn''t expect more than one scan',
{ JERR_FILE_READ } 'Input file read error',
{ JERR_FILE_WRITE } 'Output file write error --- out of disk space?',
{ JERR_FRACT_SAMPLE_NOTIMPL } 'Fractional sampling not implemented yet',
{ JERR_HUFF_CLEN_OVERFLOW } 'Huffman code size table overflow',
{ JERR_HUFF_MISSING_CODE } 'Missing Huffman code table entry',
{ JERR_IMAGE_TOO_BIG } 'Maximum supported image dimension is %d pixels',
{ JERR_INPUT_EMPTY } 'Empty input file',
{ JERR_INPUT_EOF } 'Premature end of input file',
{ JERR_MISMATCHED_QUANT_TABLE }
'Cannot transcode due to multiple use of quantization table %d',
{ JERR_MISSING_DATA } 'Scan script does not transmit all data',
{ JERR_MODE_CHANGE } 'Invalid color quantization mode change',
{ JERR_NOTIMPL } 'Not implemented yet',
{ JERR_NOT_COMPILED } 'Requested feature was omitted at compile time',
{ JERR_NO_BACKING_STORE } 'Backing store not supported',
{ JERR_NO_HUFF_TABLE } 'Huffman table $%02x was not defined',
{ JERR_NO_IMAGE } 'JPEG datastream contains no image',
{ JERR_NO_QUANT_TABLE } 'Quantization table $%02x was not defined',
{ JERR_NO_SOI } 'Not a JPEG file: starts with $%02x $%02x',
{ JERR_OUT_OF_MEMORY } 'Insufficient memory (case %d)',
{ JERR_QUANT_COMPONENTS }
'Cannot quantize more than %d color components',
{ JERR_QUANT_FEW_COLORS } 'Cannot quantize to fewer 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_NO_SOS } 'Invalid JPEG file structure: missing SOS marker',
{ JERR_SOF_UNSUPPORTED } 'Unsupported JPEG process: SOF type $%02x',
{ JERR_SOI_DUPLICATE } 'Invalid JPEG file structure: two SOI markers',
{ JERR_SOS_NO_SOF } 'Invalid JPEG file structure: SOS before SOF',
{ JERR_TFILE_CREATE } 'Failed to create temporary file %s',
{ JERR_TFILE_READ } 'Read failed on temporary file',
{ JERR_TFILE_SEEK } 'Seek failed on temporary file',
{ JERR_TFILE_WRITE }
'Write failed on temporary file --- out of disk space?',
{ JERR_TOO_LITTLE_DATA } 'Application transferred too few scanlines',
{ JERR_UNKNOWN_MARKER } 'Unsupported marker type $%02x',
{ JERR_VIRTUAL_BUG } 'Virtual array controller messed up',
{ JERR_WIDTH_OVERFLOW } 'Image too wide for this implementation',
{ JERR_XMS_READ } 'Read from XMS failed',
{ JERR_XMS_WRITE } 'Write to XMS failed',
{ JMSG_COPYRIGHT } JCOPYRIGHT,
{ JMSG_VERSION } JVERSION,
{ JTRC_16BIT_TABLES }
'Caution: quantization tables are too coarse for baseline JPEG',
{ JTRC_ADOBE }
'Adobe APP14 marker: version %d, flags $%04x $%04x, transform %d',
{ JTRC_APP0 } 'Unknown APP0 marker (not JFIF), length %d',
{ JTRC_APP14 } 'Unknown APP14 marker (not Adobe), length %d',
{ JTRC_DAC } 'Define Arithmetic Table $%02x: $%02x',
{ JTRC_DHT } 'Define Huffman Table $%02x',
{ JTRC_DQT } 'Define Quantization Table %d precision %d',
{ JTRC_DRI } 'Define Restart Interval %d',
{ JTRC_EMS_CLOSE } 'Freed EMS handle %d',
{ JTRC_EMS_OPEN } 'Obtained EMS handle %d',
{ JTRC_EOI } 'End Of Image',
{ JTRC_HUFFBITS } ' %3d %3d %3d %3d %3d %3d %3d %3d',
{ JTRC_JFIF } 'JFIF APP0 marker, density %dx%d %d',
{ JTRC_JFIF_BADTHUMBNAILSIZE }
'Warning: thumbnail image size does not match data length %d',
{ JTRC_JFIF_EXTENSION } 'JFIF extension marker: type 0x%02x, length %u',
{ JTRC_JFIF_THUMBNAIL } ' with %d x %d thumbnail image',
{ JTRC_MISC_MARKER } 'Skipping marker $%02x, length %d',
{ JTRC_PARMLESS_MARKER } 'Unexpected marker $%02x',
{ JTRC_QUANTVALS } ' %4d %4d %4d %4d %4d %4d %4d %4d',
{ JTRC_QUANT_3_NCOLORS } 'Quantizing to %d = %d*%d*%d colors',
{ JTRC_QUANT_NCOLORS } 'Quantizing to %d colors',
{ JTRC_QUANT_SELECTED } 'Selected %d colors for quantization',
{ JTRC_RECOVERY_ACTION } 'At marker $%02x, recovery action %d',
{ JTRC_RST } 'RST%d',
{ JTRC_SMOOTH_NOTIMPL }
'Smoothing not supported with nonstandard sampling ratios',
{ JTRC_SOF } 'Start Of Frame $%02x: width=%d, height=%d, components=%d',
{ JTRC_SOF_COMPONENT } ' Component %d: %dhx%dv q=%d',
{ JTRC_SOI } 'Start of Image',
{ JTRC_SOS } 'Start Of Scan: %d components',
{ JTRC_SOS_COMPONENT } ' Component %d: dc=%d ac=%d',
{ JTRC_SOS_PARAMS } ' Ss=%d, Se=%d, Ah=%d, Al=%d',
{ JTRC_TFILE_CLOSE } 'Closed temporary file %s',
{ JTRC_TFILE_OPEN } 'Opened temporary file %s',
{ JTRC_THUMB_JPEG }
'JFIF extension marker: JPEG-compressed thumbnail image, length %u',
{ JMESSAGE(JTRC_THUMB_PALETTE }
'JFIF extension marker: palette thumbnail image, length %u',
{ JMESSAGE(JTRC_THUMB_RGB }
'JFIF extension marker: RGB thumbnail image, length %u',
{ JTRC_UNKNOWN_IDS }
'Unrecognized component IDs %d %d %d, assuming YCbCr',
{ JTRC_XMS_CLOSE } 'Freed XMS handle %d',
{ JTRC_XMS_OPEN } 'Obtained XMS handle %d',
{ JWRN_ADOBE_XFORM } 'Unknown Adobe color transform code %d',
{ JWRN_BOGUS_PROGRESSION }
'Inconsistent progression sequence for component %d coefficient %d',
{ JWRN_EXTRANEOUS_DATA }
'Corrupt JPEG data: %d extraneous bytes before marker $%02x',
{ JWRN_HIT_MARKER } 'Corrupt JPEG data: premature end of data segment',
{ JWRN_HUFF_BAD_CODE } 'Corrupt JPEG data: bad Huffman code',
{ JWRN_JFIF_MAJOR } 'Warning: unknown JFIF revision number %d.%02d',
{ JWRN_JPEG_EOF } 'Premature end of JPEG file',
{ JWRN_MUST_RESYNC }
'Corrupt JPEG data: found marker $%02x instead of RST%d',
{ JWRN_NOT_SEQUENTIAL } 'Invalid SOS parameters for sequential JPEG',
{ JWRN_TOO_MUCH_DATA } 'Application transferred too many scanlines',
{ JMSG_FIRSTADDONCODE } '', { Must be first entry! }
{$ifdef BMP_SUPPORTED}
{ JERR_BMP_BADCMAP } 'Unsupported BMP colormap format',
{ JERR_BMP_BADDEPTH } 'Only 8- and 24-bit BMP files are supported',
{ JERR_BMP_BADHEADER } 'Invalid BMP file: bad header length',
{ JERR_BMP_BADPLANES } 'Invalid BMP file: biPlanes not equal to 1',
{ JERR_BMP_COLORSPACE } 'BMP output must be grayscale or RGB',
{ JERR_BMP_COMPRESSED } 'Sorry, compressed BMPs not yet supported',
{ JERR_BMP_NOT } 'Not a BMP file - does not start with BM',
{ JTRC_BMP } '%dx%d 24-bit 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_MAPPED } '%dx%d 8-bit colormapped OS2 BMP image',
{$endif} { BMP_SUPPORTED }
{$ifdef GIF_SUPPORTED}
{ JERR_GIF_BUG } 'GIF output got confused',
{ JERR_GIF_CODESIZE } 'Bogus GIF codesize %d',
{ JERR_GIF_COLORSPACE } 'GIF output must be grayscale or RGB',
{ JERR_GIF_IMAGENOTFOUND } 'Too few images in GIF file',
{ JERR_GIF_NOT } 'Not a GIF file',
{ JTRC_GIF } '%dx%dx%d GIF image',
{ JTRC_GIF_BADVERSION }
'Warning: unexpected GIF version number "%c%c%c"',
{ JTRC_GIF_EXTENSION } 'Ignoring GIF extension block of type 0x%02x',
{ JTRC_GIF_NONSQUARE } 'Caution: nonsquare pixels in input',
{ JWRN_GIF_BADDATA } 'Corrupt data in GIF file',
{ JWRN_GIF_CHAR } 'Bogus char 0x%02x in GIF file, ignoring',
{ JWRN_GIF_ENDCODE } 'Premature end of GIF image',
{ JWRN_GIF_NOMOREDATA } 'Ran out of GIF bits',
{$endif} { GIF_SUPPORTED }
{$ifdef PPM_SUPPORTED}
{ JERR_PPM_COLORSPACE } 'PPM output must be grayscale or RGB',
{ JERR_PPM_NONNUMERIC } 'Nonnumeric data in PPM file',
{ JERR_PPM_NOT } 'Not a PPM file',
{ JTRC_PGM } '%dx%d PGM image',
{ JTRC_PGM_TEXT } '%dx%d text PGM image',
{ JTRC_PPM } '%dx%d PPM image',
{ JTRC_PPM_TEXT } '%dx%d text PPM image',
{$endif} { PPM_SUPPORTED }
{$ifdef RLE_SUPPORTED}
{ JERR_RLE_BADERROR } 'Bogus error code from RLE library',
{ JERR_RLE_COLORSPACE } 'RLE output must be grayscale or RGB',
{ JERR_RLE_DIMENSIONS } 'Image dimensions (%dx%d) too large for RLE',
{ JERR_RLE_EMPTY } 'Empty RLE file',
{ JERR_RLE_EOF } 'Premature EOF in RLE header',
{ JERR_RLE_MEM } 'Insufficient memory for RLE header',
{ JERR_RLE_NOT } 'Not an RLE file',
{ JERR_RLE_TOOMANYCHANNELS } 'Cannot handle %d output channels for RLE',
{ JERR_RLE_UNSUPPORTED } 'Cannot handle this RLE setup',
{ JTRC_RLE } '%dx%d full-color RLE file',
{ JTRC_RLE_FULLMAP } '%dx%d full-color RLE file with map of length %d',
{ JTRC_RLE_GRAY } '%dx%d grayscale RLE file',
{ 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',
{$endif} { RLE_SUPPORTED }
{$ifdef TARGA_SUPPORTED}
{ JERR_TGA_BADCMAP } 'Unsupported Targa colormap format',
{ JERR_TGA_BADPARMS } 'Invalid or unsupported Targa file',
{ JERR_TGA_COLORSPACE } 'Targa output must be grayscale or RGB',
{ JTRC_TGA } '%dx%d RGB Targa image',
{ JTRC_TGA_GRAY } '%dx%d grayscale Targa image',
{ JTRC_TGA_MAPPED } '%dx%d colormapped Targa image',
{$else}
{ JERR_TGA_NOTCOMP } 'Targa support was not compiled',
{$endif} { TARGA_SUPPORTED }
{ JERR_BAD_CMAP_FILE }
'Color map file is invalid or of unsupported format',
{ JERR_TOO_MANY_COLORS }
'Output file format cannot handle %d colormap entries',
{ JERR_UNGETC_FAILED } 'ungetc failed',
{$ifdef TARGA_SUPPORTED}
{ JERR_UNKNOWN_FORMAT }
'Unrecognized input file format --- perhaps you need -targa',
{$else}
{ JERR_UNKNOWN_FORMAT } 'Unrecognized input file format',
{$endif}
{ JERR_UNSUPPORTED_FORMAT } 'Unsupported output file format',
{ JMSG_LASTADDONCODE } '');
implementation
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;
{ Original: jdinput.c ; Copyright (C) 1991-1997, Thomas G. Lane. }
{ This file is part of the Independent JPEG Group's software.
For conditions of distribution and use, see the accompanying README file.
This file contains input control logic for the JPEG decompressor.
These routines are concerned with controlling the decompressor's input
processing (marker reading and coefficient decoding). The actual input
reading is done in jdmarker.c, jdhuff.c, and jdphuff.c. }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjpeglib,
imjdeferr,
imjerror,
imjinclude, imjutils;
{ Initialize the input controller module.
This is called only once, when the decompression object is created. }
{GLOBAL}
procedure jinit_input_controller (cinfo : j_decompress_ptr);
implementation
{ Private state }
type
my_inputctl_ptr = ^my_input_controller;
my_input_controller = record
pub : jpeg_input_controller; { public fields }
inheaders : boolean; { TRUE until first SOS is reached }
end; {my_input_controller;}
{ Forward declarations }
{METHODDEF}
function consume_markers (cinfo : j_decompress_ptr) : int; forward;
{ Routines to calculate various quantities related to the size of the image. }
{LOCAL}
procedure initial_setup (cinfo : j_decompress_ptr);
{ Called once, when first SOS marker is reached }
var
ci : int;
compptr : jpeg_component_info_ptr;
begin
{ Make sure image isn't bigger than I can handle }
if (long(cinfo^.image_height) > long (JPEG_MAX_DIMENSION)) or
(long(cinfo^.image_width) > long(JPEG_MAX_DIMENSION)) then
ERREXIT1(j_common_ptr(cinfo), JERR_IMAGE_TOO_BIG, uInt(JPEG_MAX_DIMENSION));
{ For now, precision must match compiled-in value... }
if (cinfo^.data_precision <> BITS_IN_JSAMPLE) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PRECISION, cinfo^.data_precision);
{ Check that number of components won't exceed internal array sizes }
if (cinfo^.num_components > MAX_COMPONENTS) then
ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, cinfo^.num_components,
MAX_COMPONENTS);
{ Compute maximum sampling factors; check factor validity }
cinfo^.max_h_samp_factor := 1;
cinfo^.max_v_samp_factor := 1;
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
for ci := 0 to pred(cinfo^.num_components) do
begin
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
ERREXIT(j_common_ptr(cinfo), JERR_BAD_SAMPLING);
{cinfo^.max_h_samp_factor := MAX(cinfo^.max_h_samp_factor,
compptr^.h_samp_factor);
cinfo^.max_v_samp_factor := MAX(cinfo^.max_v_samp_factor,
compptr^.v_samp_factor);}
if cinfo^.max_h_samp_factor < compptr^.h_samp_factor then
cinfo^.max_h_samp_factor := compptr^.h_samp_factor;
if cinfo^.max_v_samp_factor < compptr^.v_samp_factor then
cinfo^.max_v_samp_factor := compptr^.v_samp_factor;
Inc(compptr);
end;
{ We initialize DCT_scaled_size and min_DCT_scaled_size to DCTSIZE.
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. }
cinfo^.min_DCT_scaled_size := DCTSIZE;
{ Compute dimensions of components }
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
for ci := 0 to pred(cinfo^.num_components) do
begin
compptr^.DCT_scaled_size := DCTSIZE;
{ Size in DCT blocks }
compptr^.width_in_blocks := JDIMENSION(
jdiv_round_up( long(cinfo^.image_width) * long(compptr^.h_samp_factor),
long(cinfo^.max_h_samp_factor * DCTSIZE)) );
compptr^.height_in_blocks := JDIMENSION (
jdiv_round_up(long (cinfo^.image_height) * long(compptr^.v_samp_factor),
long (cinfo^.max_v_samp_factor * DCTSIZE)) );
{ downsampled_width and downsampled_height will also be overridden by
jdmaster.c if we are doing full decompression. The transcoder library
doesn't use these values, but the calling application might. }
{ Size in samples }
compptr^.downsampled_width := JDIMENSION (
jdiv_round_up(long (cinfo^.image_width) * long(compptr^.h_samp_factor),
long (cinfo^.max_h_samp_factor)) );
compptr^.downsampled_height := JDIMENSION (
jdiv_round_up(long (cinfo^.image_height) * long(compptr^.v_samp_factor),
long (cinfo^.max_v_samp_factor)) );
{ Mark component needed, until color conversion says otherwise }
compptr^.component_needed := TRUE;
{ Mark no quantization table yet saved for component }
compptr^.quant_table := NIL;
Inc(compptr);
end;
{ Compute number of fully interleaved MCU rows. }
cinfo^.total_iMCU_rows := JDIMENSION(
jdiv_round_up(long(cinfo^.image_height),
long(cinfo^.max_v_samp_factor*DCTSIZE)) );
{ Decide whether file contains multiple scans }
if (cinfo^.comps_in_scan < cinfo^.num_components) or
(cinfo^.progressive_mode) then
cinfo^.inputctl^.has_multiple_scans := TRUE
else
cinfo^.inputctl^.has_multiple_scans := FALSE;
end;
{LOCAL}
procedure per_scan_setup (cinfo : j_decompress_ptr);
{ Do computations that are needed before processing a JPEG scan }
{ cinfo^.comps_in_scan and cinfo^.cur_comp_info[] were set from SOS marker }
var
ci, mcublks, tmp : int;
compptr : jpeg_component_info_ptr;
begin
if (cinfo^.comps_in_scan = 1) then
begin
{ Noninterleaved (single-component) scan }
compptr := cinfo^.cur_comp_info[0];
{ Overall image size in MCUs }
cinfo^.MCUs_per_row := compptr^.width_in_blocks;
cinfo^.MCU_rows_in_scan := compptr^.height_in_blocks;
{ For noninterleaved scan, always one block per MCU }
compptr^.MCU_width := 1;
compptr^.MCU_height := 1;
compptr^.MCU_blocks := 1;
compptr^.MCU_sample_width := compptr^.DCT_scaled_size;
compptr^.last_col_width := 1;
{ For noninterleaved scans, it is convenient to define last_row_height
as the number of block rows present in the last iMCU row. }
tmp := int (LongInt(compptr^.height_in_blocks) mod compptr^.v_samp_factor);
if (tmp = 0) then
tmp := compptr^.v_samp_factor;
compptr^.last_row_height := tmp;
{ Prepare array describing MCU composition }
cinfo^.blocks_in_MCU := 1;
cinfo^.MCU_membership[0] := 0;
end
else
begin
{ Interleaved (multi-component) scan }
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,
MAX_COMPS_IN_SCAN);
{ Overall image size in MCUs }
cinfo^.MCUs_per_row := JDIMENSION (
jdiv_round_up(long (cinfo^.image_width),
long (cinfo^.max_h_samp_factor*DCTSIZE)) );
cinfo^.MCU_rows_in_scan := JDIMENSION (
jdiv_round_up(long (cinfo^.image_height),
long (cinfo^.max_v_samp_factor*DCTSIZE)) );
cinfo^.blocks_in_MCU := 0;
for ci := 0 to pred(cinfo^.comps_in_scan) do
begin
compptr := cinfo^.cur_comp_info[ci];
{ Sampling factors give # of blocks of component in each MCU }
compptr^.MCU_width := compptr^.h_samp_factor;
compptr^.MCU_height := compptr^.v_samp_factor;
compptr^.MCU_blocks := compptr^.MCU_width * compptr^.MCU_height;
compptr^.MCU_sample_width := compptr^.MCU_width * compptr^.DCT_scaled_size;
{ Figure number of non-dummy blocks in last MCU column & row }
tmp := int (LongInt(compptr^.width_in_blocks) mod compptr^.MCU_width);
if (tmp = 0) then
tmp := compptr^.MCU_width;
compptr^.last_col_width := tmp;
tmp := int (LongInt(compptr^.height_in_blocks) mod compptr^.MCU_height);
if (tmp = 0) then
tmp := compptr^.MCU_height;
compptr^.last_row_height := tmp;
{ Prepare array describing MCU composition }
mcublks := compptr^.MCU_blocks;
if (LongInt(cinfo^.blocks_in_MCU) + mcublks > D_MAX_BLOCKS_IN_MCU) then
ERREXIT(j_common_ptr(cinfo), JERR_BAD_MCU_SIZE);
while (mcublks > 0) do
begin
Dec(mcublks);
cinfo^.MCU_membership[cinfo^.blocks_in_MCU] := ci;
Inc(cinfo^.blocks_in_MCU);
end;
end;
end;
end;
{ 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 a multiple-scan JPEG file, the encoder could assign different components
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
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
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
the component.
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
anyway, this decoder will simply use the Q-table values that were current
at the start of the first scan for the component.
The decompressor output side looks only at the saved quant tables,
not at the current Q-table slots. }
{LOCAL}
procedure latch_quant_tables (cinfo : j_decompress_ptr);
var
ci, qtblno : int;
compptr : jpeg_component_info_ptr;
qtbl : JQUANT_TBL_PTR;
begin
for ci := 0 to pred(cinfo^.comps_in_scan) do
begin
compptr := cinfo^.cur_comp_info[ci];
{ No work if we already saved Q-table for this component }
if (compptr^.quant_table <> NIL) then
continue;
{ Make sure specified quantization table is present }
qtblno := compptr^.quant_tbl_no;
if (qtblno < 0) or (qtblno >= NUM_QUANT_TBLS) or
(cinfo^.quant_tbl_ptrs[qtblno] = NIL) then
ERREXIT1(j_common_ptr(cinfo), JERR_NO_QUANT_TABLE, qtblno);
{ OK, save away the quantization table }
qtbl := JQUANT_TBL_PTR(
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
SIZEOF(JQUANT_TBL)) );
MEMCOPY(qtbl, cinfo^.quant_tbl_ptrs[qtblno], SIZEOF(JQUANT_TBL));
compptr^.quant_table := qtbl;
end;
end;
{ Initialize the input modules to read a scan of compressed data.
The first call to this is done by jdmaster.c after initializing
the entire decompressor (during jpeg_start_decompress).
Subsequent calls come from consume_markers, below. }
{METHODDEF}
procedure start_input_pass (cinfo : j_decompress_ptr);
begin
per_scan_setup(cinfo);
latch_quant_tables(cinfo);
cinfo^.entropy^.start_pass (cinfo);
cinfo^.coef^.start_input_pass (cinfo);
cinfo^.inputctl^.consume_input := cinfo^.coef^.consume_data;
end;
{ Finish up after inputting a compressed-data scan.
This is called by the coefficient controller after it's read all
the expected data of the scan. }
{METHODDEF}
procedure finish_input_pass (cinfo : j_decompress_ptr);
begin
cinfo^.inputctl^.consume_input := consume_markers;
end;
{ Read JPEG markers before, between, or after compressed-data scans.
Change state as necessary when a new scan is reached.
Return value is JPEG_SUSPENDED, JPEG_REACHED_SOS, or JPEG_REACHED_EOI.
The consume_input method pointer points either here or to the
coefficient controller's consume_data routine, depending on whether
we are reading a compressed data segment or inter-segment markers. }
{METHODDEF}
function consume_markers (cinfo : j_decompress_ptr) : int;
var
val : int;
inputctl : my_inputctl_ptr;
begin
inputctl := my_inputctl_ptr (cinfo^.inputctl);
if (inputctl^.pub.eoi_reached) then { After hitting EOI, read no further }
begin
consume_markers := JPEG_REACHED_EOI;
exit;
end;
val := cinfo^.marker^.read_markers (cinfo);
case (val) of
JPEG_REACHED_SOS: { Found SOS }
begin
if (inputctl^.inheaders) then
begin { 1st SOS }
initial_setup(cinfo);
inputctl^.inheaders := FALSE;
{ Note: start_input_pass must be called by jdmaster.c
before any more input can be consumed. jdapimin.c is
responsible for enforcing this sequencing. }
end
else
begin { 2nd or later SOS marker }
if (not inputctl^.pub.has_multiple_scans) then
ERREXIT(j_common_ptr(cinfo), JERR_EOI_EXPECTED); { Oops, I wasn't expecting this! }
start_input_pass(cinfo);
end;
end;
JPEG_REACHED_EOI: { Found EOI }
begin
inputctl^.pub.eoi_reached := TRUE;
if (inputctl^.inheaders) then
begin { Tables-only datastream, apparently }
if (cinfo^.marker^.saw_SOF) then
ERREXIT(j_common_ptr(cinfo), JERR_SOF_NO_SOS);
end
else
begin
{ Prevent infinite loop in coef ctlr's decompress_data routine
if user set output_scan_number larger than number of scans. }
if (cinfo^.output_scan_number > cinfo^.input_scan_number) then
cinfo^.output_scan_number := cinfo^.input_scan_number;
end;
end;
JPEG_SUSPENDED:;
end;
consume_markers := val;
end;
{ Reset state to begin a fresh datastream. }
{METHODDEF}
procedure reset_input_controller (cinfo : j_decompress_ptr);
var
inputctl : my_inputctl_ptr;
begin
inputctl := my_inputctl_ptr (cinfo^.inputctl);
inputctl^.pub.consume_input := consume_markers;
inputctl^.pub.has_multiple_scans := FALSE; { "unknown" would be better }
inputctl^.pub.eoi_reached := FALSE;
inputctl^.inheaders := TRUE;
{ Reset other modules }
cinfo^.err^.reset_error_mgr (j_common_ptr(cinfo));
cinfo^.marker^.reset_marker_reader (cinfo);
{ Reset progression state -- would be cleaner if entropy decoder did this }
cinfo^.coef_bits := NIL;
end;
{ Initialize the input controller module.
This is called only once, when the decompression object is created. }
{GLOBAL}
procedure jinit_input_controller (cinfo : j_decompress_ptr);
var
inputctl : my_inputctl_ptr;
begin
{ Create subobject in permanent pool }
inputctl := my_inputctl_ptr(
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_PERMANENT,
SIZEOF(my_input_controller)) );
cinfo^.inputctl := jpeg_input_controller_ptr(inputctl);
{ Initialize method pointers }
inputctl^.pub.consume_input := consume_markers;
inputctl^.pub.reset_input_controller := reset_input_controller;
inputctl^.pub.start_input_pass := start_input_pass;
inputctl^.pub.finish_input_pass := finish_input_pass;
{ Initialize state: can't use reset_input_controller since we don't
want to try to reset other modules yet. }
inputctl^.pub.has_multiple_scans := FALSE; { "unknown" would be better }
inputctl^.pub.eoi_reached := FALSE;
inputctl^.inheaders := TRUE;
end;
end.
unit imjdinput;
{ Original: jdinput.c ; Copyright (C) 1991-1997, Thomas G. Lane. }
{ This file is part of the Independent JPEG Group's software.
For conditions of distribution and use, see the accompanying README file.
This file contains input control logic for the JPEG decompressor.
These routines are concerned with controlling the decompressor's input
processing (marker reading and coefficient decoding). The actual input
reading is done in jdmarker.c, jdhuff.c, and jdphuff.c. }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjpeglib,
imjdeferr,
imjerror,
imjinclude, imjutils;
{ Initialize the input controller module.
This is called only once, when the decompression object is created. }
{GLOBAL}
procedure jinit_input_controller (cinfo : j_decompress_ptr);
implementation
{ Private state }
type
my_inputctl_ptr = ^my_input_controller;
my_input_controller = record
pub : jpeg_input_controller; { public fields }
inheaders : boolean; { TRUE until first SOS is reached }
end; {my_input_controller;}
{ Forward declarations }
{METHODDEF}
function consume_markers (cinfo : j_decompress_ptr) : int; forward;
{ Routines to calculate various quantities related to the size of the image. }
{LOCAL}
procedure initial_setup (cinfo : j_decompress_ptr);
{ Called once, when first SOS marker is reached }
var
ci : int;
compptr : jpeg_component_info_ptr;
begin
{ Make sure image isn't bigger than I can handle }
if (long(cinfo^.image_height) > long (JPEG_MAX_DIMENSION)) or
(long(cinfo^.image_width) > long(JPEG_MAX_DIMENSION)) then
ERREXIT1(j_common_ptr(cinfo), JERR_IMAGE_TOO_BIG, uInt(JPEG_MAX_DIMENSION));
{ For now, precision must match compiled-in value... }
if (cinfo^.data_precision <> BITS_IN_JSAMPLE) then
ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PRECISION, cinfo^.data_precision);
{ Check that number of components won't exceed internal array sizes }
if (cinfo^.num_components > MAX_COMPONENTS) then
ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, cinfo^.num_components,
MAX_COMPONENTS);
{ Compute maximum sampling factors; check factor validity }
cinfo^.max_h_samp_factor := 1;
cinfo^.max_v_samp_factor := 1;
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
for ci := 0 to pred(cinfo^.num_components) do
begin
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
ERREXIT(j_common_ptr(cinfo), JERR_BAD_SAMPLING);
{cinfo^.max_h_samp_factor := MAX(cinfo^.max_h_samp_factor,
compptr^.h_samp_factor);
cinfo^.max_v_samp_factor := MAX(cinfo^.max_v_samp_factor,
compptr^.v_samp_factor);}
if cinfo^.max_h_samp_factor < compptr^.h_samp_factor then
cinfo^.max_h_samp_factor := compptr^.h_samp_factor;
if cinfo^.max_v_samp_factor < compptr^.v_samp_factor then
cinfo^.max_v_samp_factor := compptr^.v_samp_factor;
Inc(compptr);
end;
{ We initialize DCT_scaled_size and min_DCT_scaled_size to DCTSIZE.
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. }
cinfo^.min_DCT_scaled_size := DCTSIZE;
{ Compute dimensions of components }
compptr := jpeg_component_info_ptr(cinfo^.comp_info);
for ci := 0 to pred(cinfo^.num_components) do
begin
compptr^.DCT_scaled_size := DCTSIZE;
{ Size in DCT blocks }
compptr^.width_in_blocks := JDIMENSION(
jdiv_round_up( long(cinfo^.image_width) * long(compptr^.h_samp_factor),
long(cinfo^.max_h_samp_factor * DCTSIZE)) );
compptr^.height_in_blocks := JDIMENSION (
jdiv_round_up(long (cinfo^.image_height) * long(compptr^.v_samp_factor),
long (cinfo^.max_v_samp_factor * DCTSIZE)) );
{ downsampled_width and downsampled_height will also be overridden by
jdmaster.c if we are doing full decompression. The transcoder library
doesn't use these values, but the calling application might. }
{ Size in samples }
compptr^.downsampled_width := JDIMENSION (
jdiv_round_up(long (cinfo^.image_width) * long(compptr^.h_samp_factor),
long (cinfo^.max_h_samp_factor)) );
compptr^.downsampled_height := JDIMENSION (
jdiv_round_up(long (cinfo^.image_height) * long(compptr^.v_samp_factor),
long (cinfo^.max_v_samp_factor)) );
{ Mark component needed, until color conversion says otherwise }
compptr^.component_needed := TRUE;
{ Mark no quantization table yet saved for component }
compptr^.quant_table := NIL;
Inc(compptr);
end;
{ Compute number of fully interleaved MCU rows. }
cinfo^.total_iMCU_rows := JDIMENSION(
jdiv_round_up(long(cinfo^.image_height),
long(cinfo^.max_v_samp_factor*DCTSIZE)) );
{ Decide whether file contains multiple scans }
if (cinfo^.comps_in_scan < cinfo^.num_components) or
(cinfo^.progressive_mode) then
cinfo^.inputctl^.has_multiple_scans := TRUE
else
cinfo^.inputctl^.has_multiple_scans := FALSE;
end;
{LOCAL}
procedure per_scan_setup (cinfo : j_decompress_ptr);
{ Do computations that are needed before processing a JPEG scan }
{ cinfo^.comps_in_scan and cinfo^.cur_comp_info[] were set from SOS marker }
var
ci, mcublks, tmp : int;
compptr : jpeg_component_info_ptr;
begin
if (cinfo^.comps_in_scan = 1) then
begin
{ Noninterleaved (single-component) scan }
compptr := cinfo^.cur_comp_info[0];
{ Overall image size in MCUs }
cinfo^.MCUs_per_row := compptr^.width_in_blocks;
cinfo^.MCU_rows_in_scan := compptr^.height_in_blocks;
{ For noninterleaved scan, always one block per MCU }
compptr^.MCU_width := 1;
compptr^.MCU_height := 1;
compptr^.MCU_blocks := 1;
compptr^.MCU_sample_width := compptr^.DCT_scaled_size;
compptr^.last_col_width := 1;
{ For noninterleaved scans, it is convenient to define last_row_height
as the number of block rows present in the last iMCU row. }
tmp := int (LongInt(compptr^.height_in_blocks) mod compptr^.v_samp_factor);
if (tmp = 0) then
tmp := compptr^.v_samp_factor;
compptr^.last_row_height := tmp;
{ Prepare array describing MCU composition }
cinfo^.blocks_in_MCU := 1;
cinfo^.MCU_membership[0] := 0;
end
else
begin
{ Interleaved (multi-component) scan }
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,
MAX_COMPS_IN_SCAN);
{ Overall image size in MCUs }
cinfo^.MCUs_per_row := JDIMENSION (
jdiv_round_up(long (cinfo^.image_width),
long (cinfo^.max_h_samp_factor*DCTSIZE)) );
cinfo^.MCU_rows_in_scan := JDIMENSION (
jdiv_round_up(long (cinfo^.image_height),
long (cinfo^.max_v_samp_factor*DCTSIZE)) );
cinfo^.blocks_in_MCU := 0;
for ci := 0 to pred(cinfo^.comps_in_scan) do
begin
compptr := cinfo^.cur_comp_info[ci];
{ Sampling factors give # of blocks of component in each MCU }
compptr^.MCU_width := compptr^.h_samp_factor;
compptr^.MCU_height := compptr^.v_samp_factor;
compptr^.MCU_blocks := compptr^.MCU_width * compptr^.MCU_height;
compptr^.MCU_sample_width := compptr^.MCU_width * compptr^.DCT_scaled_size;
{ Figure number of non-dummy blocks in last MCU column & row }
tmp := int (LongInt(compptr^.width_in_blocks) mod compptr^.MCU_width);
if (tmp = 0) then
tmp := compptr^.MCU_width;
compptr^.last_col_width := tmp;
tmp := int (LongInt(compptr^.height_in_blocks) mod compptr^.MCU_height);
if (tmp = 0) then
tmp := compptr^.MCU_height;
compptr^.last_row_height := tmp;
{ Prepare array describing MCU composition }
mcublks := compptr^.MCU_blocks;
if (LongInt(cinfo^.blocks_in_MCU) + mcublks > D_MAX_BLOCKS_IN_MCU) then
ERREXIT(j_common_ptr(cinfo), JERR_BAD_MCU_SIZE);
while (mcublks > 0) do
begin
Dec(mcublks);
cinfo^.MCU_membership[cinfo^.blocks_in_MCU] := ci;
Inc(cinfo^.blocks_in_MCU);
end;
end;
end;
end;
{ 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 a multiple-scan JPEG file, the encoder could assign different components
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
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
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
the component.
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
anyway, this decoder will simply use the Q-table values that were current
at the start of the first scan for the component.
The decompressor output side looks only at the saved quant tables,
not at the current Q-table slots. }
{LOCAL}
procedure latch_quant_tables (cinfo : j_decompress_ptr);
var
ci, qtblno : int;
compptr : jpeg_component_info_ptr;
qtbl : JQUANT_TBL_PTR;
begin
for ci := 0 to pred(cinfo^.comps_in_scan) do
begin
compptr := cinfo^.cur_comp_info[ci];
{ No work if we already saved Q-table for this component }
if (compptr^.quant_table <> NIL) then
continue;
{ Make sure specified quantization table is present }
qtblno := compptr^.quant_tbl_no;
if (qtblno < 0) or (qtblno >= NUM_QUANT_TBLS) or
(cinfo^.quant_tbl_ptrs[qtblno] = NIL) then
ERREXIT1(j_common_ptr(cinfo), JERR_NO_QUANT_TABLE, qtblno);
{ OK, save away the quantization table }
qtbl := JQUANT_TBL_PTR(
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
SIZEOF(JQUANT_TBL)) );
MEMCOPY(qtbl, cinfo^.quant_tbl_ptrs[qtblno], SIZEOF(JQUANT_TBL));
compptr^.quant_table := qtbl;
end;
end;
{ Initialize the input modules to read a scan of compressed data.
The first call to this is done by jdmaster.c after initializing
the entire decompressor (during jpeg_start_decompress).
Subsequent calls come from consume_markers, below. }
{METHODDEF}
procedure start_input_pass (cinfo : j_decompress_ptr);
begin
per_scan_setup(cinfo);
latch_quant_tables(cinfo);
cinfo^.entropy^.start_pass (cinfo);
cinfo^.coef^.start_input_pass (cinfo);
cinfo^.inputctl^.consume_input := cinfo^.coef^.consume_data;
end;
{ Finish up after inputting a compressed-data scan.
This is called by the coefficient controller after it's read all
the expected data of the scan. }
{METHODDEF}
procedure finish_input_pass (cinfo : j_decompress_ptr);
begin
cinfo^.inputctl^.consume_input := consume_markers;
end;
{ Read JPEG markers before, between, or after compressed-data scans.
Change state as necessary when a new scan is reached.
Return value is JPEG_SUSPENDED, JPEG_REACHED_SOS, or JPEG_REACHED_EOI.
The consume_input method pointer points either here or to the
coefficient controller's consume_data routine, depending on whether
we are reading a compressed data segment or inter-segment markers. }
{METHODDEF}
function consume_markers (cinfo : j_decompress_ptr) : int;
var
val : int;
inputctl : my_inputctl_ptr;
begin
inputctl := my_inputctl_ptr (cinfo^.inputctl);
if (inputctl^.pub.eoi_reached) then { After hitting EOI, read no further }
begin
consume_markers := JPEG_REACHED_EOI;
exit;
end;
val := cinfo^.marker^.read_markers (cinfo);
case (val) of
JPEG_REACHED_SOS: { Found SOS }
begin
if (inputctl^.inheaders) then
begin { 1st SOS }
initial_setup(cinfo);
inputctl^.inheaders := FALSE;
{ Note: start_input_pass must be called by jdmaster.c
before any more input can be consumed. jdapimin.c is
responsible for enforcing this sequencing. }
end
else
begin { 2nd or later SOS marker }
if (not inputctl^.pub.has_multiple_scans) then
ERREXIT(j_common_ptr(cinfo), JERR_EOI_EXPECTED); { Oops, I wasn't expecting this! }
start_input_pass(cinfo);
end;
end;
JPEG_REACHED_EOI: { Found EOI }
begin
inputctl^.pub.eoi_reached := TRUE;
if (inputctl^.inheaders) then
begin { Tables-only datastream, apparently }
if (cinfo^.marker^.saw_SOF) then
ERREXIT(j_common_ptr(cinfo), JERR_SOF_NO_SOS);
end
else
begin
{ Prevent infinite loop in coef ctlr's decompress_data routine
if user set output_scan_number larger than number of scans. }
if (cinfo^.output_scan_number > cinfo^.input_scan_number) then
cinfo^.output_scan_number := cinfo^.input_scan_number;
end;
end;
JPEG_SUSPENDED:;
end;
consume_markers := val;
end;
{ Reset state to begin a fresh datastream. }
{METHODDEF}
procedure reset_input_controller (cinfo : j_decompress_ptr);
var
inputctl : my_inputctl_ptr;
begin
inputctl := my_inputctl_ptr (cinfo^.inputctl);
inputctl^.pub.consume_input := consume_markers;
inputctl^.pub.has_multiple_scans := FALSE; { "unknown" would be better }
inputctl^.pub.eoi_reached := FALSE;
inputctl^.inheaders := TRUE;
{ Reset other modules }
cinfo^.err^.reset_error_mgr (j_common_ptr(cinfo));
cinfo^.marker^.reset_marker_reader (cinfo);
{ Reset progression state -- would be cleaner if entropy decoder did this }
cinfo^.coef_bits := NIL;
end;
{ Initialize the input controller module.
This is called only once, when the decompression object is created. }
{GLOBAL}
procedure jinit_input_controller (cinfo : j_decompress_ptr);
var
inputctl : my_inputctl_ptr;
begin
{ Create subobject in permanent pool }
inputctl := my_inputctl_ptr(
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_PERMANENT,
SIZEOF(my_input_controller)) );
cinfo^.inputctl := jpeg_input_controller_ptr(inputctl);
{ Initialize method pointers }
inputctl^.pub.consume_input := consume_markers;
inputctl^.pub.reset_input_controller := reset_input_controller;
inputctl^.pub.start_input_pass := start_input_pass;
inputctl^.pub.finish_input_pass := finish_input_pass;
{ Initialize state: can't use reset_input_controller since we don't
want to try to reset other modules yet. }
inputctl^.pub.has_multiple_scans := FALSE; { "unknown" would be better }
inputctl^.pub.eoi_reached := FALSE;
inputctl^.inheaders := TRUE;
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;
{ Original: jdpostct.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
{ This file contains the decompression postprocessing controller.
This controller manages the upsampling, color conversion, and color
quantization/reduction steps; specifically, it controls the buffering
between upsample/color conversion and color quantization/reduction.
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.
An integrated upsample/convert/quantize process would replace this module
entirely. }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjinclude,
imjdeferr,
imjerror,
imjutils,
imjpeglib;
{ Initialize postprocessing controller. }
{GLOBAL}
procedure jinit_d_post_controller (cinfo : j_decompress_ptr;
need_full_buffer : boolean);
implementation
{ Private buffer controller object }
type
my_post_ptr = ^my_post_controller;
my_post_controller = record
pub : jpeg_d_post_controller; { public fields }
{ Color quantization source buffer: this holds output data from
the upsample/color conversion step to be passed to the quantizer.
For two-pass color quantization, we need a full-image buffer;
for one-pass operation, a strip buffer is sufficient. }
whole_image : jvirt_sarray_ptr; { virtual array, or NIL if one-pass }
buffer : JSAMPARRAY; { strip buffer, or current strip of virtual }
strip_height : JDIMENSION; { buffer size in rows }
{ for two-pass mode only: }
starting_row : JDIMENSION; { row # of first row in current strip }
next_row : JDIMENSION; { index of next row to fill/empty in strip }
end;
{ Forward declarations }
{METHODDEF}
procedure post_process_1pass(cinfo : j_decompress_ptr;
input_buf : JSAMPIMAGE;
var in_row_group_ctr : JDIMENSION;
in_row_groups_avail : JDIMENSION;
output_buf : JSAMPARRAY;
var out_row_ctr : JDIMENSION;
out_rows_avail : JDIMENSION); forward;
{$ifdef QUANT_2PASS_SUPPORTED}
{METHODDEF}
procedure post_process_prepass(cinfo : j_decompress_ptr;
input_buf : JSAMPIMAGE;
var in_row_group_ctr : JDIMENSION;
in_row_groups_avail : JDIMENSION;
output_buf : JSAMPARRAY;
var out_row_ctr : JDIMENSION;
out_rows_avail : JDIMENSION); forward;
{METHODDEF}
procedure post_process_2pass(cinfo : j_decompress_ptr;
input_buf : JSAMPIMAGE;
var in_row_group_ctr : JDIMENSION;
in_row_groups_avail : JDIMENSION;
output_buf : JSAMPARRAY;
var out_row_ctr : JDIMENSION;
out_rows_avail : JDIMENSION); forward;
{$endif}
{ Initialize for a processing pass. }
{METHODDEF}
procedure start_pass_dpost (cinfo : j_decompress_ptr;
pass_mode : J_BUF_MODE);
var
post : my_post_ptr;
begin
post := my_post_ptr(cinfo^.post);
case (pass_mode) of
JBUF_PASS_THRU:
if (cinfo^.quantize_colors) then
begin
{ Single-pass processing with color quantization. }
post^.pub.post_process_data := post_process_1pass;
{ We could be doing buffered-image output before starting a 2-pass
color quantization; in that case, jinit_d_post_controller did not
allocate a strip buffer. Use the virtual-array buffer as workspace. }
if (post^.buffer = NIL) then
begin
post^.buffer := cinfo^.mem^.access_virt_sarray
(j_common_ptr(cinfo), post^.whole_image,
JDIMENSION(0), post^.strip_height, TRUE);
end;
end
else
begin
{ For single-pass processing without color quantization,
I have no work to do; just call the upsampler directly. }
post^.pub.post_process_data := cinfo^.upsample^.upsample;
end;
{$ifdef QUANT_2PASS_SUPPORTED}
JBUF_SAVE_AND_PASS:
begin
{ First pass of 2-pass quantization }
if (post^.whole_image = NIL) then
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
post^.pub.post_process_data := post_process_prepass;
end;
JBUF_CRANK_DEST:
begin
{ Second pass of 2-pass quantization }
if (post^.whole_image = NIL) then
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
post^.pub.post_process_data := post_process_2pass;
end;
{$endif} { QUANT_2PASS_SUPPORTED }
else
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
end;
post^.next_row := 0;
post^.starting_row := 0;
end;
{ Process some data in the one-pass (strip buffer) case.
This is used for color precision reduction as well as one-pass quantization. }
{METHODDEF}
procedure post_process_1pass (cinfo : j_decompress_ptr;
input_buf : JSAMPIMAGE;
var in_row_group_ctr : JDIMENSION;
in_row_groups_avail : JDIMENSION;
output_buf : JSAMPARRAY;
var out_row_ctr : JDIMENSION;
out_rows_avail : JDIMENSION);
var
post : my_post_ptr;
num_rows, max_rows : JDIMENSION;
begin
post := my_post_ptr (cinfo^.post);
{ 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. }
max_rows := out_rows_avail - out_row_ctr;
if (max_rows > post^.strip_height) then
max_rows := post^.strip_height;
num_rows := 0;
cinfo^.upsample^.upsample (cinfo,
input_buf,
in_row_group_ctr,
in_row_groups_avail,
post^.buffer,
num_rows, { var }
max_rows);
{ Quantize and emit data. }
cinfo^.cquantize^.color_quantize (cinfo,
post^.buffer,
JSAMPARRAY(@ output_buf^[out_row_ctr]),
int(num_rows));
Inc(out_row_ctr, num_rows);
end;
{$ifdef QUANT_2PASS_SUPPORTED}
{ Process some data in the first pass of 2-pass quantization. }
{METHODDEF}
procedure post_process_prepass (cinfo : j_decompress_ptr;
input_buf : JSAMPIMAGE;
var in_row_group_ctr : JDIMENSION;
in_row_groups_avail : JDIMENSION;
output_buf : JSAMPARRAY;
var out_row_ctr : JDIMENSION;
out_rows_avail:JDIMENSION);
var
post : my_post_ptr;
old_next_row, num_rows : JDIMENSION;
begin
post := my_post_ptr(cinfo^.post);
{ Reposition virtual buffer if at start of strip. }
if (post^.next_row = 0) then
begin
post^.buffer := cinfo^.mem^.access_virt_sarray
(j_common_ptr(cinfo), post^.whole_image,
post^.starting_row, post^.strip_height, TRUE);
end;
{ Upsample some data (up to a strip height's worth). }
old_next_row := post^.next_row;
cinfo^.upsample^.upsample (cinfo,
input_buf, in_row_group_ctr, in_row_groups_avail,
post^.buffer, post^.next_row, post^.strip_height);
{ 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. }
if (post^.next_row > old_next_row) then
begin
num_rows := post^.next_row - old_next_row;
cinfo^.cquantize^.color_quantize (cinfo,
JSAMPARRAY(@ post^.buffer^[old_next_row]),
JSAMPARRAY(NIL),
int(num_rows));
Inc(out_row_ctr, num_rows);
end;
{ Advance if we filled the strip. }
if (post^.next_row >= post^.strip_height) then
begin
Inc(post^.starting_row, post^.strip_height);
post^.next_row := 0;
end;
end;
{ Process some data in the second pass of 2-pass quantization. }
{METHODDEF}
procedure post_process_2pass (cinfo : j_decompress_ptr;
input_buf : JSAMPIMAGE;
var in_row_group_ctr : JDIMENSION;
in_row_groups_avail : JDIMENSION;
output_buf : JSAMPARRAY;
var out_row_ctr : JDIMENSION;
out_rows_avail : JDIMENSION);
var
post : my_post_ptr;
num_rows, max_rows : JDIMENSION;
begin
post := my_post_ptr(cinfo^.post);
{ Reposition virtual buffer if at start of strip. }
if (post^.next_row = 0) then
begin
post^.buffer := cinfo^.mem^.access_virt_sarray
(j_common_ptr(cinfo), post^.whole_image,
post^.starting_row, post^.strip_height, FALSE);
end;
{ Determine number of rows to emit. }
num_rows := post^.strip_height - post^.next_row; { available in strip }
max_rows := out_rows_avail - out_row_ctr; { available in output area }
if (num_rows > max_rows) then
num_rows := max_rows;
{ We have to check bottom of image here, can't depend on upsampler. }
max_rows := cinfo^.output_height - post^.starting_row;
if (num_rows > max_rows) then
num_rows := max_rows;
{ Quantize and emit data. }
cinfo^.cquantize^.color_quantize (cinfo,
JSAMPARRAY(@ post^.buffer^[post^.next_row]),
JSAMPARRAY(@ output_buf^[out_row_ctr]),
int(num_rows));
Inc(out_row_ctr, num_rows);
{ Advance if we filled the strip. }
Inc(post^.next_row, num_rows);
if (post^.next_row >= post^.strip_height) then
begin
Inc(post^.starting_row, post^.strip_height);
post^.next_row := 0;
end;
end;
{$endif} { QUANT_2PASS_SUPPORTED }
{ Initialize postprocessing controller. }
{GLOBAL}
procedure jinit_d_post_controller (cinfo : j_decompress_ptr;
need_full_buffer : boolean);
var
post : my_post_ptr;
begin
post := my_post_ptr(
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
SIZEOF(my_post_controller)) );
cinfo^.post := jpeg_d_post_controller_ptr (post);
post^.pub.start_pass := start_pass_dpost;
post^.whole_image := NIL; { flag for no virtual arrays }
post^.buffer := NIL; { flag for no strip buffer }
{ Create the quantization buffer, if needed }
if (cinfo^.quantize_colors) then
begin
{ The buffer strip height is max_v_samp_factor, which is typically
an efficient number of rows for upsampling to return.
(In the presence of output rescaling, we might want to be smarter?) }
post^.strip_height := JDIMENSION (cinfo^.max_v_samp_factor);
if (need_full_buffer) then
begin
{ Two-pass color quantization: need full-image storage. }
{ We round up the number of rows to a multiple of the strip height. }
{$ifdef QUANT_2PASS_SUPPORTED}
post^.whole_image := cinfo^.mem^.request_virt_sarray
(j_common_ptr(cinfo), JPOOL_IMAGE, FALSE,
LongInt(cinfo^.output_width) * cinfo^.out_color_components,
JDIMENSION (jround_up( long(cinfo^.output_height),
long(post^.strip_height)) ),
post^.strip_height);
{$else}
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
{$endif} { QUANT_2PASS_SUPPORTED }
end
else
begin
{ One-pass color quantization: just make a strip buffer. }
post^.buffer := cinfo^.mem^.alloc_sarray
(j_common_ptr (cinfo), JPOOL_IMAGE,
LongInt(cinfo^.output_width) * cinfo^.out_color_components,
post^.strip_height);
end;
end;
end;
end.
unit imjdpostct;
{ Original: jdpostct.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
{ This file contains the decompression postprocessing controller.
This controller manages the upsampling, color conversion, and color
quantization/reduction steps; specifically, it controls the buffering
between upsample/color conversion and color quantization/reduction.
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.
An integrated upsample/convert/quantize process would replace this module
entirely. }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjinclude,
imjdeferr,
imjerror,
imjutils,
imjpeglib;
{ Initialize postprocessing controller. }
{GLOBAL}
procedure jinit_d_post_controller (cinfo : j_decompress_ptr;
need_full_buffer : boolean);
implementation
{ Private buffer controller object }
type
my_post_ptr = ^my_post_controller;
my_post_controller = record
pub : jpeg_d_post_controller; { public fields }
{ Color quantization source buffer: this holds output data from
the upsample/color conversion step to be passed to the quantizer.
For two-pass color quantization, we need a full-image buffer;
for one-pass operation, a strip buffer is sufficient. }
whole_image : jvirt_sarray_ptr; { virtual array, or NIL if one-pass }
buffer : JSAMPARRAY; { strip buffer, or current strip of virtual }
strip_height : JDIMENSION; { buffer size in rows }
{ for two-pass mode only: }
starting_row : JDIMENSION; { row # of first row in current strip }
next_row : JDIMENSION; { index of next row to fill/empty in strip }
end;
{ Forward declarations }
{METHODDEF}
procedure post_process_1pass(cinfo : j_decompress_ptr;
input_buf : JSAMPIMAGE;
var in_row_group_ctr : JDIMENSION;
in_row_groups_avail : JDIMENSION;
output_buf : JSAMPARRAY;
var out_row_ctr : JDIMENSION;
out_rows_avail : JDIMENSION); forward;
{$ifdef QUANT_2PASS_SUPPORTED}
{METHODDEF}
procedure post_process_prepass(cinfo : j_decompress_ptr;
input_buf : JSAMPIMAGE;
var in_row_group_ctr : JDIMENSION;
in_row_groups_avail : JDIMENSION;
output_buf : JSAMPARRAY;
var out_row_ctr : JDIMENSION;
out_rows_avail : JDIMENSION); forward;
{METHODDEF}
procedure post_process_2pass(cinfo : j_decompress_ptr;
input_buf : JSAMPIMAGE;
var in_row_group_ctr : JDIMENSION;
in_row_groups_avail : JDIMENSION;
output_buf : JSAMPARRAY;
var out_row_ctr : JDIMENSION;
out_rows_avail : JDIMENSION); forward;
{$endif}
{ Initialize for a processing pass. }
{METHODDEF}
procedure start_pass_dpost (cinfo : j_decompress_ptr;
pass_mode : J_BUF_MODE);
var
post : my_post_ptr;
begin
post := my_post_ptr(cinfo^.post);
case (pass_mode) of
JBUF_PASS_THRU:
if (cinfo^.quantize_colors) then
begin
{ Single-pass processing with color quantization. }
post^.pub.post_process_data := post_process_1pass;
{ We could be doing buffered-image output before starting a 2-pass
color quantization; in that case, jinit_d_post_controller did not
allocate a strip buffer. Use the virtual-array buffer as workspace. }
if (post^.buffer = NIL) then
begin
post^.buffer := cinfo^.mem^.access_virt_sarray
(j_common_ptr(cinfo), post^.whole_image,
JDIMENSION(0), post^.strip_height, TRUE);
end;
end
else
begin
{ For single-pass processing without color quantization,
I have no work to do; just call the upsampler directly. }
post^.pub.post_process_data := cinfo^.upsample^.upsample;
end;
{$ifdef QUANT_2PASS_SUPPORTED}
JBUF_SAVE_AND_PASS:
begin
{ First pass of 2-pass quantization }
if (post^.whole_image = NIL) then
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
post^.pub.post_process_data := post_process_prepass;
end;
JBUF_CRANK_DEST:
begin
{ Second pass of 2-pass quantization }
if (post^.whole_image = NIL) then
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
post^.pub.post_process_data := post_process_2pass;
end;
{$endif} { QUANT_2PASS_SUPPORTED }
else
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
end;
post^.next_row := 0;
post^.starting_row := 0;
end;
{ Process some data in the one-pass (strip buffer) case.
This is used for color precision reduction as well as one-pass quantization. }
{METHODDEF}
procedure post_process_1pass (cinfo : j_decompress_ptr;
input_buf : JSAMPIMAGE;
var in_row_group_ctr : JDIMENSION;
in_row_groups_avail : JDIMENSION;
output_buf : JSAMPARRAY;
var out_row_ctr : JDIMENSION;
out_rows_avail : JDIMENSION);
var
post : my_post_ptr;
num_rows, max_rows : JDIMENSION;
begin
post := my_post_ptr (cinfo^.post);
{ 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. }
max_rows := out_rows_avail - out_row_ctr;
if (max_rows > post^.strip_height) then
max_rows := post^.strip_height;
num_rows := 0;
cinfo^.upsample^.upsample (cinfo,
input_buf,
in_row_group_ctr,
in_row_groups_avail,
post^.buffer,
num_rows, { var }
max_rows);
{ Quantize and emit data. }
cinfo^.cquantize^.color_quantize (cinfo,
post^.buffer,
JSAMPARRAY(@ output_buf^[out_row_ctr]),
int(num_rows));
Inc(out_row_ctr, num_rows);
end;
{$ifdef QUANT_2PASS_SUPPORTED}
{ Process some data in the first pass of 2-pass quantization. }
{METHODDEF}
procedure post_process_prepass (cinfo : j_decompress_ptr;
input_buf : JSAMPIMAGE;
var in_row_group_ctr : JDIMENSION;
in_row_groups_avail : JDIMENSION;
output_buf : JSAMPARRAY;
var out_row_ctr : JDIMENSION;
out_rows_avail:JDIMENSION);
var
post : my_post_ptr;
old_next_row, num_rows : JDIMENSION;
begin
post := my_post_ptr(cinfo^.post);
{ Reposition virtual buffer if at start of strip. }
if (post^.next_row = 0) then
begin
post^.buffer := cinfo^.mem^.access_virt_sarray
(j_common_ptr(cinfo), post^.whole_image,
post^.starting_row, post^.strip_height, TRUE);
end;
{ Upsample some data (up to a strip height's worth). }
old_next_row := post^.next_row;
cinfo^.upsample^.upsample (cinfo,
input_buf, in_row_group_ctr, in_row_groups_avail,
post^.buffer, post^.next_row, post^.strip_height);
{ 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. }
if (post^.next_row > old_next_row) then
begin
num_rows := post^.next_row - old_next_row;
cinfo^.cquantize^.color_quantize (cinfo,
JSAMPARRAY(@ post^.buffer^[old_next_row]),
JSAMPARRAY(NIL),
int(num_rows));
Inc(out_row_ctr, num_rows);
end;
{ Advance if we filled the strip. }
if (post^.next_row >= post^.strip_height) then
begin
Inc(post^.starting_row, post^.strip_height);
post^.next_row := 0;
end;
end;
{ Process some data in the second pass of 2-pass quantization. }
{METHODDEF}
procedure post_process_2pass (cinfo : j_decompress_ptr;
input_buf : JSAMPIMAGE;
var in_row_group_ctr : JDIMENSION;
in_row_groups_avail : JDIMENSION;
output_buf : JSAMPARRAY;
var out_row_ctr : JDIMENSION;
out_rows_avail : JDIMENSION);
var
post : my_post_ptr;
num_rows, max_rows : JDIMENSION;
begin
post := my_post_ptr(cinfo^.post);
{ Reposition virtual buffer if at start of strip. }
if (post^.next_row = 0) then
begin
post^.buffer := cinfo^.mem^.access_virt_sarray
(j_common_ptr(cinfo), post^.whole_image,
post^.starting_row, post^.strip_height, FALSE);
end;
{ Determine number of rows to emit. }
num_rows := post^.strip_height - post^.next_row; { available in strip }
max_rows := out_rows_avail - out_row_ctr; { available in output area }
if (num_rows > max_rows) then
num_rows := max_rows;
{ We have to check bottom of image here, can't depend on upsampler. }
max_rows := cinfo^.output_height - post^.starting_row;
if (num_rows > max_rows) then
num_rows := max_rows;
{ Quantize and emit data. }
cinfo^.cquantize^.color_quantize (cinfo,
JSAMPARRAY(@ post^.buffer^[post^.next_row]),
JSAMPARRAY(@ output_buf^[out_row_ctr]),
int(num_rows));
Inc(out_row_ctr, num_rows);
{ Advance if we filled the strip. }
Inc(post^.next_row, num_rows);
if (post^.next_row >= post^.strip_height) then
begin
Inc(post^.starting_row, post^.strip_height);
post^.next_row := 0;
end;
end;
{$endif} { QUANT_2PASS_SUPPORTED }
{ Initialize postprocessing controller. }
{GLOBAL}
procedure jinit_d_post_controller (cinfo : j_decompress_ptr;
need_full_buffer : boolean);
var
post : my_post_ptr;
begin
post := my_post_ptr(
cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE,
SIZEOF(my_post_controller)) );
cinfo^.post := jpeg_d_post_controller_ptr (post);
post^.pub.start_pass := start_pass_dpost;
post^.whole_image := NIL; { flag for no virtual arrays }
post^.buffer := NIL; { flag for no strip buffer }
{ Create the quantization buffer, if needed }
if (cinfo^.quantize_colors) then
begin
{ The buffer strip height is max_v_samp_factor, which is typically
an efficient number of rows for upsampling to return.
(In the presence of output rescaling, we might want to be smarter?) }
post^.strip_height := JDIMENSION (cinfo^.max_v_samp_factor);
if (need_full_buffer) then
begin
{ Two-pass color quantization: need full-image storage. }
{ We round up the number of rows to a multiple of the strip height. }
{$ifdef QUANT_2PASS_SUPPORTED}
post^.whole_image := cinfo^.mem^.request_virt_sarray
(j_common_ptr(cinfo), JPOOL_IMAGE, FALSE,
LongInt(cinfo^.output_width) * cinfo^.out_color_components,
JDIMENSION (jround_up( long(cinfo^.output_height),
long(post^.strip_height)) ),
post^.strip_height);
{$else}
ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE);
{$endif} { QUANT_2PASS_SUPPORTED }
end
else
begin
{ One-pass color quantization: just make a strip buffer. }
post^.buffer := cinfo^.mem^.alloc_sarray
(j_common_ptr (cinfo), JPOOL_IMAGE,
LongInt(cinfo^.output_width) * cinfo^.out_color_components,
post^.strip_height);
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;
{ This file contains simple error-reporting and trace-message routines.
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
some or all of these routines.
These routines are used by both the compression and decompression code. }
{ Source: jerror.c; Copyright (C) 1991-1996, Thomas G. Lane. }
{ note: format_message still contains a hack }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjdeferr,
imjpeglib;
{
jversion;
}
const
EXIT_FAILURE = 1; { define halt() codes if not provided }
{GLOBAL}
function jpeg_std_error (var err : jpeg_error_mgr) : jpeg_error_mgr_ptr;
procedure ERREXIT(cinfo : j_common_ptr; code : J_MESSAGE_CODE);
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 ERREXIT3(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int);
procedure ERREXIT4(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int);
procedure ERREXITS(cinfo : j_common_ptr;code : J_MESSAGE_CODE;
str : string);
{ Nonfatal errors (we can keep going, but the data is probably corrupt) }
procedure WARNMS(cinfo : j_common_ptr; code : J_MESSAGE_CODE);
procedure WARNMS1(cinfo : j_common_ptr;code : J_MESSAGE_CODE; p1 : int);
procedure WARNMS2(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
p1 : int; p2 : int);
{ Informational/debugging messages }
procedure TRACEMS(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE);
procedure TRACEMS1(cinfo : j_common_ptr; lvl : int;
code : J_MESSAGE_CODE; p1 : long);
procedure TRACEMS2(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int;
p2 : int);
procedure TRACEMS3(cinfo : j_common_ptr;
lvl : int;
code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int);
procedure TRACEMS4(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int);
procedure TRACEMS5(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int; p5 : int);
procedure TRACEMS8(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int;
p5 : int; p6 : int; p7 : int; p8 : int);
procedure TRACEMSS(cinfo : j_common_ptr; lvl : int;
code : J_MESSAGE_CODE; str : string);
implementation
{ How to format a message string, in format_message() ? }
{$IFDEF OS2}
{$DEFINE NO_FORMAT}
{$ENDIF}
{$IFDEF FPC}
{$DEFINE NO_FORMAT}
{$ENDIF}
uses
{$IFNDEF NO_FORMAT}
{$IFDEF VER70}
drivers, { Turbo Vision unit with FormatStr }
{$ELSE}
sysutils, { Delphi Unit with Format() }
{$ENDIF}
{$ENDIF}
imjcomapi;
{ Error exit handler: must not return to caller.
Applications may override this if they want to get control back after
an error. Typically one would longjmp somewhere instead of exiting.
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
is stored in the error object, so you can generate the message now or
later, at your convenience.
You should make sure that the JPEG object is cleaned up (with jpeg_abort
or jpeg_destroy) at some point. }
{METHODDEF}
procedure error_exit (cinfo : j_common_ptr);
begin
{ Always display the message }
cinfo^.err^.output_message(cinfo);
{ Let the memory manager delete any temp files before we die }
jpeg_destroy(cinfo);
halt(EXIT_FAILURE);
end;
{ Actual output of an error or trace message.
Applications may override this method to send JPEG messages somewhere
other than stderr. }
{ Macros to simplify using the error and trace message stuff }
{ The first parameter is either type of cinfo pointer }
{ Fatal errors (print message and exit) }
procedure ERREXIT(cinfo : j_common_ptr; code : J_MESSAGE_CODE);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.error_exit(cinfo);
end;
procedure ERREXIT1(cinfo : j_common_ptr; code : J_MESSAGE_CODE; p1 : uInt);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.error_exit (cinfo);
end;
procedure ERREXIT2(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
p1 : int; p2 : int);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.msg_parm.i[1] := p2;
cinfo^.err^.error_exit (cinfo);
end;
procedure ERREXIT3(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.msg_parm.i[1] := p2;
cinfo^.err^.msg_parm.i[2] := p3;
cinfo^.err^.error_exit (cinfo);
end;
procedure ERREXIT4(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.msg_parm.i[1] := p2;
cinfo^.err^.msg_parm.i[2] := p3;
cinfo^.err^.msg_parm.i[3] := p4;
cinfo^.err^.error_exit (cinfo);
end;
procedure ERREXITS(cinfo : j_common_ptr;code : J_MESSAGE_CODE;
str : string);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.s := str; { string[JMSG_STR_PARM_MAX] }
cinfo^.err^.error_exit (cinfo);
end;
{ Nonfatal errors (we can keep going, but the data is probably corrupt) }
procedure WARNMS(cinfo : j_common_ptr; code : J_MESSAGE_CODE);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.emit_message(cinfo, -1);
end;
procedure WARNMS1(cinfo : j_common_ptr;code : J_MESSAGE_CODE; p1 : int);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.emit_message (cinfo, -1);
end;
procedure WARNMS2(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
p1 : int; p2 : int);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.msg_parm.i[1] := p2;
cinfo^.err^.emit_message (cinfo, -1);
end;
{ Informational/debugging messages }
procedure TRACEMS(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.emit_message(cinfo, lvl);
end;
procedure TRACEMS1(cinfo : j_common_ptr; lvl : int;
code : J_MESSAGE_CODE; p1 : long);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.emit_message (cinfo, lvl);
end;
procedure TRACEMS2(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int;
p2 : int);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.msg_parm.i[1] := p2;
cinfo^.err^.emit_message (cinfo, lvl);
end;
procedure TRACEMS3(cinfo : j_common_ptr;
lvl : int;
code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int);
var
_mp : int8array;
begin
_mp[0] := p1; _mp[1] := p2; _mp[2] := p3;
cinfo^.err^.msg_parm.i := _mp;
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.emit_message (cinfo, lvl);
end;
procedure TRACEMS4(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int);
var
_mp : int8array;
begin
_mp[0] := p1; _mp[1] := p2; _mp[2] := p3; _mp[3] := p4;
cinfo^.err^.msg_parm.i := _mp;
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.emit_message (cinfo, lvl);
end;
procedure TRACEMS5(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int; p5 : int);
var
_mp : ^int8array;
begin
_mp := @cinfo^.err^.msg_parm.i;
_mp^[0] := p1; _mp^[1] := p2; _mp^[2] := p3;
_mp^[3] := p4; _mp^[5] := p5;
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.emit_message (cinfo, lvl);
end;
procedure TRACEMS8(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int;
p5 : int; p6 : int; p7 : int; p8 : int);
var
_mp : int8array;
begin
_mp[0] := p1; _mp[1] := p2; _mp[2] := p3; _mp[3] := p4;
_mp[4] := p5; _mp[5] := p6; _mp[6] := p7; _mp[7] := p8;
cinfo^.err^.msg_parm.i := _mp;
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.emit_message (cinfo, lvl);
end;
procedure TRACEMSS(cinfo : j_common_ptr; lvl : int;
code : J_MESSAGE_CODE; str : string);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.s := str; { string JMSG_STR_PARM_MAX }
cinfo^.err^.emit_message (cinfo, lvl);
end;
{METHODDEF}
procedure output_message (cinfo : j_common_ptr);
var
buffer : string; {[JMSG_LENGTH_MAX];}
begin
{ Create the message }
cinfo^.err^.format_message (cinfo, buffer);
{ Send it to stderr, adding a newline }
WriteLn(output, buffer);
end;
{ Decide whether to emit a trace or warning message.
msg_level is one of:
-1: recoverable corrupt-data warning, may want to abort.
0: important advisory messages (always display to user).
1: first level of tracing detail.
2,3,...: successively more detailed tracing messages.
An application might override this method if it wanted to abort on warnings
or change the policy about which messages to display. }
{METHODDEF}
procedure emit_message (cinfo : j_common_ptr; msg_level : int);
var
err : jpeg_error_mgr_ptr;
begin
err := cinfo^.err;
if (msg_level < 0) then
begin
{ It's a warning message. Since corrupt files may generate many warnings,
the policy implemented here is to show only the first warning,
unless trace_level >= 3. }
if (err^.num_warnings = 0) or (err^.trace_level >= 3) then
err^.output_message(cinfo);
{ Always count warnings in num_warnings. }
Inc( err^.num_warnings );
end
else
begin
{ It's a trace message. Show it if trace_level >= msg_level. }
if (err^.trace_level >= msg_level) then
err^.output_message (cinfo);
end;
end;
{ 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
characters. Note that no '\n' character is added to the string.
Few applications should need to override this method. }
{METHODDEF}
procedure format_message (cinfo : j_common_ptr; var buffer : string);
var
err : jpeg_error_mgr_ptr;
msg_code : J_MESSAGE_CODE;
msgtext : string;
isstring : boolean;
begin
err := cinfo^.err;
msg_code := J_MESSAGE_CODE(err^.msg_code);
msgtext := '';
{ Look up message string in proper table }
if (msg_code > JMSG_NOMESSAGE)
and (msg_code <= J_MESSAGE_CODE(err^.last_jpeg_message)) then
begin
msgtext := err^.jpeg_message_table^[msg_code];
end
else
if (err^.addon_message_table <> NIL) and
(msg_code >= err^.first_addon_message) and
(msg_code <= err^.last_addon_message) then
begin
msgtext := err^.addon_message_table^[J_MESSAGE_CODE
(ord(msg_code) - ord(err^.first_addon_message))];
end;
{ Defend against bogus message number }
if (msgtext = '') then
begin
err^.msg_parm.i[0] := int(msg_code);
msgtext := err^.jpeg_message_table^[JMSG_NOMESSAGE];
end;
{ Check for string parameter, as indicated by %s in the message text }
isstring := Pos('%s', msgtext) > 0;
{ Format the message into the passed buffer }
if (isstring) then
buffer := Concat(msgtext, err^.msg_parm.s)
else
begin
{$IFDEF VER70}
FormatStr(buffer, msgtext, err^.msg_parm.i);
{$ELSE}
{$IFDEF NO_FORMAT}
buffer := msgtext;
{$ELSE}
buffer := Format(msgtext, [
err^.msg_parm.i[0], err^.msg_parm.i[1],
err^.msg_parm.i[2], err^.msg_parm.i[3],
err^.msg_parm.i[4], err^.msg_parm.i[5],
err^.msg_parm.i[6], err^.msg_parm.i[7] ]);
{$ENDIF}
{$ENDIF}
end;
end;
{ Reset error state variables at start of a new image.
This is called during compression startup to reset trace/error
processing to default state, without losing any application-specific
method pointers. An application might possibly want to override
this method if it has additional error processing state. }
{METHODDEF}
procedure reset_error_mgr (cinfo : j_common_ptr);
begin
cinfo^.err^.num_warnings := 0;
{ 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" }
end;
{ Fill in the standard error-handling methods in a jpeg_error_mgr object.
Typical call is:
cinfo : jpeg_compress_struct;
err : jpeg_error_mgr;
cinfo.err := jpeg_std_error(@err);
after which the application may override some of the methods. }
{GLOBAL}
function jpeg_std_error (var err : jpeg_error_mgr) : jpeg_error_mgr_ptr;
begin
err.error_exit := error_exit;
err.emit_message := emit_message;
err.output_message := output_message;
err.format_message := format_message;
err.reset_error_mgr := reset_error_mgr;
err.trace_level := 0; { default := no tracing }
err.num_warnings := 0; { no warnings emitted yet }
err.msg_code := 0; { may be useful as a flag for "no error" }
{ Initialize message table pointers }
err.jpeg_message_table := @jpeg_std_message_table;
err.last_jpeg_message := pred(JMSG_LASTMSGCODE);
err.addon_message_table := NIL;
err.first_addon_message := JMSG_NOMESSAGE; { for safety }
err.last_addon_message := JMSG_NOMESSAGE;
jpeg_std_error := @err;
end;
end.
unit imjerror;
{ This file contains simple error-reporting and trace-message routines.
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
some or all of these routines.
These routines are used by both the compression and decompression code. }
{ Source: jerror.c; Copyright (C) 1991-1996, Thomas G. Lane. }
{ note: format_message still contains a hack }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjdeferr,
imjpeglib;
{
jversion;
}
const
EXIT_FAILURE = 1; { define halt() codes if not provided }
{GLOBAL}
function jpeg_std_error (var err : jpeg_error_mgr) : jpeg_error_mgr_ptr;
procedure ERREXIT(cinfo : j_common_ptr; code : J_MESSAGE_CODE);
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 ERREXIT3(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int);
procedure ERREXIT4(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int);
procedure ERREXITS(cinfo : j_common_ptr;code : J_MESSAGE_CODE;
str : AnsiString);
{ Nonfatal errors (we can keep going, but the data is probably corrupt) }
procedure WARNMS(cinfo : j_common_ptr; code : J_MESSAGE_CODE);
procedure WARNMS1(cinfo : j_common_ptr;code : J_MESSAGE_CODE; p1 : int);
procedure WARNMS2(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
p1 : int; p2 : int);
{ Informational/debugging messages }
procedure TRACEMS(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE);
procedure TRACEMS1(cinfo : j_common_ptr; lvl : int;
code : J_MESSAGE_CODE; p1 : long);
procedure TRACEMS2(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int;
p2 : int);
procedure TRACEMS3(cinfo : j_common_ptr;
lvl : int;
code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int);
procedure TRACEMS4(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int);
procedure TRACEMS5(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int; p5 : int);
procedure TRACEMS8(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int;
p5 : int; p6 : int; p7 : int; p8 : int);
procedure TRACEMSS(cinfo : j_common_ptr; lvl : int;
code : J_MESSAGE_CODE; str : AnsiString);
implementation
{ How to format a message string, in format_message() ? }
{$IFDEF OS2}
{$DEFINE NO_FORMAT}
{$ENDIF}
{$IFDEF FPC}
{$DEFINE NO_FORMAT}
{$ENDIF}
uses
{$IFNDEF NO_FORMAT}
{$IFDEF VER70}
drivers, { Turbo Vision unit with FormatStr }
{$ELSE}
sysutils, { Delphi Unit with Format() }
{$ENDIF}
{$ENDIF}
imjcomapi;
{ Error exit handler: must not return to caller.
Applications may override this if they want to get control back after
an error. Typically one would longjmp somewhere instead of exiting.
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
is stored in the error object, so you can generate the message now or
later, at your convenience.
You should make sure that the JPEG object is cleaned up (with jpeg_abort
or jpeg_destroy) at some point. }
{METHODDEF}
procedure error_exit (cinfo : j_common_ptr);
begin
{ Always display the message }
cinfo^.err^.output_message(cinfo);
{ Let the memory manager delete any temp files before we die }
jpeg_destroy(cinfo);
halt(EXIT_FAILURE);
end;
{ Actual output of an error or trace message.
Applications may override this method to send JPEG messages somewhere
other than stderr. }
{ Macros to simplify using the error and trace message stuff }
{ The first parameter is either type of cinfo pointer }
{ Fatal errors (print message and exit) }
procedure ERREXIT(cinfo : j_common_ptr; code : J_MESSAGE_CODE);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.error_exit(cinfo);
end;
procedure ERREXIT1(cinfo : j_common_ptr; code : J_MESSAGE_CODE; p1 : uInt);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.error_exit (cinfo);
end;
procedure ERREXIT2(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
p1 : int; p2 : int);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.msg_parm.i[1] := p2;
cinfo^.err^.error_exit (cinfo);
end;
procedure ERREXIT3(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.msg_parm.i[1] := p2;
cinfo^.err^.msg_parm.i[2] := p3;
cinfo^.err^.error_exit (cinfo);
end;
procedure ERREXIT4(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.msg_parm.i[1] := p2;
cinfo^.err^.msg_parm.i[2] := p3;
cinfo^.err^.msg_parm.i[3] := p4;
cinfo^.err^.error_exit (cinfo);
end;
procedure ERREXITS(cinfo : j_common_ptr;code : J_MESSAGE_CODE;
str : AnsiString);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.s := str; { string[JMSG_STR_PARM_MAX] }
cinfo^.err^.error_exit (cinfo);
end;
{ Nonfatal errors (we can keep going, but the data is probably corrupt) }
procedure WARNMS(cinfo : j_common_ptr; code : J_MESSAGE_CODE);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.emit_message(cinfo, -1);
end;
procedure WARNMS1(cinfo : j_common_ptr;code : J_MESSAGE_CODE; p1 : int);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.emit_message (cinfo, -1);
end;
procedure WARNMS2(cinfo : j_common_ptr; code : J_MESSAGE_CODE;
p1 : int; p2 : int);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.msg_parm.i[1] := p2;
cinfo^.err^.emit_message (cinfo, -1);
end;
{ Informational/debugging messages }
procedure TRACEMS(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.emit_message(cinfo, lvl);
end;
procedure TRACEMS1(cinfo : j_common_ptr; lvl : int;
code : J_MESSAGE_CODE; p1 : long);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.emit_message (cinfo, lvl);
end;
procedure TRACEMS2(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int;
p2 : int);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.i[0] := p1;
cinfo^.err^.msg_parm.i[1] := p2;
cinfo^.err^.emit_message (cinfo, lvl);
end;
procedure TRACEMS3(cinfo : j_common_ptr;
lvl : int;
code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int);
var
_mp : int8array;
begin
_mp[0] := p1; _mp[1] := p2; _mp[2] := p3;
cinfo^.err^.msg_parm.i := _mp;
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.emit_message (cinfo, lvl);
end;
procedure TRACEMS4(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int);
var
_mp : int8array;
begin
_mp[0] := p1; _mp[1] := p2; _mp[2] := p3; _mp[3] := p4;
cinfo^.err^.msg_parm.i := _mp;
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.emit_message (cinfo, lvl);
end;
procedure TRACEMS5(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int; p5 : int);
var
_mp : ^int8array;
begin
_mp := @cinfo^.err^.msg_parm.i;
_mp^[0] := p1; _mp^[1] := p2; _mp^[2] := p3;
_mp^[3] := p4; _mp^[5] := p5;
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.emit_message (cinfo, lvl);
end;
procedure TRACEMS8(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE;
p1 : int; p2 : int; p3 : int; p4 : int;
p5 : int; p6 : int; p7 : int; p8 : int);
var
_mp : int8array;
begin
_mp[0] := p1; _mp[1] := p2; _mp[2] := p3; _mp[3] := p4;
_mp[4] := p5; _mp[5] := p6; _mp[6] := p7; _mp[7] := p8;
cinfo^.err^.msg_parm.i := _mp;
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.emit_message (cinfo, lvl);
end;
procedure TRACEMSS(cinfo : j_common_ptr; lvl : int;
code : J_MESSAGE_CODE; str : AnsiString);
begin
cinfo^.err^.msg_code := ord(code);
cinfo^.err^.msg_parm.s := str; { string JMSG_STR_PARM_MAX }
cinfo^.err^.emit_message (cinfo, lvl);
end;
{METHODDEF}
procedure output_message (cinfo : j_common_ptr);
var
buffer : AnsiString; {[JMSG_LENGTH_MAX];}
begin
{ Create the message }
cinfo^.err^.format_message (cinfo, buffer);
{ Send it to stderr, adding a newline }
WriteLn(output, buffer);
end;
{ Decide whether to emit a trace or warning message.
msg_level is one of:
-1: recoverable corrupt-data warning, may want to abort.
0: important advisory messages (always display to user).
1: first level of tracing detail.
2,3,...: successively more detailed tracing messages.
An application might override this method if it wanted to abort on warnings
or change the policy about which messages to display. }
{METHODDEF}
procedure emit_message (cinfo : j_common_ptr; msg_level : int);
var
err : jpeg_error_mgr_ptr;
begin
err := cinfo^.err;
if (msg_level < 0) then
begin
{ It's a warning message. Since corrupt files may generate many warnings,
the policy implemented here is to show only the first warning,
unless trace_level >= 3. }
if (err^.num_warnings = 0) or (err^.trace_level >= 3) then
err^.output_message(cinfo);
{ Always count warnings in num_warnings. }
Inc( err^.num_warnings );
end
else
begin
{ It's a trace message. Show it if trace_level >= msg_level. }
if (err^.trace_level >= msg_level) then
err^.output_message (cinfo);
end;
end;
{ 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
characters. Note that no '\n' character is added to the string.
Few applications should need to override this method. }
{METHODDEF}
procedure format_message (cinfo : j_common_ptr; var buffer : AnsiString);
var
err : jpeg_error_mgr_ptr;
msg_code : J_MESSAGE_CODE;
msgtext : AnsiString;
isstring : boolean;
begin
err := cinfo^.err;
msg_code := J_MESSAGE_CODE(err^.msg_code);
msgtext := '';
{ Look up message string in proper table }
if (msg_code > JMSG_NOMESSAGE)
and (msg_code <= J_MESSAGE_CODE(err^.last_jpeg_message)) then
begin
msgtext := err^.jpeg_message_table^[msg_code];
end
else
if (err^.addon_message_table <> NIL) and
(msg_code >= err^.first_addon_message) and
(msg_code <= err^.last_addon_message) then
begin
msgtext := err^.addon_message_table^[J_MESSAGE_CODE
(ord(msg_code) - ord(err^.first_addon_message))];
end;
{ Defend against bogus message number }
if (msgtext = '') then
begin
err^.msg_parm.i[0] := int(msg_code);
msgtext := err^.jpeg_message_table^[JMSG_NOMESSAGE];
end;
{ Check for string parameter, as indicated by %s in the message text }
isstring := Pos('%s', msgtext) > 0;
{ Format the message into the passed buffer }
if (isstring) then
buffer := Concat(msgtext, err^.msg_parm.s)
else
begin
{$IFDEF VER70}
FormatStr(buffer, msgtext, err^.msg_parm.i);
{$ELSE}
{$IFDEF NO_FORMAT}
buffer := msgtext;
{$ELSE}
buffer := Format(msgtext, [
err^.msg_parm.i[0], err^.msg_parm.i[1],
err^.msg_parm.i[2], err^.msg_parm.i[3],
err^.msg_parm.i[4], err^.msg_parm.i[5],
err^.msg_parm.i[6], err^.msg_parm.i[7] ]);
{$ENDIF}
{$ENDIF}
end;
end;
{ Reset error state variables at start of a new image.
This is called during compression startup to reset trace/error
processing to default state, without losing any application-specific
method pointers. An application might possibly want to override
this method if it has additional error processing state. }
{METHODDEF}
procedure reset_error_mgr (cinfo : j_common_ptr);
begin
cinfo^.err^.num_warnings := 0;
{ 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" }
end;
{ Fill in the standard error-handling methods in a jpeg_error_mgr object.
Typical call is:
cinfo : jpeg_compress_struct;
err : jpeg_error_mgr;
cinfo.err := jpeg_std_error(@err);
after which the application may override some of the methods. }
{GLOBAL}
function jpeg_std_error (var err : jpeg_error_mgr) : jpeg_error_mgr_ptr;
begin
err.error_exit := error_exit;
err.emit_message := emit_message;
err.output_message := output_message;
err.format_message := format_message;
err.reset_error_mgr := reset_error_mgr;
err.trace_level := 0; { default := no tracing }
err.num_warnings := 0; { no warnings emitted yet }
err.msg_code := 0; { may be useful as a flag for "no error" }
{ Initialize message table pointers }
err.jpeg_message_table := @jpeg_std_message_table;
err.last_jpeg_message := pred(JMSG_LASTMSGCODE);
err.addon_message_table := NIL;
err.first_addon_message := JMSG_NOMESSAGE; { for safety }
err.last_addon_message := JMSG_NOMESSAGE;
jpeg_std_error := @err;
end;
end.

351
Imaging/JpegLib/imjfdctflt.pas
View File

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

474
Imaging/JpegLib/imjfdctfst.pas
View File

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

594
Imaging/JpegLib/imjfdctint.pas
View File

@ -1,297 +1,297 @@
unit imjfdctint;
{ This file contains a slow-but-accurate integer implementation of the
forward DCT (Discrete Cosine Transform).
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
much more complex and seem not to be any faster when reduced to code.
This implementation is based on an algorithm described in
C. Loeffler, A. Ligtenberg and G. Moschytz, "Practical Fast 1-D DCT
Algorithms with 11 Multiplications", Proc. Int'l. Conf. on Acoustics,
Speech, and Signal Processing 1989 (ICASSP '89), pp. 988-991.
The primary algorithm described there uses 11 multiplies and 29 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
multiplication; this allows a very simple and accurate implementation in
scaled fixed-point arithmetic, with a minimal number of shifts. }
{ Original : jfdctint.c ; Copyright (C) 1991-1996, Thomas G. Lane. }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjinclude,
imjutils,
imjpeglib,
imjdct; { Private declarations for DCT subsystem }
{ Perform the forward DCT on one block of samples. }
{GLOBAL}
procedure jpeg_fdct_islow (var data : array of DCTELEM);
implementation
{ This module is specialized to the case DCTSIZE = 8. }
{$ifndef DCTSIZE_IS_8}
Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err }
{$endif}
{ The poop on this scaling stuff is as follows:
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
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
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).
In the IJG code, this factor of 8 is removed by the quantization step
(in jcdctmgr.c), NOT in this module.
We have to do addition and subtraction of the integer inputs, which
is no problem, and multiplication by fractional constants, which is
a problem to do in integer arithmetic. We multiply all the constants
by CONST_SCALE and convert them to integer constants (thus retaining
CONST_BITS bits of precision in the constants). After doing a
multiplication we have to divide the product by CONST_SCALE, with proper
rounding, to produce the correct output. This division can be done
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
full fractional precision.
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
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
array is INT32 anyway.)
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
shows that the values given below are the most effective. }
{$ifdef BITS_IN_JSAMPLE_IS_8}
const
CONST_BITS = 13;
PASS1_BITS = 2;
{$else}
const
CONST_BITS = 13;
PASS1_BITS = 1; { lose a little precision to avoid overflow }
{$endif}
const
CONST_SCALE = (INT32(1) shl CONST_BITS);
const
FIX_0_298631336 = INT32(Round(CONST_SCALE * 0.298631336)); {2446}
FIX_0_390180644 = INT32(Round(CONST_SCALE * 0.390180644)); {3196}
FIX_0_541196100 = INT32(Round(CONST_SCALE * 0.541196100)); {4433}
FIX_0_765366865 = INT32(Round(CONST_SCALE * 0.765366865)); {6270}
FIX_0_899976223 = INT32(Round(CONST_SCALE * 0.899976223)); {7373}
FIX_1_175875602 = INT32(Round(CONST_SCALE * 1.175875602)); {9633}
FIX_1_501321110 = INT32(Round(CONST_SCALE * 1.501321110)); {12299}
FIX_1_847759065 = INT32(Round(CONST_SCALE * 1.847759065)); {15137}
FIX_1_961570560 = INT32(Round(CONST_SCALE * 1.961570560)); {16069}
FIX_2_053119869 = INT32(Round(CONST_SCALE * 2.053119869)); {16819}
FIX_2_562915447 = INT32(Round(CONST_SCALE * 2.562915447)); {20995}
FIX_3_072711026 = INT32(Round(CONST_SCALE * 3.072711026)); {25172}
{ Multiply an INT32 variable by an INT32 constant to yield an INT32 result.
For 8-bit samples with the recommended scaling, all the variable
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.
For 12-bit samples, a full 32-bit multiplication will be needed. }
{$ifdef BITS_IN_JSAMPLE_IS_8}
{MULTIPLY16C16(var,const)}
function Multiply(X, Y: int): INT32;
begin
Multiply := int(X) * INT32(Y);
end;
{$else}
function Multiply(X, Y: INT32): INT32;
begin
Multiply := X * Y;
end;
{$endif}
{ Descale and correctly round an INT32 value that's scaled by N bits.
We assume RIGHT_SHIFT rounds towards minus infinity, so adding
the fudge factor is correct for either sign of X. }
function DESCALE(x : INT32; n : int) : INT32;
var
shift_temp : INT32;
begin
{$ifdef RIGHT_SHIFT_IS_UNSIGNED}
shift_temp := x + (INT32(1) shl (n-1));
if shift_temp < 0 then
Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n))
else
Descale := (shift_temp shr n);
{$else}
Descale := (x + (INT32(1) shl (n-1)) shr n;
{$endif}
end;
{ Perform the forward DCT on one block of samples. }
{GLOBAL}
procedure jpeg_fdct_islow (var data : array of DCTELEM);
type
PWorkspace = ^TWorkspace;
TWorkspace = array [0..DCTSIZE2-1] of DCTELEM;
var
tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7 : INT32;
tmp10, tmp11, tmp12, tmp13 : INT32;
z1, z2, z3, z4, z5 : INT32;
dataptr : PWorkspace;
ctr : int;
{SHIFT_TEMPS}
begin
{ Pass 1: process rows. }
{ Note results are scaled up by sqrt(8) compared to a true DCT; }
{ furthermore, we scale the results by 2**PASS1_BITS. }
dataptr := PWorkspace(@data);
for ctr := DCTSIZE-1 downto 0 do
begin
tmp0 := dataptr^[0] + dataptr^[7];
tmp7 := dataptr^[0] - dataptr^[7];
tmp1 := dataptr^[1] + dataptr^[6];
tmp6 := dataptr^[1] - dataptr^[6];
tmp2 := dataptr^[2] + dataptr^[5];
tmp5 := dataptr^[2] - dataptr^[5];
tmp3 := dataptr^[3] + dataptr^[4];
tmp4 := dataptr^[3] - dataptr^[4];
{ Even part per LL&M figure 1 --- note that published figure is faulty;
rotator "sqrt(2)*c1" should be "sqrt(2)*c6". }
tmp10 := tmp0 + tmp3;
tmp13 := tmp0 - tmp3;
tmp11 := tmp1 + tmp2;
tmp12 := tmp1 - tmp2;
dataptr^[0] := DCTELEM ((tmp10 + tmp11) shl PASS1_BITS);
dataptr^[4] := DCTELEM ((tmp10 - tmp11) shl PASS1_BITS);
z1 := MULTIPLY(tmp12 + tmp13, FIX_0_541196100);
dataptr^[2] := DCTELEM (DESCALE(z1 + MULTIPLY(tmp13, FIX_0_765366865),
CONST_BITS-PASS1_BITS));
dataptr^[6] := DCTELEM (DESCALE(z1 + MULTIPLY(tmp12, - FIX_1_847759065),
CONST_BITS-PASS1_BITS));
{ Odd part per figure 8 --- note paper omits factor of sqrt(2).
cK represents cos(K*pi/16).
i0..i3 in the paper are tmp4..tmp7 here. }
z1 := tmp4 + tmp7;
z2 := tmp5 + tmp6;
z3 := tmp4 + tmp6;
z4 := tmp5 + tmp7;
z5 := MULTIPLY(z3 + z4, FIX_1_175875602); { sqrt(2) * c3 }
tmp4 := MULTIPLY(tmp4, FIX_0_298631336); { 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) }
tmp7 := MULTIPLY(tmp7, FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) }
z1 := MULTIPLY(z1, - FIX_0_899976223); { sqrt(2) * (c7-c3) }
z2 := MULTIPLY(z2, - FIX_2_562915447); { sqrt(2) * (-c1-c3) }
z3 := MULTIPLY(z3, - FIX_1_961570560); { sqrt(2) * (-c3-c5) }
z4 := MULTIPLY(z4, - FIX_0_390180644); { sqrt(2) * (c5-c3) }
Inc(z3, z5);
Inc(z4, z5);
dataptr^[7] := DCTELEM(DESCALE(tmp4 + z1 + z3, 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^[1] := DCTELEM(DESCALE(tmp7 + z1 + z4, CONST_BITS-PASS1_BITS));
Inc(DCTELEMPTR(dataptr), DCTSIZE); { advance pointer to next row }
end;
{ Pass 2: process columns.
We remove the PASS1_BITS scaling, but leave the results scaled up
by an overall factor of 8. }
dataptr := PWorkspace(@data);
for ctr := DCTSIZE-1 downto 0 do
begin
tmp0 := dataptr^[DCTSIZE*0] + dataptr^[DCTSIZE*7];
tmp7 := dataptr^[DCTSIZE*0] - dataptr^[DCTSIZE*7];
tmp1 := dataptr^[DCTSIZE*1] + dataptr^[DCTSIZE*6];
tmp6 := dataptr^[DCTSIZE*1] - dataptr^[DCTSIZE*6];
tmp2 := dataptr^[DCTSIZE*2] + dataptr^[DCTSIZE*5];
tmp5 := dataptr^[DCTSIZE*2] - dataptr^[DCTSIZE*5];
tmp3 := 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;
rotator "sqrt(2)*c1" should be "sqrt(2)*c6". }
tmp10 := tmp0 + tmp3;
tmp13 := tmp0 - tmp3;
tmp11 := tmp1 + tmp2;
tmp12 := tmp1 - tmp2;
dataptr^[DCTSIZE*0] := DCTELEM (DESCALE(tmp10 + tmp11, PASS1_BITS));
dataptr^[DCTSIZE*4] := DCTELEM (DESCALE(tmp10 - tmp11, PASS1_BITS));
z1 := MULTIPLY(tmp12 + tmp13, FIX_0_541196100);
dataptr^[DCTSIZE*2] := DCTELEM (DESCALE(z1 + MULTIPLY(tmp13, FIX_0_765366865),
CONST_BITS+PASS1_BITS));
dataptr^[DCTSIZE*6] := DCTELEM (DESCALE(z1 + MULTIPLY(tmp12, - FIX_1_847759065),
CONST_BITS+PASS1_BITS));
{ Odd part per figure 8 --- note paper omits factor of sqrt(2).
cK represents cos(K*pi/16).
i0..i3 in the paper are tmp4..tmp7 here. }
z1 := tmp4 + tmp7;
z2 := tmp5 + tmp6;
z3 := tmp4 + tmp6;
z4 := tmp5 + tmp7;
z5 := MULTIPLY(z3 + z4, FIX_1_175875602); { sqrt(2) * c3 }
tmp4 := MULTIPLY(tmp4, FIX_0_298631336); { 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) }
tmp7 := MULTIPLY(tmp7, FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) }
z1 := MULTIPLY(z1, - FIX_0_899976223); { sqrt(2) * (c7-c3) }
z2 := MULTIPLY(z2, - FIX_2_562915447); { sqrt(2) * (-c1-c3) }
z3 := MULTIPLY(z3, - FIX_1_961570560); { sqrt(2) * (-c3-c5) }
z4 := MULTIPLY(z4, - FIX_0_390180644); { sqrt(2) * (c5-c3) }
Inc(z3, z5);
Inc(z4, z5);
dataptr^[DCTSIZE*7] := DCTELEM (DESCALE(tmp4 + z1 + z3,
CONST_BITS+PASS1_BITS));
dataptr^[DCTSIZE*5] := DCTELEM (DESCALE(tmp5 + z2 + z4,
CONST_BITS+PASS1_BITS));
dataptr^[DCTSIZE*3] := DCTELEM (DESCALE(tmp6 + z2 + z3,
CONST_BITS+PASS1_BITS));
dataptr^[DCTSIZE*1] := DCTELEM (DESCALE(tmp7 + z1 + z4,
CONST_BITS+PASS1_BITS));
Inc(DCTELEMPTR(dataptr)); { advance pointer to next column }
end;
end;
end.
unit imjfdctint;
{ This file contains a slow-but-accurate integer implementation of the
forward DCT (Discrete Cosine Transform).
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
much more complex and seem not to be any faster when reduced to code.
This implementation is based on an algorithm described in
C. Loeffler, A. Ligtenberg and G. Moschytz, "Practical Fast 1-D DCT
Algorithms with 11 Multiplications", Proc. Int'l. Conf. on Acoustics,
Speech, and Signal Processing 1989 (ICASSP '89), pp. 988-991.
The primary algorithm described there uses 11 multiplies and 29 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
multiplication; this allows a very simple and accurate implementation in
scaled fixed-point arithmetic, with a minimal number of shifts. }
{ Original : jfdctint.c ; Copyright (C) 1991-1996, Thomas G. Lane. }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjinclude,
imjutils,
imjpeglib,
imjdct; { Private declarations for DCT subsystem }
{ Perform the forward DCT on one block of samples. }
{GLOBAL}
procedure jpeg_fdct_islow (var data : array of DCTELEM);
implementation
{ This module is specialized to the case DCTSIZE = 8. }
{$ifndef DCTSIZE_IS_8}
Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err }
{$endif}
{ The poop on this scaling stuff is as follows:
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
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
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).
In the IJG code, this factor of 8 is removed by the quantization step
(in jcdctmgr.c), NOT in this module.
We have to do addition and subtraction of the integer inputs, which
is no problem, and multiplication by fractional constants, which is
a problem to do in integer arithmetic. We multiply all the constants
by CONST_SCALE and convert them to integer constants (thus retaining
CONST_BITS bits of precision in the constants). After doing a
multiplication we have to divide the product by CONST_SCALE, with proper
rounding, to produce the correct output. This division can be done
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
full fractional precision.
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
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
array is INT32 anyway.)
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
shows that the values given below are the most effective. }
{$ifdef BITS_IN_JSAMPLE_IS_8}
const
CONST_BITS = 13;
PASS1_BITS = 2;
{$else}
const
CONST_BITS = 13;
PASS1_BITS = 1; { lose a little precision to avoid overflow }
{$endif}
const
CONST_SCALE = (INT32(1) shl CONST_BITS);
const
FIX_0_298631336 = INT32(Round(CONST_SCALE * 0.298631336)); {2446}
FIX_0_390180644 = INT32(Round(CONST_SCALE * 0.390180644)); {3196}
FIX_0_541196100 = INT32(Round(CONST_SCALE * 0.541196100)); {4433}
FIX_0_765366865 = INT32(Round(CONST_SCALE * 0.765366865)); {6270}
FIX_0_899976223 = INT32(Round(CONST_SCALE * 0.899976223)); {7373}
FIX_1_175875602 = INT32(Round(CONST_SCALE * 1.175875602)); {9633}
FIX_1_501321110 = INT32(Round(CONST_SCALE * 1.501321110)); {12299}
FIX_1_847759065 = INT32(Round(CONST_SCALE * 1.847759065)); {15137}
FIX_1_961570560 = INT32(Round(CONST_SCALE * 1.961570560)); {16069}
FIX_2_053119869 = INT32(Round(CONST_SCALE * 2.053119869)); {16819}
FIX_2_562915447 = INT32(Round(CONST_SCALE * 2.562915447)); {20995}
FIX_3_072711026 = INT32(Round(CONST_SCALE * 3.072711026)); {25172}
{ Multiply an INT32 variable by an INT32 constant to yield an INT32 result.
For 8-bit samples with the recommended scaling, all the variable
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.
For 12-bit samples, a full 32-bit multiplication will be needed. }
{$ifdef BITS_IN_JSAMPLE_IS_8}
{MULTIPLY16C16(var,const)}
function Multiply(X, Y: int): INT32;
begin
Multiply := int(X) * INT32(Y);
end;
{$else}
function Multiply(X, Y: INT32): INT32;
begin
Multiply := X * Y;
end;
{$endif}
{ Descale and correctly round an INT32 value that's scaled by N bits.
We assume RIGHT_SHIFT rounds towards minus infinity, so adding
the fudge factor is correct for either sign of X. }
function DESCALE(x : INT32; n : int) : INT32;
var
shift_temp : INT32;
begin
{$ifdef RIGHT_SHIFT_IS_UNSIGNED}
shift_temp := x + (INT32(1) shl (n-1));
if shift_temp < 0 then
Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n))
else
Descale := (shift_temp shr n);
{$else}
Descale := (x + (INT32(1) shl (n-1)) shr n;
{$endif}
end;
{ Perform the forward DCT on one block of samples. }
{GLOBAL}
procedure jpeg_fdct_islow (var data : array of DCTELEM);
type
PWorkspace = ^TWorkspace;
TWorkspace = array [0..DCTSIZE2-1] of DCTELEM;
var
tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7 : INT32;
tmp10, tmp11, tmp12, tmp13 : INT32;
z1, z2, z3, z4, z5 : INT32;
dataptr : PWorkspace;
ctr : int;
{SHIFT_TEMPS}
begin
{ Pass 1: process rows. }
{ Note results are scaled up by sqrt(8) compared to a true DCT; }
{ furthermore, we scale the results by 2**PASS1_BITS. }
dataptr := PWorkspace(@data);
for ctr := DCTSIZE-1 downto 0 do
begin
tmp0 := dataptr^[0] + dataptr^[7];
tmp7 := dataptr^[0] - dataptr^[7];
tmp1 := dataptr^[1] + dataptr^[6];
tmp6 := dataptr^[1] - dataptr^[6];
tmp2 := dataptr^[2] + dataptr^[5];
tmp5 := dataptr^[2] - dataptr^[5];
tmp3 := dataptr^[3] + dataptr^[4];
tmp4 := dataptr^[3] - dataptr^[4];
{ Even part per LL&M figure 1 --- note that published figure is faulty;
rotator "sqrt(2)*c1" should be "sqrt(2)*c6". }
tmp10 := tmp0 + tmp3;
tmp13 := tmp0 - tmp3;
tmp11 := tmp1 + tmp2;
tmp12 := tmp1 - tmp2;
dataptr^[0] := DCTELEM ((tmp10 + tmp11) shl PASS1_BITS);
dataptr^[4] := DCTELEM ((tmp10 - tmp11) shl PASS1_BITS);
z1 := MULTIPLY(tmp12 + tmp13, FIX_0_541196100);
dataptr^[2] := DCTELEM (DESCALE(z1 + MULTIPLY(tmp13, FIX_0_765366865),
CONST_BITS-PASS1_BITS));
dataptr^[6] := DCTELEM (DESCALE(z1 + MULTIPLY(tmp12, - FIX_1_847759065),
CONST_BITS-PASS1_BITS));
{ Odd part per figure 8 --- note paper omits factor of sqrt(2).
cK represents cos(K*pi/16).
i0..i3 in the paper are tmp4..tmp7 here. }
z1 := tmp4 + tmp7;
z2 := tmp5 + tmp6;
z3 := tmp4 + tmp6;
z4 := tmp5 + tmp7;
z5 := MULTIPLY(z3 + z4, FIX_1_175875602); { sqrt(2) * c3 }
tmp4 := MULTIPLY(tmp4, FIX_0_298631336); { 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) }
tmp7 := MULTIPLY(tmp7, FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) }
z1 := MULTIPLY(z1, - FIX_0_899976223); { sqrt(2) * (c7-c3) }
z2 := MULTIPLY(z2, - FIX_2_562915447); { sqrt(2) * (-c1-c3) }
z3 := MULTIPLY(z3, - FIX_1_961570560); { sqrt(2) * (-c3-c5) }
z4 := MULTIPLY(z4, - FIX_0_390180644); { sqrt(2) * (c5-c3) }
Inc(z3, z5);
Inc(z4, z5);
dataptr^[7] := DCTELEM(DESCALE(tmp4 + z1 + z3, 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^[1] := DCTELEM(DESCALE(tmp7 + z1 + z4, CONST_BITS-PASS1_BITS));
Inc(DCTELEMPTR(dataptr), DCTSIZE); { advance pointer to next row }
end;
{ Pass 2: process columns.
We remove the PASS1_BITS scaling, but leave the results scaled up
by an overall factor of 8. }
dataptr := PWorkspace(@data);
for ctr := DCTSIZE-1 downto 0 do
begin
tmp0 := dataptr^[DCTSIZE*0] + dataptr^[DCTSIZE*7];
tmp7 := dataptr^[DCTSIZE*0] - dataptr^[DCTSIZE*7];
tmp1 := dataptr^[DCTSIZE*1] + dataptr^[DCTSIZE*6];
tmp6 := dataptr^[DCTSIZE*1] - dataptr^[DCTSIZE*6];
tmp2 := dataptr^[DCTSIZE*2] + dataptr^[DCTSIZE*5];
tmp5 := dataptr^[DCTSIZE*2] - dataptr^[DCTSIZE*5];
tmp3 := 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;
rotator "sqrt(2)*c1" should be "sqrt(2)*c6". }
tmp10 := tmp0 + tmp3;
tmp13 := tmp0 - tmp3;
tmp11 := tmp1 + tmp2;
tmp12 := tmp1 - tmp2;
dataptr^[DCTSIZE*0] := DCTELEM (DESCALE(tmp10 + tmp11, PASS1_BITS));
dataptr^[DCTSIZE*4] := DCTELEM (DESCALE(tmp10 - tmp11, PASS1_BITS));
z1 := MULTIPLY(tmp12 + tmp13, FIX_0_541196100);
dataptr^[DCTSIZE*2] := DCTELEM (DESCALE(z1 + MULTIPLY(tmp13, FIX_0_765366865),
CONST_BITS+PASS1_BITS));
dataptr^[DCTSIZE*6] := DCTELEM (DESCALE(z1 + MULTIPLY(tmp12, - FIX_1_847759065),
CONST_BITS+PASS1_BITS));
{ Odd part per figure 8 --- note paper omits factor of sqrt(2).
cK represents cos(K*pi/16).
i0..i3 in the paper are tmp4..tmp7 here. }
z1 := tmp4 + tmp7;
z2 := tmp5 + tmp6;
z3 := tmp4 + tmp6;
z4 := tmp5 + tmp7;
z5 := MULTIPLY(z3 + z4, FIX_1_175875602); { sqrt(2) * c3 }
tmp4 := MULTIPLY(tmp4, FIX_0_298631336); { 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) }
tmp7 := MULTIPLY(tmp7, FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) }
z1 := MULTIPLY(z1, - FIX_0_899976223); { sqrt(2) * (c7-c3) }
z2 := MULTIPLY(z2, - FIX_2_562915447); { sqrt(2) * (-c1-c3) }
z3 := MULTIPLY(z3, - FIX_1_961570560); { sqrt(2) * (-c3-c5) }
z4 := MULTIPLY(z4, - FIX_0_390180644); { sqrt(2) * (c5-c3) }
Inc(z3, z5);
Inc(z4, z5);
dataptr^[DCTSIZE*7] := DCTELEM (DESCALE(tmp4 + z1 + z3,
CONST_BITS+PASS1_BITS));
dataptr^[DCTSIZE*5] := DCTELEM (DESCALE(tmp5 + z2 + z4,
CONST_BITS+PASS1_BITS));
dataptr^[DCTSIZE*3] := DCTELEM (DESCALE(tmp6 + z2 + z3,
CONST_BITS+PASS1_BITS));
dataptr^[DCTSIZE*1] := DCTELEM (DESCALE(tmp7 + z1 + z4,
CONST_BITS+PASS1_BITS));
Inc(DCTELEMPTR(dataptr)); { advance pointer to next column }
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;
{$N+}
{ This file contains a floating-point implementation of the
inverse DCT (Discrete Cosine Transform). In the IJG code, this routine
must also perform dequantization of the input coefficients.
This implementation should be more accurate than either of the integer
IDCT implementations. However, it may not give the same results on all
machines because of differences in roundoff behavior. Speed will depend
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
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
complex and seem not to be any faster when reduced to code.
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
Japanese, but the algorithm is described in the Pennebaker & Mitchell
JPEG textbook (see REFERENCES section in file README). The following code
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
possible to arrange the computation so that many of the multiplies are
simple scalings of the final outputs. These multiplies can then be
folded into the multiplications or divisions by the JPEG quantization
table entries. The AA&N method leaves only 5 multiplies and 29 adds
to be done in the DCT itself.
The primary disadvantage of this method is that with a fixed-point
implementation, accuracy is lost due to imprecise representation of the
scaled quantization values. However, that problem does not arise if
we use floating point arithmetic. }
{ Original: jidctflt.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjinclude,
imjpeglib,
imjdct; { Private declarations for DCT subsystem }
{ Perform dequantization and inverse DCT on one block of coefficients. }
{GLOBAL}
procedure jpeg_idct_float (cinfo : j_decompress_ptr;
compptr : jpeg_component_info_ptr;
coef_block : JCOEFPTR;
output_buf : JSAMPARRAY;
output_col : JDIMENSION);
implementation
{ This module is specialized to the case DCTSIZE = 8. }
{$ifndef DCTSIZE_IS_8}
Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err }
{$endif}
{ Dequantize a coefficient by multiplying it by the multiplier-table
entry; produce a float result. }
function DEQUANTIZE(coef : int; quantval : FAST_FLOAT) : FAST_FLOAT;
begin
Dequantize := ( (coef) * quantval);
end;
{ Descale and correctly round an INT32 value that's scaled by N bits.
We assume RIGHT_SHIFT rounds towards minus infinity, so adding
the fudge factor is correct for either sign of X. }
function DESCALE(x : INT32; n : int) : INT32;
var
shift_temp : INT32;
begin
{$ifdef RIGHT_SHIFT_IS_UNSIGNED}
shift_temp := x + (INT32(1) shl (n-1));
if shift_temp < 0 then
Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n))
else
Descale := (shift_temp shr n);
{$else}
Descale := (x + (INT32(1) shl (n-1)) shr n;
{$endif}
end;
{ Perform dequantization and inverse DCT on one block of coefficients. }
{GLOBAL}
procedure jpeg_idct_float (cinfo : j_decompress_ptr;
compptr : jpeg_component_info_ptr;
coef_block : JCOEFPTR;
output_buf : JSAMPARRAY;
output_col : JDIMENSION);
type
PWorkspace = ^TWorkspace;
TWorkspace = array[0..DCTSIZE2-1] of FAST_FLOAT;
var
tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7 : FAST_FLOAT;
tmp10, tmp11, tmp12, tmp13 : FAST_FLOAT;
z5, z10, z11, z12, z13 : FAST_FLOAT;
inptr : JCOEFPTR;
quantptr : FLOAT_MULT_TYPE_FIELD_PTR;
wsptr : PWorkSpace;
outptr : JSAMPROW;
range_limit : JSAMPROW;
ctr : int;
workspace : TWorkspace; { buffers data between passes }
{SHIFT_TEMPS}
var
dcval : FAST_FLOAT;
begin
{ Each IDCT routine is responsible for range-limiting its results and
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
range-limiting step is required. We use a mask-and-table-lookup method
to do the combined operations quickly. See the comments with
prepare_range_limit_table (in jdmaster.c) for more info. }
range_limit := JSAMPROW(@(cinfo^.sample_range_limit^[CENTERJSAMPLE]));
{ Pass 1: process columns from input, store into work array. }
inptr := coef_block;
quantptr := FLOAT_MULT_TYPE_FIELD_PTR (compptr^.dct_table);
wsptr := @workspace;
for ctr := pred(DCTSIZE) downto 0 do
begin
{ Due to quantization, we will usually find that many of the input
coefficients are zero, especially the AC terms. We can exploit this
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
DC coefficient (with scale factor as needed).
With typical images and quantization tables, half or more of the
column DCT calculations can be simplified this way. }
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*7]=0) then
begin
{ AC terms all zero }
FAST_FLOAT(dcval) := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]);
wsptr^[DCTSIZE*0] := dcval;
wsptr^[DCTSIZE*1] := dcval;
wsptr^[DCTSIZE*2] := dcval;
wsptr^[DCTSIZE*3] := dcval;
wsptr^[DCTSIZE*4] := dcval;
wsptr^[DCTSIZE*5] := dcval;
wsptr^[DCTSIZE*6] := dcval;
wsptr^[DCTSIZE*7] := dcval;
Inc(JCOEF_PTR(inptr)); { advance pointers to next column }
Inc(FLOAT_MULT_TYPE_PTR(quantptr));
Inc(FAST_FLOAT_PTR(wsptr));
continue;
end;
{ Even part }
tmp0 := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]);
tmp1 := DEQUANTIZE(inptr^[DCTSIZE*2], quantptr^[DCTSIZE*2]);
tmp2 := DEQUANTIZE(inptr^[DCTSIZE*4], quantptr^[DCTSIZE*4]);
tmp3 := DEQUANTIZE(inptr^[DCTSIZE*6], quantptr^[DCTSIZE*6]);
tmp10 := tmp0 + tmp2; { phase 3 }
tmp11 := tmp0 - tmp2;
tmp13 := tmp1 + tmp3; { phases 5-3 }
tmp12 := (tmp1 - tmp3) * ({FAST_FLOAT}(1.414213562)) - tmp13; { 2*c4 }
tmp0 := tmp10 + tmp13; { phase 2 }
tmp3 := tmp10 - tmp13;
tmp1 := tmp11 + tmp12;
tmp2 := tmp11 - tmp12;
{ Odd part }
tmp4 := DEQUANTIZE(inptr^[DCTSIZE*1], quantptr^[DCTSIZE*1]);
tmp5 := DEQUANTIZE(inptr^[DCTSIZE*3], quantptr^[DCTSIZE*3]);
tmp6 := DEQUANTIZE(inptr^[DCTSIZE*5], quantptr^[DCTSIZE*5]);
tmp7 := DEQUANTIZE(inptr^[DCTSIZE*7], quantptr^[DCTSIZE*7]);
z13 := tmp6 + tmp5; { phase 6 }
z10 := tmp6 - tmp5;
z11 := tmp4 + tmp7;
z12 := tmp4 - tmp7;
tmp7 := z11 + z13; { phase 5 }
tmp11 := (z11 - z13) * ({FAST_FLOAT}(1.414213562)); { 2*c4 }
z5 := (z10 + z12) * ({FAST_FLOAT}(1.847759065)); { 2*c2 }
tmp10 := ({FAST_FLOAT}(1.082392200)) * z12 - z5; { 2*(c2-c6) }
tmp12 := ({FAST_FLOAT}(-2.613125930)) * z10 + z5; { -2*(c2+c6) }
tmp6 := tmp12 - tmp7; { phase 2 }
tmp5 := tmp11 - tmp6;
tmp4 := tmp10 + tmp5;
wsptr^[DCTSIZE*0] := tmp0 + tmp7;
wsptr^[DCTSIZE*7] := tmp0 - tmp7;
wsptr^[DCTSIZE*1] := tmp1 + tmp6;
wsptr^[DCTSIZE*6] := tmp1 - tmp6;
wsptr^[DCTSIZE*2] := tmp2 + tmp5;
wsptr^[DCTSIZE*5] := tmp2 - tmp5;
wsptr^[DCTSIZE*4] := tmp3 + tmp4;
wsptr^[DCTSIZE*3] := tmp3 - tmp4;
Inc(JCOEF_PTR(inptr)); { advance pointers to next column }
Inc(FLOAT_MULT_TYPE_PTR(quantptr));
Inc(FAST_FLOAT_PTR(wsptr));
end;
{ 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. }
wsptr := @workspace;
for ctr := 0 to pred(DCTSIZE) do
begin
outptr := JSAMPROW(@(output_buf^[ctr]^[output_col]));
{ 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
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. }
{ Even part }
tmp10 := wsptr^[0] + wsptr^[4];
tmp11 := wsptr^[0] - wsptr^[4];
tmp13 := wsptr^[2] + wsptr^[6];
tmp12 := (wsptr^[2] - wsptr^[6]) * ({FAST_FLOAT}(1.414213562)) - tmp13;
tmp0 := tmp10 + tmp13;
tmp3 := tmp10 - tmp13;
tmp1 := tmp11 + tmp12;
tmp2 := tmp11 - tmp12;
{ Odd part }
z13 := wsptr^[5] + wsptr^[3];
z10 := wsptr^[5] - wsptr^[3];
z11 := wsptr^[1] + wsptr^[7];
z12 := wsptr^[1] - wsptr^[7];
tmp7 := z11 + z13;
tmp11 := (z11 - z13) * ({FAST_FLOAT}(1.414213562));
z5 := (z10 + z12) * ({FAST_FLOAT}(1.847759065)); { 2*c2 }
tmp10 := ({FAST_FLOAT}(1.082392200)) * z12 - z5; { 2*(c2-c6) }
tmp12 := ({FAST_FLOAT}(-2.613125930)) * z10 + z5; { -2*(c2+c6) }
tmp6 := tmp12 - tmp7;
tmp5 := tmp11 - tmp6;
tmp4 := tmp10 + tmp5;
{ Final output stage: scale down by a factor of 8 and range-limit }
outptr^[0] := range_limit^[ int(DESCALE( INT32(Round((tmp0 + tmp7))), 3))
and RANGE_MASK];
outptr^[7] := range_limit^[ int(DESCALE( INT32(Round((tmp0 - tmp7))), 3))
and RANGE_MASK];
outptr^[1] := range_limit^[ int(DESCALE( INT32(Round((tmp1 + tmp6))), 3))
and RANGE_MASK];
outptr^[6] := range_limit^[ int(DESCALE( INT32(Round((tmp1 - tmp6))), 3))
and RANGE_MASK];
outptr^[2] := range_limit^[ int(DESCALE( INT32(Round((tmp2 + tmp5))), 3))
and RANGE_MASK];
outptr^[5] := range_limit^[ int(DESCALE( INT32(Round((tmp2 - tmp5))), 3))
and RANGE_MASK];
outptr^[4] := range_limit^[ int(DESCALE( INT32(Round((tmp3 + tmp4))), 3))
and RANGE_MASK];
outptr^[3] := range_limit^[ int(DESCALE( INT32(Round((tmp3 - tmp4))), 3))
and RANGE_MASK];
Inc(FAST_FLOAT_PTR(wsptr), DCTSIZE); { advance pointer to next row }
end;
end;
end.
unit imjidctflt;
{ This file contains a floating-point implementation of the
inverse DCT (Discrete Cosine Transform). In the IJG code, this routine
must also perform dequantization of the input coefficients.
This implementation should be more accurate than either of the integer
IDCT implementations. However, it may not give the same results on all
machines because of differences in roundoff behavior. Speed will depend
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
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
complex and seem not to be any faster when reduced to code.
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
Japanese, but the algorithm is described in the Pennebaker & Mitchell
JPEG textbook (see REFERENCES section in file README). The following code
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
possible to arrange the computation so that many of the multiplies are
simple scalings of the final outputs. These multiplies can then be
folded into the multiplications or divisions by the JPEG quantization
table entries. The AA&N method leaves only 5 multiplies and 29 adds
to be done in the DCT itself.
The primary disadvantage of this method is that with a fixed-point
implementation, accuracy is lost due to imprecise representation of the
scaled quantization values. However, that problem does not arise if
we use floating point arithmetic. }
{ Original: jidctflt.c ; Copyright (C) 1994-1996, Thomas G. Lane. }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjinclude,
imjpeglib,
imjdct; { Private declarations for DCT subsystem }
{ Perform dequantization and inverse DCT on one block of coefficients. }
{GLOBAL}
procedure jpeg_idct_float (cinfo : j_decompress_ptr;
compptr : jpeg_component_info_ptr;
coef_block : JCOEFPTR;
output_buf : JSAMPARRAY;
output_col : JDIMENSION);
implementation
{ This module is specialized to the case DCTSIZE = 8. }
{$ifndef DCTSIZE_IS_8}
Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err }
{$endif}
{ Dequantize a coefficient by multiplying it by the multiplier-table
entry; produce a float result. }
function DEQUANTIZE(coef : int; quantval : FAST_FLOAT) : FAST_FLOAT;
begin
Dequantize := ( (coef) * quantval);
end;
{ Descale and correctly round an INT32 value that's scaled by N bits.
We assume RIGHT_SHIFT rounds towards minus infinity, so adding
the fudge factor is correct for either sign of X. }
function DESCALE(x : INT32; n : int) : INT32;
var
shift_temp : INT32;
begin
{$ifdef RIGHT_SHIFT_IS_UNSIGNED}
shift_temp := x + (INT32(1) shl (n-1));
if shift_temp < 0 then
Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n))
else
Descale := (shift_temp shr n);
{$else}
Descale := (x + (INT32(1) shl (n-1)) shr n;
{$endif}
end;
{ Perform dequantization and inverse DCT on one block of coefficients. }
{GLOBAL}
procedure jpeg_idct_float (cinfo : j_decompress_ptr;
compptr : jpeg_component_info_ptr;
coef_block : JCOEFPTR;
output_buf : JSAMPARRAY;
output_col : JDIMENSION);
type
PWorkspace = ^TWorkspace;
TWorkspace = array[0..DCTSIZE2-1] of FAST_FLOAT;
var
tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7 : FAST_FLOAT;
tmp10, tmp11, tmp12, tmp13 : FAST_FLOAT;
z5, z10, z11, z12, z13 : FAST_FLOAT;
inptr : JCOEFPTR;
quantptr : FLOAT_MULT_TYPE_FIELD_PTR;
wsptr : PWorkSpace;
outptr : JSAMPROW;
range_limit : JSAMPROW;
ctr : int;
workspace : TWorkspace; { buffers data between passes }
{SHIFT_TEMPS}
var
dcval : FAST_FLOAT;
begin
{ Each IDCT routine is responsible for range-limiting its results and
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
range-limiting step is required. We use a mask-and-table-lookup method
to do the combined operations quickly. See the comments with
prepare_range_limit_table (in jdmaster.c) for more info. }
range_limit := JSAMPROW(@(cinfo^.sample_range_limit^[CENTERJSAMPLE]));
{ Pass 1: process columns from input, store into work array. }
inptr := coef_block;
quantptr := FLOAT_MULT_TYPE_FIELD_PTR (compptr^.dct_table);
wsptr := @workspace;
for ctr := pred(DCTSIZE) downto 0 do
begin
{ Due to quantization, we will usually find that many of the input
coefficients are zero, especially the AC terms. We can exploit this
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
DC coefficient (with scale factor as needed).
With typical images and quantization tables, half or more of the
column DCT calculations can be simplified this way. }
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*7]=0) then
begin
{ AC terms all zero }
FAST_FLOAT(dcval) := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]);
wsptr^[DCTSIZE*0] := dcval;
wsptr^[DCTSIZE*1] := dcval;
wsptr^[DCTSIZE*2] := dcval;
wsptr^[DCTSIZE*3] := dcval;
wsptr^[DCTSIZE*4] := dcval;
wsptr^[DCTSIZE*5] := dcval;
wsptr^[DCTSIZE*6] := dcval;
wsptr^[DCTSIZE*7] := dcval;
Inc(JCOEF_PTR(inptr)); { advance pointers to next column }
Inc(FLOAT_MULT_TYPE_PTR(quantptr));
Inc(FAST_FLOAT_PTR(wsptr));
continue;
end;
{ Even part }
tmp0 := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]);
tmp1 := DEQUANTIZE(inptr^[DCTSIZE*2], quantptr^[DCTSIZE*2]);
tmp2 := DEQUANTIZE(inptr^[DCTSIZE*4], quantptr^[DCTSIZE*4]);
tmp3 := DEQUANTIZE(inptr^[DCTSIZE*6], quantptr^[DCTSIZE*6]);
tmp10 := tmp0 + tmp2; { phase 3 }
tmp11 := tmp0 - tmp2;
tmp13 := tmp1 + tmp3; { phases 5-3 }
tmp12 := (tmp1 - tmp3) * ({FAST_FLOAT}(1.414213562)) - tmp13; { 2*c4 }
tmp0 := tmp10 + tmp13; { phase 2 }
tmp3 := tmp10 - tmp13;
tmp1 := tmp11 + tmp12;
tmp2 := tmp11 - tmp12;
{ Odd part }
tmp4 := DEQUANTIZE(inptr^[DCTSIZE*1], quantptr^[DCTSIZE*1]);
tmp5 := DEQUANTIZE(inptr^[DCTSIZE*3], quantptr^[DCTSIZE*3]);
tmp6 := DEQUANTIZE(inptr^[DCTSIZE*5], quantptr^[DCTSIZE*5]);
tmp7 := DEQUANTIZE(inptr^[DCTSIZE*7], quantptr^[DCTSIZE*7]);
z13 := tmp6 + tmp5; { phase 6 }
z10 := tmp6 - tmp5;
z11 := tmp4 + tmp7;
z12 := tmp4 - tmp7;
tmp7 := z11 + z13; { phase 5 }
tmp11 := (z11 - z13) * ({FAST_FLOAT}(1.414213562)); { 2*c4 }
z5 := (z10 + z12) * ({FAST_FLOAT}(1.847759065)); { 2*c2 }
tmp10 := ({FAST_FLOAT}(1.082392200)) * z12 - z5; { 2*(c2-c6) }
tmp12 := ({FAST_FLOAT}(-2.613125930)) * z10 + z5; { -2*(c2+c6) }
tmp6 := tmp12 - tmp7; { phase 2 }
tmp5 := tmp11 - tmp6;
tmp4 := tmp10 + tmp5;
wsptr^[DCTSIZE*0] := tmp0 + tmp7;
wsptr^[DCTSIZE*7] := tmp0 - tmp7;
wsptr^[DCTSIZE*1] := tmp1 + tmp6;
wsptr^[DCTSIZE*6] := tmp1 - tmp6;
wsptr^[DCTSIZE*2] := tmp2 + tmp5;
wsptr^[DCTSIZE*5] := tmp2 - tmp5;
wsptr^[DCTSIZE*4] := tmp3 + tmp4;
wsptr^[DCTSIZE*3] := tmp3 - tmp4;
Inc(JCOEF_PTR(inptr)); { advance pointers to next column }
Inc(FLOAT_MULT_TYPE_PTR(quantptr));
Inc(FAST_FLOAT_PTR(wsptr));
end;
{ 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. }
wsptr := @workspace;
for ctr := 0 to pred(DCTSIZE) do
begin
outptr := JSAMPROW(@(output_buf^[ctr]^[output_col]));
{ 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
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. }
{ Even part }
tmp10 := wsptr^[0] + wsptr^[4];
tmp11 := wsptr^[0] - wsptr^[4];
tmp13 := wsptr^[2] + wsptr^[6];
tmp12 := (wsptr^[2] - wsptr^[6]) * ({FAST_FLOAT}(1.414213562)) - tmp13;
tmp0 := tmp10 + tmp13;
tmp3 := tmp10 - tmp13;
tmp1 := tmp11 + tmp12;
tmp2 := tmp11 - tmp12;
{ Odd part }
z13 := wsptr^[5] + wsptr^[3];
z10 := wsptr^[5] - wsptr^[3];
z11 := wsptr^[1] + wsptr^[7];
z12 := wsptr^[1] - wsptr^[7];
tmp7 := z11 + z13;
tmp11 := (z11 - z13) * ({FAST_FLOAT}(1.414213562));
z5 := (z10 + z12) * ({FAST_FLOAT}(1.847759065)); { 2*c2 }
tmp10 := ({FAST_FLOAT}(1.082392200)) * z12 - z5; { 2*(c2-c6) }
tmp12 := ({FAST_FLOAT}(-2.613125930)) * z10 + z5; { -2*(c2+c6) }
tmp6 := tmp12 - tmp7;
tmp5 := tmp11 - tmp6;
tmp4 := tmp10 + tmp5;
{ Final output stage: scale down by a factor of 8 and range-limit }
outptr^[0] := range_limit^[ int(DESCALE( INT32(Round((tmp0 + tmp7))), 3))
and RANGE_MASK];
outptr^[7] := range_limit^[ int(DESCALE( INT32(Round((tmp0 - tmp7))), 3))
and RANGE_MASK];
outptr^[1] := range_limit^[ int(DESCALE( INT32(Round((tmp1 + tmp6))), 3))
and RANGE_MASK];
outptr^[6] := range_limit^[ int(DESCALE( INT32(Round((tmp1 - tmp6))), 3))
and RANGE_MASK];
outptr^[2] := range_limit^[ int(DESCALE( INT32(Round((tmp2 + tmp5))), 3))
and RANGE_MASK];
outptr^[5] := range_limit^[ int(DESCALE( INT32(Round((tmp2 - tmp5))), 3))
and RANGE_MASK];
outptr^[4] := range_limit^[ int(DESCALE( INT32(Round((tmp3 + tmp4))), 3))
and RANGE_MASK];
outptr^[3] := range_limit^[ int(DESCALE( INT32(Round((tmp3 - tmp4))), 3))
and RANGE_MASK];
Inc(FAST_FLOAT_PTR(wsptr), DCTSIZE); { advance pointer to next row }
end;
end;
end.

820
Imaging/JpegLib/imjidctfst.pas
View File

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

880
Imaging/JpegLib/imjidctint.pas
View File

@ -1,440 +1,440 @@
unit imjidctint;
{$Q+}
{ This file contains a slow-but-accurate integer implementation of the
inverse DCT (Discrete Cosine Transform). In the IJG code, this routine
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
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
complex and seem not to be any faster when reduced to code.
This implementation is based on an algorithm described in
C. Loeffler, A. Ligtenberg and G. Moschytz, "Practical Fast 1-D DCT
Algorithms with 11 Multiplications", Proc. Int'l. Conf. on Acoustics,
Speech, and Signal Processing 1989 (ICASSP '89), pp. 988-991.
The primary algorithm described there uses 11 multiplies and 29 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
multiplication; this allows a very simple and accurate implementation in
scaled fixed-point arithmetic, with a minimal number of shifts. }
{ Original : jidctint.c ; Copyright (C) 1991-1998, Thomas G. Lane. }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjinclude,
imjpeglib,
imjdct; { Private declarations for DCT subsystem }
{ Perform dequantization and inverse DCT on one block of coefficients. }
{GLOBAL}
procedure jpeg_idct_islow (cinfo : j_decompress_ptr;
compptr : jpeg_component_info_ptr;
coef_block : JCOEFPTR;
output_buf : JSAMPARRAY;
output_col : JDIMENSION);
implementation
{ This module is specialized to the case DCTSIZE = 8. }
{$ifndef DCTSIZE_IS_8}
Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err }
{$endif}
{ The poop on this scaling stuff is as follows:
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
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
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).
We have to do addition and subtraction of the integer inputs, which
is no problem, and multiplication by fractional constants, which is
a problem to do in integer arithmetic. We multiply all the constants
by CONST_SCALE and convert them to integer constants (thus retaining
CONST_BITS bits of precision in the constants). After doing a
multiplication we have to divide the product by CONST_SCALE, with proper
rounding, to produce the correct output. This division can be done
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
full fractional precision.
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
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
intermediate INT32 array would be needed.)
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
shows that the values given below are the most effective. }
{$ifdef BITS_IN_JSAMPLE_IS_8}
const
CONST_BITS = 13;
PASS1_BITS = 2;
{$else}
const
CONST_BITS = 13;
PASS1_BITS = 1; { lose a little precision to avoid overflow }
{$endif}
const
CONST_SCALE = (INT32(1) shl CONST_BITS);
const
FIX_0_298631336 = INT32(Round(CONST_SCALE * 0.298631336)); {2446}
FIX_0_390180644 = INT32(Round(CONST_SCALE * 0.390180644)); {3196}
FIX_0_541196100 = INT32(Round(CONST_SCALE * 0.541196100)); {4433}
FIX_0_765366865 = INT32(Round(CONST_SCALE * 0.765366865)); {6270}
FIX_0_899976223 = INT32(Round(CONST_SCALE * 0.899976223)); {7373}
FIX_1_175875602 = INT32(Round(CONST_SCALE * 1.175875602)); {9633}
FIX_1_501321110 = INT32(Round(CONST_SCALE * 1.501321110)); {12299}
FIX_1_847759065 = INT32(Round(CONST_SCALE * 1.847759065)); {15137}
FIX_1_961570560 = INT32(Round(CONST_SCALE * 1.961570560)); {16069}
FIX_2_053119869 = INT32(Round(CONST_SCALE * 2.053119869)); {16819}
FIX_2_562915447 = INT32(Round(CONST_SCALE * 2.562915447)); {20995}
FIX_3_072711026 = INT32(Round(CONST_SCALE * 3.072711026)); {25172}
{ Multiply an INT32 variable by an INT32 constant to yield an INT32 result.
For 8-bit samples with the recommended scaling, all the variable
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.
For 12-bit samples, a full 32-bit multiplication will be needed. }
{$ifdef BITS_IN_JSAMPLE_IS_8}
{$IFDEF BASM16}
{$IFNDEF WIN32}
{MULTIPLY16C16(var,const)}
function Multiply(X, Y: Integer): integer; assembler;
asm
mov ax, X
imul Y
mov al, ah
mov ah, dl
end;
{$ENDIF}
{$ENDIF}
function Multiply(X, Y: INT32): INT32;
begin
Multiply := INT32(X) * INT32(Y);
end;
{$else}
{#define MULTIPLY(var,const) ((var) * (const))}
function Multiply(X, Y: INT32): INT32;
begin
Multiply := INT32(X) * INT32(Y);
end;
{$endif}
{ Dequantize a coefficient by multiplying it by the multiplier-table
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. }
function DEQUANTIZE(coef,quantval : int) : int;
begin
Dequantize := ( ISLOW_MULT_TYPE(coef) * quantval);
end;
{ Descale and correctly round an INT32 value that's scaled by N bits.
We assume RIGHT_SHIFT rounds towards minus infinity, so adding
the fudge factor is correct for either sign of X. }
function DESCALE(x : INT32; n : int) : INT32;
var
shift_temp : INT32;
begin
{$ifdef RIGHT_SHIFT_IS_UNSIGNED}
shift_temp := x + (INT32(1) shl (n-1));
if shift_temp < 0 then
Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n))
else
Descale := (shift_temp shr n);
{$else}
Descale := (x + (INT32(1) shl (n-1)) shr n;
{$endif}
end;
{ Perform dequantization and inverse DCT on one block of coefficients. }
{GLOBAL}
procedure jpeg_idct_islow (cinfo : j_decompress_ptr;
compptr : jpeg_component_info_ptr;
coef_block : JCOEFPTR;
output_buf : JSAMPARRAY;
output_col : JDIMENSION);
type
PWorkspace = ^TWorkspace;
TWorkspace = coef_bits_field; { buffers data between passes }
var
tmp0, tmp1, tmp2, tmp3 : INT32;
tmp10, tmp11, tmp12, tmp13 : INT32;
z1, z2, z3, z4, z5 : INT32;
inptr : JCOEFPTR;
quantptr : ISLOW_MULT_TYPE_FIELD_PTR;
wsptr : PWorkspace;
outptr : JSAMPROW;
range_limit : JSAMPROW;
ctr : int;
workspace : TWorkspace;
{SHIFT_TEMPS}
var
dcval : int;
var
dcval_ : JSAMPLE;
begin
{ Each IDCT routine is responsible for range-limiting its results and
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
range-limiting step is required. We use a mask-and-table-lookup method
to do the combined operations quickly. See the comments with
prepare_range_limit_table (in jdmaster.c) for more info. }
range_limit := JSAMPROW(@(cinfo^.sample_range_limit^[CENTERJSAMPLE]));
{ Pass 1: process columns from input, store into work array. }
{ Note results are scaled up by sqrt(8) compared to a true IDCT; }
{ furthermore, we scale the results by 2**PASS1_BITS. }
inptr := coef_block;
quantptr := ISLOW_MULT_TYPE_FIELD_PTR (compptr^.dct_table);
wsptr := PWorkspace(@workspace);
for ctr := pred(DCTSIZE) downto 0 do
begin
{ Due to quantization, we will usually find that many of the input
coefficients are zero, especially the AC terms. We can exploit this
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
DC coefficient (with scale factor as needed).
With typical images and quantization tables, half or more of the
column DCT calculations can be simplified this way. }
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*7]=0)) then
begin
{ AC terms all zero }
dcval := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]) shl PASS1_BITS;
wsptr^[DCTSIZE*0] := dcval;
wsptr^[DCTSIZE*1] := dcval;
wsptr^[DCTSIZE*2] := dcval;
wsptr^[DCTSIZE*3] := dcval;
wsptr^[DCTSIZE*4] := dcval;
wsptr^[DCTSIZE*5] := dcval;
wsptr^[DCTSIZE*6] := dcval;
wsptr^[DCTSIZE*7] := dcval;
Inc(JCOEF_PTR(inptr)); { advance pointers to next column }
Inc(ISLOW_MULT_TYPE_PTR(quantptr));
Inc(int_ptr(wsptr));
continue;
end;
{ Even part: reverse the even part of the forward DCT. }
{ The rotator is sqrt(2)*c(-6). }
z2 := DEQUANTIZE(inptr^[DCTSIZE*2], quantptr^[DCTSIZE*2]);
z3 := DEQUANTIZE(inptr^[DCTSIZE*6], quantptr^[DCTSIZE*6]);
z1 := MULTIPLY(z2 + z3, FIX_0_541196100);
tmp2 := z1 + MULTIPLY(z3, - FIX_1_847759065);
tmp3 := z1 + MULTIPLY(z2, FIX_0_765366865);
z2 := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]);
z3 := DEQUANTIZE(inptr^[DCTSIZE*4], quantptr^[DCTSIZE*4]);
tmp0 := (z2 + z3) shl CONST_BITS;
tmp1 := (z2 - z3) shl CONST_BITS;
tmp10 := tmp0 + tmp3;
tmp13 := tmp0 - tmp3;
tmp11 := tmp1 + tmp2;
tmp12 := tmp1 - tmp2;
{ Odd part per figure 8; the matrix is unitary and hence its
transpose is its inverse. i0..i3 are y7,y5,y3,y1 respectively. }
tmp0 := DEQUANTIZE(inptr^[DCTSIZE*7], quantptr^[DCTSIZE*7]);
tmp1 := DEQUANTIZE(inptr^[DCTSIZE*5], quantptr^[DCTSIZE*5]);
tmp2 := DEQUANTIZE(inptr^[DCTSIZE*3], quantptr^[DCTSIZE*3]);
tmp3 := DEQUANTIZE(inptr^[DCTSIZE*1], quantptr^[DCTSIZE*1]);
z1 := tmp0 + tmp3;
z2 := tmp1 + tmp2;
z3 := tmp0 + tmp2;
z4 := tmp1 + tmp3;
z5 := MULTIPLY(z3 + z4, FIX_1_175875602); { sqrt(2) * c3 }
tmp0 := MULTIPLY(tmp0, FIX_0_298631336); { 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) }
tmp3 := MULTIPLY(tmp3, FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) }
z1 := MULTIPLY(z1, - FIX_0_899976223); { sqrt(2) * (c7-c3) }
z2 := MULTIPLY(z2, - FIX_2_562915447); { sqrt(2) * (-c1-c3) }
z3 := MULTIPLY(z3, - FIX_1_961570560); { sqrt(2) * (-c3-c5) }
z4 := MULTIPLY(z4, - FIX_0_390180644); { sqrt(2) * (c5-c3) }
Inc(z3, z5);
Inc(z4, z5);
Inc(tmp0, z1 + z3);
Inc(tmp1, z2 + z4);
Inc(tmp2, z2 + z3);
Inc(tmp3, z1 + z4);
{ Final output stage: inputs are tmp10..tmp13, tmp0..tmp3 }
wsptr^[DCTSIZE*0] := 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*6] := int (DESCALE(tmp11 - tmp2, 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*3] := 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(ISLOW_MULT_TYPE_PTR(quantptr));
Inc(int_ptr(wsptr));
end;
{ 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, }
{ and also undo the PASS1_BITS scaling. }
wsptr := @workspace;
for ctr := 0 to pred(DCTSIZE) do
begin
outptr := output_buf^[ctr];
Inc(JSAMPLE_PTR(outptr), output_col);
{ 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
the simplification applies less often (typically 5% to 10% of the time).
On machines with very fast multiplication, it's possible that the
test takes more time than it's worth. In that case this section
may be commented out. }
{$ifndef NO_ZERO_ROW_TEST}
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
begin
{ AC terms all zero }
JSAMPLE(dcval_) := range_limit^[int(DESCALE(INT32(wsptr^[0]),
PASS1_BITS+3)) and RANGE_MASK];
outptr^[0] := dcval_;
outptr^[1] := dcval_;
outptr^[2] := dcval_;
outptr^[3] := dcval_;
outptr^[4] := dcval_;
outptr^[5] := dcval_;
outptr^[6] := dcval_;
outptr^[7] := dcval_;
Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row }
continue;
end;
{$endif}
{ Even part: reverse the even part of the forward DCT. }
{ The rotator is sqrt(2)*c(-6). }
z2 := INT32 (wsptr^[2]);
z3 := INT32 (wsptr^[6]);
z1 := MULTIPLY(z2 + z3, FIX_0_541196100);
tmp2 := z1 + MULTIPLY(z3, - FIX_1_847759065);
tmp3 := z1 + MULTIPLY(z2, FIX_0_765366865);
tmp0 := (INT32(wsptr^[0]) + INT32(wsptr^[4])) shl CONST_BITS;
tmp1 := (INT32(wsptr^[0]) - INT32(wsptr^[4])) shl CONST_BITS;
tmp10 := tmp0 + tmp3;
tmp13 := tmp0 - tmp3;
tmp11 := tmp1 + tmp2;
tmp12 := tmp1 - tmp2;
{ Odd part per figure 8; the matrix is unitary and hence its
transpose is its inverse. i0..i3 are y7,y5,y3,y1 respectively. }
tmp0 := INT32(wsptr^[7]);
tmp1 := INT32(wsptr^[5]);
tmp2 := INT32(wsptr^[3]);
tmp3 := INT32(wsptr^[1]);
z1 := tmp0 + tmp3;
z2 := tmp1 + tmp2;
z3 := tmp0 + tmp2;
z4 := tmp1 + tmp3;
z5 := MULTIPLY(z3 + z4, FIX_1_175875602); { sqrt(2) * c3 }
tmp0 := MULTIPLY(tmp0, FIX_0_298631336); { 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) }
tmp3 := MULTIPLY(tmp3, FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) }
z1 := MULTIPLY(z1, - FIX_0_899976223); { sqrt(2) * (c7-c3) }
z2 := MULTIPLY(z2, - FIX_2_562915447); { sqrt(2) * (-c1-c3) }
z3 := MULTIPLY(z3, - FIX_1_961570560); { sqrt(2) * (-c3-c5) }
z4 := MULTIPLY(z4, - FIX_0_390180644); { sqrt(2) * (c5-c3) }
Inc(z3, z5);
Inc(z4, z5);
Inc(tmp0, z1 + z3);
Inc(tmp1, z2 + z4);
Inc(tmp2, z2 + z3);
Inc(tmp3, z1 + z4);
{ Final output stage: inputs are tmp10..tmp13, tmp0..tmp3 }
outptr^[0] := range_limit^[ int(DESCALE(tmp10 + tmp3,
CONST_BITS+PASS1_BITS+3))
and RANGE_MASK];
outptr^[7] := range_limit^[ int(DESCALE(tmp10 - tmp3,
CONST_BITS+PASS1_BITS+3))
and RANGE_MASK];
outptr^[1] := range_limit^[ int(DESCALE(tmp11 + tmp2,
CONST_BITS+PASS1_BITS+3))
and RANGE_MASK];
outptr^[6] := range_limit^[ int(DESCALE(tmp11 - tmp2,
CONST_BITS+PASS1_BITS+3))
and RANGE_MASK];
outptr^[2] := range_limit^[ int(DESCALE(tmp12 + tmp1,
CONST_BITS+PASS1_BITS+3))
and RANGE_MASK];
outptr^[5] := range_limit^[ int(DESCALE(tmp12 - tmp1,
CONST_BITS+PASS1_BITS+3))
and RANGE_MASK];
outptr^[3] := range_limit^[ int(DESCALE(tmp13 + tmp0,
CONST_BITS+PASS1_BITS+3))
and RANGE_MASK];
outptr^[4] := range_limit^[ int(DESCALE(tmp13 - tmp0,
CONST_BITS+PASS1_BITS+3))
and RANGE_MASK];
Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row }
end;
end;
end.
unit imjidctint;
{$Q+}
{ This file contains a slow-but-accurate integer implementation of the
inverse DCT (Discrete Cosine Transform). In the IJG code, this routine
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
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
complex and seem not to be any faster when reduced to code.
This implementation is based on an algorithm described in
C. Loeffler, A. Ligtenberg and G. Moschytz, "Practical Fast 1-D DCT
Algorithms with 11 Multiplications", Proc. Int'l. Conf. on Acoustics,
Speech, and Signal Processing 1989 (ICASSP '89), pp. 988-991.
The primary algorithm described there uses 11 multiplies and 29 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
multiplication; this allows a very simple and accurate implementation in
scaled fixed-point arithmetic, with a minimal number of shifts. }
{ Original : jidctint.c ; Copyright (C) 1991-1998, Thomas G. Lane. }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjinclude,
imjpeglib,
imjdct; { Private declarations for DCT subsystem }
{ Perform dequantization and inverse DCT on one block of coefficients. }
{GLOBAL}
procedure jpeg_idct_islow (cinfo : j_decompress_ptr;
compptr : jpeg_component_info_ptr;
coef_block : JCOEFPTR;
output_buf : JSAMPARRAY;
output_col : JDIMENSION);
implementation
{ This module is specialized to the case DCTSIZE = 8. }
{$ifndef DCTSIZE_IS_8}
Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err }
{$endif}
{ The poop on this scaling stuff is as follows:
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
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
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).
We have to do addition and subtraction of the integer inputs, which
is no problem, and multiplication by fractional constants, which is
a problem to do in integer arithmetic. We multiply all the constants
by CONST_SCALE and convert them to integer constants (thus retaining
CONST_BITS bits of precision in the constants). After doing a
multiplication we have to divide the product by CONST_SCALE, with proper
rounding, to produce the correct output. This division can be done
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
full fractional precision.
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
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
intermediate INT32 array would be needed.)
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
shows that the values given below are the most effective. }
{$ifdef BITS_IN_JSAMPLE_IS_8}
const
CONST_BITS = 13;
PASS1_BITS = 2;
{$else}
const
CONST_BITS = 13;
PASS1_BITS = 1; { lose a little precision to avoid overflow }
{$endif}
const
CONST_SCALE = (INT32(1) shl CONST_BITS);
const
FIX_0_298631336 = INT32(Round(CONST_SCALE * 0.298631336)); {2446}
FIX_0_390180644 = INT32(Round(CONST_SCALE * 0.390180644)); {3196}
FIX_0_541196100 = INT32(Round(CONST_SCALE * 0.541196100)); {4433}
FIX_0_765366865 = INT32(Round(CONST_SCALE * 0.765366865)); {6270}
FIX_0_899976223 = INT32(Round(CONST_SCALE * 0.899976223)); {7373}
FIX_1_175875602 = INT32(Round(CONST_SCALE * 1.175875602)); {9633}
FIX_1_501321110 = INT32(Round(CONST_SCALE * 1.501321110)); {12299}
FIX_1_847759065 = INT32(Round(CONST_SCALE * 1.847759065)); {15137}
FIX_1_961570560 = INT32(Round(CONST_SCALE * 1.961570560)); {16069}
FIX_2_053119869 = INT32(Round(CONST_SCALE * 2.053119869)); {16819}
FIX_2_562915447 = INT32(Round(CONST_SCALE * 2.562915447)); {20995}
FIX_3_072711026 = INT32(Round(CONST_SCALE * 3.072711026)); {25172}
{ Multiply an INT32 variable by an INT32 constant to yield an INT32 result.
For 8-bit samples with the recommended scaling, all the variable
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.
For 12-bit samples, a full 32-bit multiplication will be needed. }
{$ifdef BITS_IN_JSAMPLE_IS_8}
{$IFDEF BASM16}
{$IFNDEF WIN32}
{MULTIPLY16C16(var,const)}
function Multiply(X, Y: Integer): integer; assembler;
asm
mov ax, X
imul Y
mov al, ah
mov ah, dl
end;
{$ENDIF}
{$ENDIF}
function Multiply(X, Y: INT32): INT32;
begin
Multiply := INT32(X) * INT32(Y);
end;
{$else}
{#define MULTIPLY(var,const) ((var) * (const))}
function Multiply(X, Y: INT32): INT32;
begin
Multiply := INT32(X) * INT32(Y);
end;
{$endif}
{ Dequantize a coefficient by multiplying it by the multiplier-table
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. }
function DEQUANTIZE(coef,quantval : int) : int;
begin
Dequantize := ( ISLOW_MULT_TYPE(coef) * quantval);
end;
{ Descale and correctly round an INT32 value that's scaled by N bits.
We assume RIGHT_SHIFT rounds towards minus infinity, so adding
the fudge factor is correct for either sign of X. }
function DESCALE(x : INT32; n : int) : INT32;
var
shift_temp : INT32;
begin
{$ifdef RIGHT_SHIFT_IS_UNSIGNED}
shift_temp := x + (INT32(1) shl (n-1));
if shift_temp < 0 then
Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n))
else
Descale := (shift_temp shr n);
{$else}
Descale := (x + (INT32(1) shl (n-1)) shr n;
{$endif}
end;
{ Perform dequantization and inverse DCT on one block of coefficients. }
{GLOBAL}
procedure jpeg_idct_islow (cinfo : j_decompress_ptr;
compptr : jpeg_component_info_ptr;
coef_block : JCOEFPTR;
output_buf : JSAMPARRAY;
output_col : JDIMENSION);
type
PWorkspace = ^TWorkspace;
TWorkspace = coef_bits_field; { buffers data between passes }
var
tmp0, tmp1, tmp2, tmp3 : INT32;
tmp10, tmp11, tmp12, tmp13 : INT32;
z1, z2, z3, z4, z5 : INT32;
inptr : JCOEFPTR;
quantptr : ISLOW_MULT_TYPE_FIELD_PTR;
wsptr : PWorkspace;
outptr : JSAMPROW;
range_limit : JSAMPROW;
ctr : int;
workspace : TWorkspace;
{SHIFT_TEMPS}
var
dcval : int;
var
dcval_ : JSAMPLE;
begin
{ Each IDCT routine is responsible for range-limiting its results and
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
range-limiting step is required. We use a mask-and-table-lookup method
to do the combined operations quickly. See the comments with
prepare_range_limit_table (in jdmaster.c) for more info. }
range_limit := JSAMPROW(@(cinfo^.sample_range_limit^[CENTERJSAMPLE]));
{ Pass 1: process columns from input, store into work array. }
{ Note results are scaled up by sqrt(8) compared to a true IDCT; }
{ furthermore, we scale the results by 2**PASS1_BITS. }
inptr := coef_block;
quantptr := ISLOW_MULT_TYPE_FIELD_PTR (compptr^.dct_table);
wsptr := PWorkspace(@workspace);
for ctr := pred(DCTSIZE) downto 0 do
begin
{ Due to quantization, we will usually find that many of the input
coefficients are zero, especially the AC terms. We can exploit this
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
DC coefficient (with scale factor as needed).
With typical images and quantization tables, half or more of the
column DCT calculations can be simplified this way. }
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*7]=0)) then
begin
{ AC terms all zero }
dcval := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]) shl PASS1_BITS;
wsptr^[DCTSIZE*0] := dcval;
wsptr^[DCTSIZE*1] := dcval;
wsptr^[DCTSIZE*2] := dcval;
wsptr^[DCTSIZE*3] := dcval;
wsptr^[DCTSIZE*4] := dcval;
wsptr^[DCTSIZE*5] := dcval;
wsptr^[DCTSIZE*6] := dcval;
wsptr^[DCTSIZE*7] := dcval;
Inc(JCOEF_PTR(inptr)); { advance pointers to next column }
Inc(ISLOW_MULT_TYPE_PTR(quantptr));
Inc(int_ptr(wsptr));
continue;
end;
{ Even part: reverse the even part of the forward DCT. }
{ The rotator is sqrt(2)*c(-6). }
z2 := DEQUANTIZE(inptr^[DCTSIZE*2], quantptr^[DCTSIZE*2]);
z3 := DEQUANTIZE(inptr^[DCTSIZE*6], quantptr^[DCTSIZE*6]);
z1 := MULTIPLY(z2 + z3, FIX_0_541196100);
tmp2 := z1 + MULTIPLY(z3, - FIX_1_847759065);
tmp3 := z1 + MULTIPLY(z2, FIX_0_765366865);
z2 := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]);
z3 := DEQUANTIZE(inptr^[DCTSIZE*4], quantptr^[DCTSIZE*4]);
tmp0 := (z2 + z3) shl CONST_BITS;
tmp1 := (z2 - z3) shl CONST_BITS;
tmp10 := tmp0 + tmp3;
tmp13 := tmp0 - tmp3;
tmp11 := tmp1 + tmp2;
tmp12 := tmp1 - tmp2;
{ Odd part per figure 8; the matrix is unitary and hence its
transpose is its inverse. i0..i3 are y7,y5,y3,y1 respectively. }
tmp0 := DEQUANTIZE(inptr^[DCTSIZE*7], quantptr^[DCTSIZE*7]);
tmp1 := DEQUANTIZE(inptr^[DCTSIZE*5], quantptr^[DCTSIZE*5]);
tmp2 := DEQUANTIZE(inptr^[DCTSIZE*3], quantptr^[DCTSIZE*3]);
tmp3 := DEQUANTIZE(inptr^[DCTSIZE*1], quantptr^[DCTSIZE*1]);
z1 := tmp0 + tmp3;
z2 := tmp1 + tmp2;
z3 := tmp0 + tmp2;
z4 := tmp1 + tmp3;
z5 := MULTIPLY(z3 + z4, FIX_1_175875602); { sqrt(2) * c3 }
tmp0 := MULTIPLY(tmp0, FIX_0_298631336); { 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) }
tmp3 := MULTIPLY(tmp3, FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) }
z1 := MULTIPLY(z1, - FIX_0_899976223); { sqrt(2) * (c7-c3) }
z2 := MULTIPLY(z2, - FIX_2_562915447); { sqrt(2) * (-c1-c3) }
z3 := MULTIPLY(z3, - FIX_1_961570560); { sqrt(2) * (-c3-c5) }
z4 := MULTIPLY(z4, - FIX_0_390180644); { sqrt(2) * (c5-c3) }
Inc(z3, z5);
Inc(z4, z5);
Inc(tmp0, z1 + z3);
Inc(tmp1, z2 + z4);
Inc(tmp2, z2 + z3);
Inc(tmp3, z1 + z4);
{ Final output stage: inputs are tmp10..tmp13, tmp0..tmp3 }
wsptr^[DCTSIZE*0] := 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*6] := int (DESCALE(tmp11 - tmp2, 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*3] := 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(ISLOW_MULT_TYPE_PTR(quantptr));
Inc(int_ptr(wsptr));
end;
{ 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, }
{ and also undo the PASS1_BITS scaling. }
wsptr := @workspace;
for ctr := 0 to pred(DCTSIZE) do
begin
outptr := output_buf^[ctr];
Inc(JSAMPLE_PTR(outptr), output_col);
{ 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
the simplification applies less often (typically 5% to 10% of the time).
On machines with very fast multiplication, it's possible that the
test takes more time than it's worth. In that case this section
may be commented out. }
{$ifndef NO_ZERO_ROW_TEST}
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
begin
{ AC terms all zero }
JSAMPLE(dcval_) := range_limit^[int(DESCALE(INT32(wsptr^[0]),
PASS1_BITS+3)) and RANGE_MASK];
outptr^[0] := dcval_;
outptr^[1] := dcval_;
outptr^[2] := dcval_;
outptr^[3] := dcval_;
outptr^[4] := dcval_;
outptr^[5] := dcval_;
outptr^[6] := dcval_;
outptr^[7] := dcval_;
Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row }
continue;
end;
{$endif}
{ Even part: reverse the even part of the forward DCT. }
{ The rotator is sqrt(2)*c(-6). }
z2 := INT32 (wsptr^[2]);
z3 := INT32 (wsptr^[6]);
z1 := MULTIPLY(z2 + z3, FIX_0_541196100);
tmp2 := z1 + MULTIPLY(z3, - FIX_1_847759065);
tmp3 := z1 + MULTIPLY(z2, FIX_0_765366865);
tmp0 := (INT32(wsptr^[0]) + INT32(wsptr^[4])) shl CONST_BITS;
tmp1 := (INT32(wsptr^[0]) - INT32(wsptr^[4])) shl CONST_BITS;
tmp10 := tmp0 + tmp3;
tmp13 := tmp0 - tmp3;
tmp11 := tmp1 + tmp2;
tmp12 := tmp1 - tmp2;
{ Odd part per figure 8; the matrix is unitary and hence its
transpose is its inverse. i0..i3 are y7,y5,y3,y1 respectively. }
tmp0 := INT32(wsptr^[7]);
tmp1 := INT32(wsptr^[5]);
tmp2 := INT32(wsptr^[3]);
tmp3 := INT32(wsptr^[1]);
z1 := tmp0 + tmp3;
z2 := tmp1 + tmp2;
z3 := tmp0 + tmp2;
z4 := tmp1 + tmp3;
z5 := MULTIPLY(z3 + z4, FIX_1_175875602); { sqrt(2) * c3 }
tmp0 := MULTIPLY(tmp0, FIX_0_298631336); { 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) }
tmp3 := MULTIPLY(tmp3, FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) }
z1 := MULTIPLY(z1, - FIX_0_899976223); { sqrt(2) * (c7-c3) }
z2 := MULTIPLY(z2, - FIX_2_562915447); { sqrt(2) * (-c1-c3) }
z3 := MULTIPLY(z3, - FIX_1_961570560); { sqrt(2) * (-c3-c5) }
z4 := MULTIPLY(z4, - FIX_0_390180644); { sqrt(2) * (c5-c3) }
Inc(z3, z5);
Inc(z4, z5);
Inc(tmp0, z1 + z3);
Inc(tmp1, z2 + z4);
Inc(tmp2, z2 + z3);
Inc(tmp3, z1 + z4);
{ Final output stage: inputs are tmp10..tmp13, tmp0..tmp3 }
outptr^[0] := range_limit^[ int(DESCALE(tmp10 + tmp3,
CONST_BITS+PASS1_BITS+3))
and RANGE_MASK];
outptr^[7] := range_limit^[ int(DESCALE(tmp10 - tmp3,
CONST_BITS+PASS1_BITS+3))
and RANGE_MASK];
outptr^[1] := range_limit^[ int(DESCALE(tmp11 + tmp2,
CONST_BITS+PASS1_BITS+3))
and RANGE_MASK];
outptr^[6] := range_limit^[ int(DESCALE(tmp11 - tmp2,
CONST_BITS+PASS1_BITS+3))
and RANGE_MASK];
outptr^[2] := range_limit^[ int(DESCALE(tmp12 + tmp1,
CONST_BITS+PASS1_BITS+3))
and RANGE_MASK];
outptr^[5] := range_limit^[ int(DESCALE(tmp12 - tmp1,
CONST_BITS+PASS1_BITS+3))
and RANGE_MASK];
outptr^[3] := range_limit^[ int(DESCALE(tmp13 + tmp0,
CONST_BITS+PASS1_BITS+3))
and RANGE_MASK];
outptr^[4] := range_limit^[ int(DESCALE(tmp13 - tmp0,
CONST_BITS+PASS1_BITS+3))
and RANGE_MASK];
Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row }
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;
{ This file exists to provide a single place to fix any problems with
including the wrong system include files. (Common problems are taken
care of by the standard jconfig symbols, but on really weird systems
you may have to edit this file.)
NOTE: this file is NOT intended to be included by applications using the
JPEG library. Most applications need only include jpeglib.h. }
{ Original: jinclude.h Copyright (C) 1991-1994, Thomas G. Lane. }
interface
{$I imjconfig.inc}
{ Include auto-config file to find out which system include files we need. }
uses
{$ifdef Delphi_Stream}
classes,
{$endif}
imjmorecfg;
{ Nomssi:
To write a dest/source manager that handle streams rather than files,
you can edit the FILEptr definition and the JFREAD() and JFWRITE()
functions in this unit, you don't need to change the default managers
JDATASRC and JDATADST. }
{$ifdef Delphi_Stream}
type
FILEptr = ^TStream;
{$else}
{$ifdef Delphi_Jpeg}
type
FILEptr = TCustomMemoryStream;
{$else}
type
FILEptr = ^File;
{$endif}
{$endif}
{ We need the NULL macro and size_t typedef.
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
pull in <sys/types.h> as well.
Note that the core JPEG library does not require <stdio.h>;
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.
You can remove those references if you want to compile without <stdio.h>.}
{ We need memory copying and zeroing functions, plus strncpy().
ANSI and System V implementations declare these in <string.h>.
BSD doesn't have the mem() functions, but it does have bcopy()/bzero().
Some systems may declare memset and memcpy in <memory.h>.
NOTE: we assume the size parameters to these functions are of type size_t.
Change the casts in these macros if not! }
procedure MEMZERO(target : pointer; size : size_t);
procedure MEMCOPY(dest, src : pointer; size : size_t);
{function SIZEOF(object) : size_t;}
function JFREAD(fp : FILEptr; buf : pointer; sizeofbuf : size_t) : size_t;
function JFWRITE(fp : FILEptr; buf : pointer; sizeofbuf : size_t) : size_t;
implementation
procedure MEMZERO(target : pointer; size : size_t);
begin
FillChar(target^, size, 0);
end;
procedure MEMCOPY(dest, src : pointer; size : size_t);
begin
Move(src^, dest^, size);
end;
{ In ANSI C, and indeed any rational implementation, size_t is also the
type returned by sizeof(). However, it seems there are some irrational
implementations out there, in which sizeof() returns an int even though
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. }
{#define
SIZEOF(object) (size_t(sizeof(object))}
{ The modules that use fread() and fwrite() always invoke them through
these macros. On some systems you may need to twiddle the argument casts.
CAUTION: argument order is different from underlying functions! }
function JFREAD(fp : FILEptr; buf : pointer; sizeofbuf : size_t) : size_t;
var
count : uint;
begin
{$ifdef Delphi_Stream}
count := fp^.Read(buf^, sizeofbuf);
{$else}
blockread(fp^, buf^, sizeofbuf, count);
{$endif}
JFREAD := size_t(count);
end;
function JFWRITE(fp : FILEptr; buf : pointer; sizeofbuf : size_t) : size_t;
var
count : uint;
begin
{$ifdef Delphi_Stream}
count := fp^.Write(buf^, sizeofbuf);
{$else}
blockwrite(fp^, buf^, sizeofbuf, count);
{$endif}
JFWRITE := size_t(count);
end;
end.
unit imjinclude;
{ This file exists to provide a single place to fix any problems with
including the wrong system include files. (Common problems are taken
care of by the standard jconfig symbols, but on really weird systems
you may have to edit this file.)
NOTE: this file is NOT intended to be included by applications using the
JPEG library. Most applications need only include jpeglib.h. }
{ Original: jinclude.h Copyright (C) 1991-1994, Thomas G. Lane. }
interface
{$I imjconfig.inc}
{ Include auto-config file to find out which system include files we need. }
uses
{$ifdef Delphi_Stream}
classes,
{$endif}
imjmorecfg;
{ Nomssi:
To write a dest/source manager that handle streams rather than files,
you can edit the FILEptr definition and the JFREAD() and JFWRITE()
functions in this unit, you don't need to change the default managers
JDATASRC and JDATADST. }
{$ifdef Delphi_Stream}
type
FILEptr = ^TStream;
{$else}
{$ifdef Delphi_Jpeg}
type
FILEptr = TCustomMemoryStream;
{$else}
type
FILEptr = ^File;
{$endif}
{$endif}
{ We need the NULL macro and size_t typedef.
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
pull in <sys/types.h> as well.
Note that the core JPEG library does not require <stdio.h>;
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.
You can remove those references if you want to compile without <stdio.h>.}
{ We need memory copying and zeroing functions, plus strncpy().
ANSI and System V implementations declare these in <string.h>.
BSD doesn't have the mem() functions, but it does have bcopy()/bzero().
Some systems may declare memset and memcpy in <memory.h>.
NOTE: we assume the size parameters to these functions are of type size_t.
Change the casts in these macros if not! }
procedure MEMZERO(target : pointer; size : size_t);
procedure MEMCOPY(dest, src : pointer; size : size_t);
{function SIZEOF(object) : size_t;}
function JFREAD(fp : FILEptr; buf : pointer; sizeofbuf : size_t) : size_t;
function JFWRITE(fp : FILEptr; buf : pointer; sizeofbuf : size_t) : size_t;
implementation
procedure MEMZERO(target : pointer; size : size_t);
begin
FillChar(target^, size, 0);
end;
procedure MEMCOPY(dest, src : pointer; size : size_t);
begin
Move(src^, dest^, size);
end;
{ In ANSI C, and indeed any rational implementation, size_t is also the
type returned by sizeof(). However, it seems there are some irrational
implementations out there, in which sizeof() returns an int even though
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. }
{#define
SIZEOF(object) (size_t(sizeof(object))}
{ The modules that use fread() and fwrite() always invoke them through
these macros. On some systems you may need to twiddle the argument casts.
CAUTION: argument order is different from underlying functions! }
function JFREAD(fp : FILEptr; buf : pointer; sizeofbuf : size_t) : size_t;
var
count : uint;
begin
{$ifdef Delphi_Stream}
count := fp^.Read(buf^, sizeofbuf);
{$else}
blockread(fp^, buf^, sizeofbuf, count);
{$endif}
JFREAD := size_t(count);
end;
function JFWRITE(fp : FILEptr; buf : pointer; sizeofbuf : size_t) : size_t;
var
count : uint;
begin
{$ifdef Delphi_Stream}
count := fp^.Write(buf^, sizeofbuf);
{$else}
blockwrite(fp^, buf^, sizeofbuf, count);
{$endif}
JFWRITE := size_t(count);
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;
{ Delphi3 -- > jmemnobs from jmemwin }
{ This file provides an Win32-compatible implementation of the system-
dependent portion of the JPEG memory manager. }
{ Check jmemnobs.c }
{ Copyright (C) 1996, Jacques Nomssi Nzali }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjdeferr,
imjerror,
imjpeglib;
{ 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
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.
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.
NB: jmemmgr.c expects that MAX_ALLOC_CHUNK will be representable as type
size_t and will be a multiple of sizeof(align_type). }
const
MAX_ALLOC_CHUNK = long(1000000000);
{GLOBAL}
procedure jpeg_open_backing_store (cinfo : j_common_ptr;
info : backing_store_ptr;
total_bytes_needed : long);
{ These routines take care of any system-dependent initialization and
cleanup required. }
{GLOBAL}
function jpeg_mem_init (cinfo : j_common_ptr) : long;
{GLOBAL}
procedure jpeg_mem_term (cinfo : j_common_ptr);
{ These two functions are used to allocate and release small chunks of
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.)
Behavior should be the same as for the standard library functions malloc
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
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. }
{ Near-memory allocation and freeing are controlled by the regular library
routines malloc() and free(). }
{GLOBAL}
function jpeg_get_small (cinfo : j_common_ptr;
sizeofobject : size_t) : pointer;
{GLOBAL}
{object is a reserved word in Borland Pascal }
procedure jpeg_free_small (cinfo : j_common_ptr;
an_object : pointer;
sizeofobject : size_t);
{ These two functions are used to allocate and release large chunks of
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,
far pointers are used. On most other machines these are identical to
the jpeg_get/free_small routines; but we keep them separate anyway,
in case a different allocation strategy is desirable for large chunks. }
{ "Large" objects are allocated in far memory, if possible }
{GLOBAL}
function jpeg_get_large (cinfo : j_common_ptr;
sizeofobject : size_t) : voidp; {far}
{GLOBAL}
procedure jpeg_free_large (cinfo : j_common_ptr;
{var?} an_object : voidp; {FAR}
sizeofobject : size_t);
{ This routine computes the total memory space available for allocation.
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).
If you can actually get the available space, it's a good idea to subtract
a slop factor of 5% or so. }
{GLOBAL}
function jpeg_mem_available (cinfo : j_common_ptr;
min_bytes_needed : long;
max_bytes_needed : long;
already_allocated : long) : long;
implementation
{ This structure holds whatever state is needed to access a single
backing-store object. The read/write/close method pointers are called
by jmemmgr.c to manipulate the backing-store object; all other fields
are private to the system-dependent backing store routines. }
{ These two functions are used to allocate and release small chunks of
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.)
Behavior should be the same as for the standard library functions malloc
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
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. }
{ Near-memory allocation and freeing are controlled by the regular library
routines malloc() and free(). }
{GLOBAL}
function jpeg_get_small (cinfo : j_common_ptr;
sizeofobject : size_t) : pointer;
var
p : pointer;
begin
GetMem(p, sizeofobject);
jpeg_get_small := p;
end;
{GLOBAL}
{object is a reserved word in Object Pascal }
procedure jpeg_free_small (cinfo : j_common_ptr;
an_object : pointer;
sizeofobject : size_t);
begin
FreeMem(an_object, sizeofobject);
end;
{ These two functions are used to allocate and release large chunks of
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,
far pointers are used. On most other machines these are identical to
the jpeg_get/free_small routines; but we keep them separate anyway,
in case a different allocation strategy is desirable for large chunks. }
{GLOBAL}
function jpeg_get_large (cinfo : j_common_ptr;
sizeofobject : size_t) : voidp; {far}
var
p : pointer;
begin
GetMem(p, sizeofobject);
jpeg_get_large := p;
end;
{GLOBAL}
procedure jpeg_free_large (cinfo : j_common_ptr;
{var?} an_object : voidp; {FAR}
sizeofobject : size_t);
begin
Freemem(an_object, sizeofobject);
end;
{ 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
used. NOTE: any memory already allocated must not be counted.
There is a minimum space requirement, corresponding to the minimum
feasible buffer sizes; jmemmgr.c will request that much space even if
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.
Finally, the total space already allocated is passed. If no better
method is available, cinfo^.mem^.max_memory_to_use - already_allocated
is often a suitable calculation.
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).
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.
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.}
{ This routine computes the total memory space available for allocation.
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).
If you can actually get the available space, it's a good idea to subtract
a slop factor of 5% or so. }
const
DEFAULT_MAX_MEM = long(300000); { for total usage about 450K }
{GLOBAL}
function jpeg_mem_available (cinfo : j_common_ptr;
min_bytes_needed : long;
max_bytes_needed : long;
already_allocated : long) : long;
begin
{jpeg_mem_available := cinfo^.mem^.max_memory_to_use - already_allocated;}
jpeg_mem_available := max_bytes_needed;
end;
{ Initial opening of a backing-store object. This must fill in the
read/write/close pointers in the object. The read/write routines
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
just take an error exit.) }
{ Initial opening of a backing-store object. }
{GLOBAL}
procedure jpeg_open_backing_store (cinfo : j_common_ptr;
info : backing_store_ptr;
total_bytes_needed : long);
begin
ERREXIT(cinfo, JERR_NO_BACKING_STORE);
end;
{ These routines take care of any system-dependent initialization and
cleanup required. jpeg_mem_init will be called before anything is
allocated (and, therefore, nothing in cinfo is of use except the error
manager pointer). It should return a suitable default value for
max_memory_to_use; this may subsequently be overridden by the surrounding
application. (Note that max_memory_to_use is only important if
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
all opened backing-store objects have been closed. }
{ These routines take care of any system-dependent initialization and
cleanup required. }
{GLOBAL}
function jpeg_mem_init (cinfo : j_common_ptr) : long;
begin
jpeg_mem_init := DEFAULT_MAX_MEM; { default for max_memory_to_use }
end;
{GLOBAL}
procedure jpeg_mem_term (cinfo : j_common_ptr);
begin
end;
end.
unit imjmemnobs;
{ Delphi3 -- > jmemnobs from jmemwin }
{ This file provides an Win32-compatible implementation of the system-
dependent portion of the JPEG memory manager. }
{ Check jmemnobs.c }
{ Copyright (C) 1996, Jacques Nomssi Nzali }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjdeferr,
imjerror,
imjpeglib;
{ 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
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.
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.
NB: jmemmgr.c expects that MAX_ALLOC_CHUNK will be representable as type
size_t and will be a multiple of sizeof(align_type). }
const
MAX_ALLOC_CHUNK = long(1000000000);
{GLOBAL}
procedure jpeg_open_backing_store (cinfo : j_common_ptr;
info : backing_store_ptr;
total_bytes_needed : long);
{ These routines take care of any system-dependent initialization and
cleanup required. }
{GLOBAL}
function jpeg_mem_init (cinfo : j_common_ptr) : long;
{GLOBAL}
procedure jpeg_mem_term (cinfo : j_common_ptr);
{ These two functions are used to allocate and release small chunks of
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.)
Behavior should be the same as for the standard library functions malloc
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
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. }
{ Near-memory allocation and freeing are controlled by the regular library
routines malloc() and free(). }
{GLOBAL}
function jpeg_get_small (cinfo : j_common_ptr;
sizeofobject : size_t) : pointer;
{GLOBAL}
{object is a reserved word in Borland Pascal }
procedure jpeg_free_small (cinfo : j_common_ptr;
an_object : pointer;
sizeofobject : size_t);
{ These two functions are used to allocate and release large chunks of
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,
far pointers are used. On most other machines these are identical to
the jpeg_get/free_small routines; but we keep them separate anyway,
in case a different allocation strategy is desirable for large chunks. }
{ "Large" objects are allocated in far memory, if possible }
{GLOBAL}
function jpeg_get_large (cinfo : j_common_ptr;
sizeofobject : size_t) : voidp; {far}
{GLOBAL}
procedure jpeg_free_large (cinfo : j_common_ptr;
{var?} an_object : voidp; {FAR}
sizeofobject : size_t);
{ This routine computes the total memory space available for allocation.
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).
If you can actually get the available space, it's a good idea to subtract
a slop factor of 5% or so. }
{GLOBAL}
function jpeg_mem_available (cinfo : j_common_ptr;
min_bytes_needed : long;
max_bytes_needed : long;
already_allocated : long) : long;
implementation
{ This structure holds whatever state is needed to access a single
backing-store object. The read/write/close method pointers are called
by jmemmgr.c to manipulate the backing-store object; all other fields
are private to the system-dependent backing store routines. }
{ These two functions are used to allocate and release small chunks of
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.)
Behavior should be the same as for the standard library functions malloc
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
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. }
{ Near-memory allocation and freeing are controlled by the regular library
routines malloc() and free(). }
{GLOBAL}
function jpeg_get_small (cinfo : j_common_ptr;
sizeofobject : size_t) : pointer;
var
p : pointer;
begin
GetMem(p, sizeofobject);
jpeg_get_small := p;
end;
{GLOBAL}
{object is a reserved word in Object Pascal }
procedure jpeg_free_small (cinfo : j_common_ptr;
an_object : pointer;
sizeofobject : size_t);
begin
FreeMem(an_object, sizeofobject);
end;
{ These two functions are used to allocate and release large chunks of
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,
far pointers are used. On most other machines these are identical to
the jpeg_get/free_small routines; but we keep them separate anyway,
in case a different allocation strategy is desirable for large chunks. }
{GLOBAL}
function jpeg_get_large (cinfo : j_common_ptr;
sizeofobject : size_t) : voidp; {far}
var
p : pointer;
begin
GetMem(p, sizeofobject);
jpeg_get_large := p;
end;
{GLOBAL}
procedure jpeg_free_large (cinfo : j_common_ptr;
{var?} an_object : voidp; {FAR}
sizeofobject : size_t);
begin
Freemem(an_object, sizeofobject);
end;
{ 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
used. NOTE: any memory already allocated must not be counted.
There is a minimum space requirement, corresponding to the minimum
feasible buffer sizes; jmemmgr.c will request that much space even if
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.
Finally, the total space already allocated is passed. If no better
method is available, cinfo^.mem^.max_memory_to_use - already_allocated
is often a suitable calculation.
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).
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.
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.}
{ This routine computes the total memory space available for allocation.
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).
If you can actually get the available space, it's a good idea to subtract
a slop factor of 5% or so. }
const
DEFAULT_MAX_MEM = long(300000); { for total usage about 450K }
{GLOBAL}
function jpeg_mem_available (cinfo : j_common_ptr;
min_bytes_needed : long;
max_bytes_needed : long;
already_allocated : long) : long;
begin
{jpeg_mem_available := cinfo^.mem^.max_memory_to_use - already_allocated;}
jpeg_mem_available := max_bytes_needed;
end;
{ Initial opening of a backing-store object. This must fill in the
read/write/close pointers in the object. The read/write routines
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
just take an error exit.) }
{ Initial opening of a backing-store object. }
{GLOBAL}
procedure jpeg_open_backing_store (cinfo : j_common_ptr;
info : backing_store_ptr;
total_bytes_needed : long);
begin
ERREXIT(cinfo, JERR_NO_BACKING_STORE);
end;
{ These routines take care of any system-dependent initialization and
cleanup required. jpeg_mem_init will be called before anything is
allocated (and, therefore, nothing in cinfo is of use except the error
manager pointer). It should return a suitable default value for
max_memory_to_use; this may subsequently be overridden by the surrounding
application. (Note that max_memory_to_use is only important if
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
all opened backing-store objects have been closed. }
{ These routines take care of any system-dependent initialization and
cleanup required. }
{GLOBAL}
function jpeg_mem_init (cinfo : j_common_ptr) : long;
begin
jpeg_mem_init := DEFAULT_MAX_MEM; { default for max_memory_to_use }
end;
{GLOBAL}
procedure jpeg_mem_term (cinfo : j_common_ptr);
begin
end;
end.

466
Imaging/JpegLib/imjmorecfg.pas
View File

@ -1,247 +1,219 @@
unit imjmorecfg;
{ This file contains additional configuration options that customize the
JPEG software for special applications or support machine-dependent
optimizations. Most users will not need to touch this file. }
{ Source: jmorecfg.h; Copyright (C) 1991-1996, Thomas G. Lane. }
interface
{$I imjconfig.inc}
{$IFDEF FPC} { Free Pascal Compiler }
type
int = longint;
uInt = Cardinal; { unsigned int }
short = Integer;
ushort = Word;
long = longint;
{$ELSE}
{$IFDEF WIN32}
{ Delphi 2.0 }
type
int = Integer;
uInt = Cardinal;
short = SmallInt;
ushort = Word;
long = longint;
{$ELSE}
{$IFDEF VIRTUALPASCAL}
type
int = longint;
uInt = longint; { unsigned int }
short = system.Integer;
ushort = system.Word;
long = longint;
{$ELSE}
type
int = Integer;
uInt = Word; { unsigned int }
short = Integer;
ushort = Word;
long = longint;
{$ENDIF}
{$ENDIF}
{$ENDIF}
type
voidp = pointer;
type
int_ptr = ^int;
size_t = int;
{ Define BITS_IN_JSAMPLE as either
8 for 8-bit sample values (the usual setting)
12 for 12-bit sample values
Only 8 and 12 are legal data precisions for lossy JPEG according to the
JPEG standard, and the IJG code does not support anything else!
We do not support run-time selection of data precision, sorry. }
{$ifdef BITS_IN_JSAMPLE_IS_8} { use 8 or 12 }
const
BITS_IN_JSAMPLE = 8;
{$else}
const
BITS_IN_JSAMPLE = 12;
{$endif}
{ Maximum number of components (color channels) allowed in JPEG image.
To meet the letter of the JPEG spec, set this to 255. However, darn
few applications need more than 4 channels (maybe 5 for CMYK + alpha
mask). We recommend 10 as a reasonable compromise; use 4 if you are
really short on memory. (Each allowed component costs a hundred or so
bytes of storage, whether actually used in an image or not.) }
const
MAX_COMPONENTS = 10; { maximum number of image components }
{ Basic data types.
You may need to change these if you have a machine with unusual data
type sizes; for example, "char" not 8 bits, "short" not 16 bits,
or "long" not 32 bits. We don't care whether "int" is 16 or 32 bits,
but it had better be at least 16. }
{ Representation of a single sample (pixel element value).
We frequently allocate large arrays of these, so it's important to keep
them small. But if you have memory to burn and access to char or short
arrays is very slow on your hardware, you might want to change these. }
{$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. }
{ CHAR_IS_UNSIGNED }
type
JSAMPLE = byte; { Pascal unsigned char }
GETJSAMPLE = int;
const
MAXJSAMPLE = 255;
CENTERJSAMPLE = 128;
{$endif}
{$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
JSAMPLE = short;
GETJSAMPLE = int;
const
MAXJSAMPLE = 4095;
CENTERJSAMPLE = 2048;
{$endif} { BITS_IN_JSAMPLE = 12 }
{ Representation of a DCT frequency coefficient.
This should be a signed value of at least 16 bits; "short" is usually OK.
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
JCOEF = int;
JCOEF_PTR = ^JCOEF;
{ Compressed datastreams are represented as arrays of JOCTET.
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
managers, this is also the data type passed to fread/fwrite. }
type
JOCTET = Byte;
jTOctet = 0..(MaxInt div SizeOf(JOCTET))-1;
JOCTET_FIELD = array[jTOctet] of JOCTET;
JOCTET_FIELD_PTR = ^JOCTET_FIELD;
JOCTETPTR = ^JOCTET;
GETJOCTET = JOCTET; { A work around }
{ 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
extraction code like we did for JSAMPLE. (In other words, these
typedefs live at a different point on the speed/space tradeoff curve.) }
{ UINT8 must hold at least the values 0..255. }
type
UINT8 = byte;
{ UINT16 must hold at least the values 0..65535. }
UINT16 = Word;
{ INT16 must hold at least the values -32768..32767. }
INT16 = int;
{ INT32 must hold at least signed 32-bit values. }
INT32 = longint;
type
INT32PTR = ^INT32;
{ Datatype used for image dimensions. The JPEG standard only supports
images up to 64K*64K due to 16-bit fields in SOF markers. Therefore
"unsigned int" is sufficient on all machines. However, if you need to
handle larger images and you don't mind deviating from the spec, you
can change this datatype. }
type
JDIMENSION = uInt;
const
JPEG_MAX_DIMENSION = 65500; { a tad under 64K to prevent overflows }
{ Ordering of RGB data in scanlines passed to or from the application.
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
(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.
RESTRICTIONS:
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
useful if you are using JPEG color spaces other than YCbCr or grayscale.
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
can't use color quantization if you change that value. }
{$ifdef RGB_RED_IS_0}
const
RGB_RED = 0; { Offset of Red in an RGB scanline element }
RGB_GREEN = 1; { Offset of Green }
RGB_BLUE = 2; { Offset of Blue }
{$else}
const
RGB_RED = 2; { Offset of Red in an RGB scanline element }
RGB_GREEN = 1; { Offset of Green }
RGB_BLUE = 0; { Offset of Blue }
{$endif}
{$ifdef RGB_PIXELSIZE_IS_3}
const
RGB_PIXELSIZE = 3; { JSAMPLEs per RGB scanline element }
{$else}
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.
unit imjmorecfg;
{ This file contains additional configuration options that customize the
JPEG software for special applications or support machine-dependent
optimizations. Most users will not need to touch this file. }
{ Source: jmorecfg.h; Copyright (C) 1991-1996, Thomas G. Lane. }
interface
{$I imjconfig.inc}
type
int = Integer;
uInt = Cardinal;
short = SmallInt;
ushort = Word;
long = LongInt;
type
voidp = pointer;
type
int_ptr = ^int;
size_t = int;
{ Define BITS_IN_JSAMPLE as either
8 for 8-bit sample values (the usual setting)
12 for 12-bit sample values
Only 8 and 12 are legal data precisions for lossy JPEG according to the
JPEG standard, and the IJG code does not support anything else!
We do not support run-time selection of data precision, sorry. }
{$ifdef BITS_IN_JSAMPLE_IS_8} { use 8 or 12 }
const
BITS_IN_JSAMPLE = 8;
{$else}
const
BITS_IN_JSAMPLE = 12;
{$endif}
{ Maximum number of components (color channels) allowed in JPEG image.
To meet the letter of the JPEG spec, set this to 255. However, darn
few applications need more than 4 channels (maybe 5 for CMYK + alpha
mask). We recommend 10 as a reasonable compromise; use 4 if you are
really short on memory. (Each allowed component costs a hundred or so
bytes of storage, whether actually used in an image or not.) }
const
MAX_COMPONENTS = 10; { maximum number of image components }
{ Basic data types.
You may need to change these if you have a machine with unusual data
type sizes; for example, "char" not 8 bits, "short" not 16 bits,
or "long" not 32 bits. We don't care whether "int" is 16 or 32 bits,
but it had better be at least 16. }
{ Representation of a single sample (pixel element value).
We frequently allocate large arrays of these, so it's important to keep
them small. But if you have memory to burn and access to char or short
arrays is very slow on your hardware, you might want to change these. }
{$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. }
{ CHAR_IS_UNSIGNED }
type
JSAMPLE = byte; { Pascal unsigned char }
GETJSAMPLE = int;
const
MAXJSAMPLE = 255;
CENTERJSAMPLE = 128;
{$endif}
{$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
JSAMPLE = short;
GETJSAMPLE = int;
const
MAXJSAMPLE = 4095;
CENTERJSAMPLE = 2048;
{$endif} { BITS_IN_JSAMPLE = 12 }
{ Representation of a DCT frequency coefficient.
This should be a signed value of at least 16 bits; "short" is usually OK.
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
JCOEF = int;
JCOEF_PTR = ^JCOEF;
{ Compressed datastreams are represented as arrays of JOCTET.
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
managers, this is also the data type passed to fread/fwrite. }
type
JOCTET = Byte;
jTOctet = 0..(MaxInt div SizeOf(JOCTET))-1;
JOCTET_FIELD = array[jTOctet] of JOCTET;
JOCTET_FIELD_PTR = ^JOCTET_FIELD;
JOCTETPTR = ^JOCTET;
GETJOCTET = JOCTET; { A work around }
{ 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
extraction code like we did for JSAMPLE. (In other words, these
typedefs live at a different point on the speed/space tradeoff curve.) }
{ UINT8 must hold at least the values 0..255. }
type
UINT8 = Byte;
{ UINT16 must hold at least the values 0..65535. }
UINT16 = Word;
{ INT16 must hold at least the values -32768..32767. }
INT16 = SmallInt;
{ INT32 must hold at least signed 32-bit values. }
INT32 = LongInt;
type
INT32PTR = ^INT32;
{ Datatype used for image dimensions. The JPEG standard only supports
images up to 64K*64K due to 16-bit fields in SOF markers. Therefore
"unsigned int" is sufficient on all machines. However, if you need to
handle larger images and you don't mind deviating from the spec, you
can change this datatype. }
type
JDIMENSION = uInt;
const
JPEG_MAX_DIMENSION = 65500; { a tad under 64K to prevent overflows }
{ Ordering of RGB data in scanlines passed to or from the application.
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
(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.
RESTRICTIONS:
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
useful if you are using JPEG color spaces other than YCbCr or grayscale.
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
can't use color quantization if you change that value. }
{$ifdef RGB_RED_IS_0}
const
RGB_RED = 0; { Offset of Red in an RGB scanline element }
RGB_GREEN = 1; { Offset of Green }
RGB_BLUE = 2; { Offset of Blue }
{$else}
const
RGB_RED = 2; { Offset of Red in an RGB scanline element }
RGB_GREEN = 1; { Offset of Green }
RGB_BLUE = 0; { Offset of Blue }
{$endif}
{$ifdef RGB_PIXELSIZE_IS_3}
const
RGB_PIXELSIZE = 3; { JSAMPLEs per RGB scanline element }
{$else}
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;
{ This file contains tables and miscellaneous utility routines needed
for both compression and decompression.
Note we prefix all global names with "j" to minimize conflicts with
a surrounding application. }
{ Source: jutils.c; Copyright (C) 1991-1996, Thomas G. Lane. }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjinclude,
imjpeglib;
{ 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). }
{$ifdef FALSE} { This table is not actually needed in v6a }
const
jpeg_zigzag_order : array[0..DCTSIZE2] of int =
(0, 1, 5, 6, 14, 15, 27, 28,
2, 4, 7, 13, 16, 26, 29, 42,
3, 8, 12, 17, 25, 30, 41, 43,
9, 11, 18, 24, 31, 40, 44, 53,
10, 19, 23, 32, 39, 45, 52, 54,
20, 22, 33, 38, 46, 51, 55, 60,
21, 34, 37, 47, 50, 56, 59, 61,
35, 36, 48, 49, 57, 58, 62, 63);
{$endif}
{ jpeg_natural_order[i] is the natural-order position of the i'th element
of zigzag order.
When reading corrupted data, the Huffman decoders could attempt
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
wild stores without adding an inner-loop test, we put some extra
"63"s after the real entries. This will cause the extra coefficient
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
fake entries. }
const
jpeg_natural_order : array[0..DCTSIZE2+16-1] of int =
(0, 1, 8, 16, 9, 2, 3, 10,
17, 24, 32, 25, 18, 11, 4, 5,
12, 19, 26, 33, 40, 48, 41, 34,
27, 20, 13, 6, 7, 14, 21, 28,
35, 42, 49, 56, 57, 50, 43, 36,
29, 22, 15, 23, 30, 37, 44, 51,
58, 59, 52, 45, 38, 31, 39, 46,
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);
{ Arithmetic utilities }
{GLOBAL}
function jdiv_round_up (a : long; b : long) : long;
{GLOBAL}
function jround_up (a : long; b : long) : long;
{GLOBAL}
procedure jcopy_sample_rows (input_array : JSAMPARRAY;
source_row : int;
output_array : JSAMPARRAY; dest_row : int;
num_rows : int; num_cols : JDIMENSION);
{GLOBAL}
procedure jcopy_block_row (input_row : JBLOCKROW;
output_row : JBLOCKROW;
num_blocks : JDIMENSION);
{GLOBAL}
procedure jzero_far (target : pointer;{far} bytestozero : size_t);
procedure FMEMZERO(target : pointer; size : size_t);
procedure FMEMCOPY(dest,src : pointer; size : size_t);
implementation
{GLOBAL}
function jdiv_round_up (a : long; b : long) : long;
{ Compute a/b rounded up to next integer, ie, ceil(a/b) }
{ Assumes a >= 0, b > 0 }
begin
jdiv_round_up := (a + b - long(1)) div b;
end;
{GLOBAL}
function jround_up (a : long; b : long) : long;
{ Compute a rounded up to next multiple of b, ie, ceil(a/b)*b }
{ Assumes a >= 0, b > 0 }
begin
Inc(a, b - long(1));
jround_up := a - (a mod b);
end;
{ 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
are FAR and we're assuming a small-pointer memory model. However, some
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.
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.) }
{$ifndef NEED_FAR_POINTERS} { normal case, same as regular macros }
procedure FMEMZERO(target : pointer; size : size_t);
begin
FillChar(target^, size, 0);
end;
procedure FMEMCOPY(dest,src : pointer; size : size_t);
begin
Move(src^, dest^, size);
end;
{$else} { 80x86 case, define if we can }
{$ifdef USE_FMEM}
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))
{$endif}
{$endif}
{GLOBAL}
procedure jcopy_sample_rows (input_array : JSAMPARRAY; source_row : int;
output_array : JSAMPARRAY; dest_row : int;
num_rows : int; num_cols : JDIMENSION);
{ Copy some rows of samples from one place to another.
num_rows rows are copied from input_array[source_row++]
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. }
var
inptr, outptr : JSAMPLE_PTR; {register}
{$ifdef FMEMCOPY}
count : size_t; {register}
{$else}
count : JDIMENSION; {register}
{$endif}
row : int; {register}
begin
{$ifdef FMEMCOPY}
count := size_t(num_cols * SIZEOF(JSAMPLE));
{$endif}
Inc(JSAMPROW_PTR(input_array), source_row);
Inc(JSAMPROW_PTR(output_array), dest_row);
for row := pred(num_rows) downto 0 do
begin
inptr := JSAMPLE_PTR(input_array^[0]);
Inc(JSAMPROW_PTR(input_array));
outptr := JSAMPLE_PTR(output_array^[0]);
Inc(JSAMPROW_PTR(output_array));
{$ifdef FMEMCOPY}
FMEMCOPY(outptr, inptr, count);
{$else}
for count := pred(num_cols) downto 0 do
begin
outptr^ := inptr^; { needn't bother with GETJSAMPLE() here }
Inc(inptr);
Inc(outptr);
end;
{$endif}
end;
end;
{GLOBAL}
procedure jcopy_block_row (input_row : JBLOCKROW;
output_row : JBLOCKROW;
num_blocks : JDIMENSION);
{ Copy a row of coefficient blocks from one place to another. }
{$ifdef FMEMCOPY}
begin
FMEMCOPY(output_row, input_row, num_blocks * (DCTSIZE2 * SIZEOF(JCOEF)));
{$else}
var
inptr, outptr : JCOEFPTR; {register}
count : long; {register}
begin
inptr := JCOEFPTR (input_row);
outptr := JCOEFPTR (output_row);
for count := long(num_blocks) * DCTSIZE2 -1 downto 0 do
begin
outptr^ := inptr^;
Inc(outptr);
Inc(inptr);
end;
{$endif}
end;
{GLOBAL}
procedure jzero_far (target : pointer;{far} bytestozero : size_t);
{ Zero out a chunk of FAR memory. }
{ This might be sample-array data, block-array data, or alloc_large data. }
{$ifdef FMEMZERO}
begin
FMEMZERO(target, bytestozero);
{$else}
var
ptr : byteptr;
count : size_t; {register}
begin
ptr := target;
for count := bytestozero-1 downto 0 do
begin
ptr^ := 0;
Inc(ptr);
end;
{$endif}
end;
end.
unit imjutils;
{ This file contains tables and miscellaneous utility routines needed
for both compression and decompression.
Note we prefix all global names with "j" to minimize conflicts with
a surrounding application. }
{ Source: jutils.c; Copyright (C) 1991-1996, Thomas G. Lane. }
interface
{$I imjconfig.inc}
uses
imjmorecfg,
imjinclude,
imjpeglib;
{ 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). }
{$ifdef FALSE} { This table is not actually needed in v6a }
const
jpeg_zigzag_order : array[0..DCTSIZE2] of int =
(0, 1, 5, 6, 14, 15, 27, 28,
2, 4, 7, 13, 16, 26, 29, 42,
3, 8, 12, 17, 25, 30, 41, 43,
9, 11, 18, 24, 31, 40, 44, 53,
10, 19, 23, 32, 39, 45, 52, 54,
20, 22, 33, 38, 46, 51, 55, 60,
21, 34, 37, 47, 50, 56, 59, 61,
35, 36, 48, 49, 57, 58, 62, 63);
{$endif}
{ jpeg_natural_order[i] is the natural-order position of the i'th element
of zigzag order.
When reading corrupted data, the Huffman decoders could attempt
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
wild stores without adding an inner-loop test, we put some extra
"63"s after the real entries. This will cause the extra coefficient
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
fake entries. }
const
jpeg_natural_order : array[0..DCTSIZE2+16-1] of int =
(0, 1, 8, 16, 9, 2, 3, 10,
17, 24, 32, 25, 18, 11, 4, 5,
12, 19, 26, 33, 40, 48, 41, 34,
27, 20, 13, 6, 7, 14, 21, 28,
35, 42, 49, 56, 57, 50, 43, 36,
29, 22, 15, 23, 30, 37, 44, 51,
58, 59, 52, 45, 38, 31, 39, 46,
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);
{ Arithmetic utilities }
{GLOBAL}
function jdiv_round_up (a : long; b : long) : long;
{GLOBAL}
function jround_up (a : long; b : long) : long;
{GLOBAL}
procedure jcopy_sample_rows (input_array : JSAMPARRAY;
source_row : int;
output_array : JSAMPARRAY; dest_row : int;
num_rows : int; num_cols : JDIMENSION);
{GLOBAL}
procedure jcopy_block_row (input_row : JBLOCKROW;
output_row : JBLOCKROW;
num_blocks : JDIMENSION);
{GLOBAL}
procedure jzero_far (target : pointer;{far} bytestozero : size_t);
procedure FMEMZERO(target : pointer; size : size_t);
procedure FMEMCOPY(dest,src : pointer; size : size_t);
implementation
{GLOBAL}
function jdiv_round_up (a : long; b : long) : long;
{ Compute a/b rounded up to next integer, ie, ceil(a/b) }
{ Assumes a >= 0, b > 0 }
begin
jdiv_round_up := (a + b - long(1)) div b;
end;
{GLOBAL}
function jround_up (a : long; b : long) : long;
{ Compute a rounded up to next multiple of b, ie, ceil(a/b)*b }
{ Assumes a >= 0, b > 0 }
begin
Inc(a, b - long(1));
jround_up := a - (a mod b);
end;
{ 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
are FAR and we're assuming a small-pointer memory model. However, some
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.
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.) }
{$ifndef NEED_FAR_POINTERS} { normal case, same as regular macros }
procedure FMEMZERO(target : pointer; size : size_t);
begin
FillChar(target^, size, 0);
end;
procedure FMEMCOPY(dest,src : pointer; size : size_t);
begin
Move(src^, dest^, size);
end;
{$else} { 80x86 case, define if we can }
{$ifdef USE_FMEM}
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))
{$endif}
{$endif}
{GLOBAL}
procedure jcopy_sample_rows (input_array : JSAMPARRAY; source_row : int;
output_array : JSAMPARRAY; dest_row : int;
num_rows : int; num_cols : JDIMENSION);
{ Copy some rows of samples from one place to another.
num_rows rows are copied from input_array[source_row++]
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. }
var
inptr, outptr : JSAMPLE_PTR; {register}
{$ifdef FMEMCOPY}
count : size_t; {register}
{$else}
count : JDIMENSION; {register}
{$endif}
row : int; {register}
begin
{$ifdef FMEMCOPY}
count := size_t(num_cols * SIZEOF(JSAMPLE));
{$endif}
Inc(JSAMPROW_PTR(input_array), source_row);
Inc(JSAMPROW_PTR(output_array), dest_row);
for row := pred(num_rows) downto 0 do
begin
inptr := JSAMPLE_PTR(input_array^[0]);
Inc(JSAMPROW_PTR(input_array));
outptr := JSAMPLE_PTR(output_array^[0]);
Inc(JSAMPROW_PTR(output_array));
{$ifdef FMEMCOPY}
FMEMCOPY(outptr, inptr, count);
{$else}
for count := pred(num_cols) downto 0 do
begin
outptr^ := inptr^; { needn't bother with GETJSAMPLE() here }
Inc(inptr);
Inc(outptr);
end;
{$endif}
end;
end;
{GLOBAL}
procedure jcopy_block_row (input_row : JBLOCKROW;
output_row : JBLOCKROW;
num_blocks : JDIMENSION);
{ Copy a row of coefficient blocks from one place to another. }
{$ifdef FMEMCOPY}
begin
FMEMCOPY(output_row, input_row, num_blocks * (DCTSIZE2 * SIZEOF(JCOEF)));
{$else}
var
inptr, outptr : JCOEFPTR; {register}
count : long; {register}
begin
inptr := JCOEFPTR (input_row);
outptr := JCOEFPTR (output_row);
for count := long(num_blocks) * DCTSIZE2 -1 downto 0 do
begin
outptr^ := inptr^;
Inc(outptr);
Inc(inptr);
end;
{$endif}
end;
{GLOBAL}
procedure jzero_far (target : pointer;{far} bytestozero : size_t);
{ Zero out a chunk of FAR memory. }
{ This might be sample-array data, block-array data, or alloc_large data. }
{$ifdef FMEMZERO}
begin
FMEMZERO(target, bytestozero);
{$else}
var
ptr : byteptr;
count : size_t; {register}
begin
ptr := target;
for count := bytestozero-1 downto 0 do
begin
ptr^ := 0;
Inc(ptr);
end;
{$endif}
end;
end.

760
Imaging/JpegLib/readme.txt
View File

@ -1,381 +1,381 @@
_____________________________________________________________________________
PASJPEG 1.1 May 29th, 1999
Based on the Independent JPEG Group's JPEG software release 6b
Copyright (C) 1996,1998,1999 by NOMSSI NZALI Jacques H. C.
[kn&n DES] See "Legal issues" for conditions of distribution and use.
_____________________________________________________________________________
Information in this file
========================
o Introduction
o Notes
o File list
o Translation
o Legal issues
o Archive Locations
Introduction
============
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
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
environments, since many compilers try to be compatible to TP.
JPEG (pronounced "jay-peg") is a standardized familly of algorithms for
compression of continous tone still images. Most JPEG processes are lossy,
the output image is not exactly identical to the input image. However, on
typical photographic images, very good compression levels can be obtained
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
(IJG) has created a free, portable C library for JPEG compression and
decompression of JPEG images.
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,
DJPEG.PAS and EXAMPLE.PAS demonstrate the usage of the JPEG decompression
and compression library. The RDJPGCOM application shows how to parse a JFIF
file.
Notes:
======
* Please report any errors/problems you may find in code and in the
documentation (e.g. this README.TXT file).
* The sample applications (CJPEG, DJPEG) doesn't support all the options
of the original C code. WRJPGCOM is not ported.
* Environment variable JPEGMEM syntax changed;
* You can modify the jpeg.pas unit from the Delphi 3 distribution to
use PasJPEG.
Change log
==========
1. bugs fixed:
* in procedure read_gif_map(), unit RDCOLMAP.PAS (used by DJPEG sample
application). Davie Lee Reed <smatters@iquest.net>
* -dct int and -dct fast now bytewise equal to the IJG output.
* -dct float produced large files
2. Support for scripts
3. BASM version of JIDCTINT.PAS for Delphi 2 and 3.
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
it with any software that uses PasJpeg. Thanks to Jannie Gerber for reporting
this with a fix: In JDSAMPLE.PAS, procedure int_upsample(),
for h := pred(h_expand) downto 0 do
begin
outptr^ := invalue;
+=> inc(outptr); { this is the culprit that was left out!!! }
Dec(outcount);
end;
File list
=========
Here is a road map to the files in the PasJPEG distribution. The
distribution includes the JPEG library proper, plus two application
programs ("cjpeg" and "djpeg") which use the library to convert JPEG
files to and from some other popular image formats. A third application
"jpegtran" uses the library to do lossless conversion between different
variants of JPEG. There is also the stand-alone applications "rdjpgcom".
Documentation(see README for a guide to the documentation files):
readme.txt Introduction, Documentation
Additional files
demo.pas Demo program, uses example.pas
example.pas Sample code for calling JPEG library.
test.pas Sample application code for demo.pas
Configuration/installation files and programs (see install.doc for more info):
jconfig.inc Configuration declarations.
*.ijg script files
Pascal source code files:
jinclude.pas Central include file used by all IJG .c files to reference
system include files.
jpeglib.pas JPEG library's internal data structures, exported data
and function declarations.
jmorecfg.pas Additional configuration declarations; need not be changed
for a standard installation.
jdeferr.pas defines the error and message text.
jerror.pas Declares JPEG library's error and trace message codes.
jinclude.pas the place to specify system depedent input/output code.
jdct.pas Private declarations for forward & reverse DCT subsystems.
These files contain most of the functions intended to be called directly by
an application program:
jcapimin.pas Application program interface: core routines for compression.
jcapistd.pas Application program interface: standard compression.
jdapimin.pas Application program interface: core routines for decompression.
jdapistd.pas Application program interface: standard decompression.
jcomapi.pas Application program interface routines common to compression
and decompression.
jcparam.pas Compression parameter setting helper routines.
jctrans.pas API and library routines for transcoding compression.
jdtrans.pas API and library routines for transcoding decompression.
Compression side of the library:
jcinit.pas Initialization: determines which other modules to use.
jcmaster.pas Master control: setup and inter-pass sequencing logic.
jcmainct.pas Main buffer controller (preprocessor => JPEG compressor).
jcprepct.pas Preprocessor buffer controller.
jccoefct.pas Buffer controller for DCT coefficient buffer.
jccolor.pas Color space conversion.
jcsample.pas Downsampling.
jcdctmgr.pas DCT manager (DCT implementation selection & control).
jfdctint.pas Forward DCT using slow-but-accurate integer method.
jfdctfst.pas Forward DCT using faster, less accurate integer method.
jfdctflt.pas Forward DCT using floating-point arithmetic.
jchuff.pas Huffman entropy coding for sequential JPEG.
jcphuff.pas Huffman entropy coding for progressive JPEG.
jcmarker.pas JPEG marker writing.
jdatadst.pas Data destination manager for stdio output.
Decompression side of the library:
jdmaster.pas Master control: determines which other modules to use.
jdinput.pas Input controller: controls input processing modules.
jdmainct.pas Main buffer controller (JPEG decompressor => postprocessor).
jdcoefct.pas Buffer controller for DCT coefficient buffer.
jdpostct.pas Postprocessor buffer controller.
jdmarker.pas JPEG marker reading.
jdhuff.pas Huffman entropy decoding for sequential JPEG.
jdphuff.pas Huffman entropy decoding for progressive JPEG.
jddctmgr.pas IDCT manager (IDCT implementation selection & control).
jidctint.pas Inverse DCT using slow-but-accurate integer method.
jidctasm.pas BASM specific version of jidctint.pas for 32bit Delphi.
jidctfst.pas Inverse DCT using faster, less accurate integer method.
jidctflt.pas Inverse DCT using floating-point arithmetic.
jidctred.pas Inverse DCTs with reduced-size outputs.
jidct2d.pas How to for a direct 2D Inverse DCT - not used
jdsample.pas Upsampling.
jdcolor.pas Color space conversion.
jdmerge.pas Merged upsampling/color conversion (faster, lower quality).
jquant1.pas One-pass color quantization using a fixed-spacing colormap.
jquant2.pas Two-pass color quantization using a custom-generated colormap.
Also handles one-pass quantization to an externally given map.
jdatasrc.pas Data source manager for stdio input.
Support files for both compression and decompression:
jerror.pas Standard error handling routines (application replaceable).
jmemmgr.pas System-independent (more or less) memory management code.
jutils.pas Miscellaneous utility routines.
jmemmgr.pas relies on a system-dependent memory management module. The
PASJPEG distribution includes the following implementations of the system-
dependent module:
jmemnobs.pas "No backing store": assumes adequate virtual memory exists.
jmemdos.pas Custom implementation for MS-DOS (16-bit environment only):
can use extended and expanded memory as well as temporary
files.
jmemsys.pas A skeleton with all the declaration you need to create a
working system-dependent JPEG memory manager on unusual
systems.
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
in MS-DOS-specific configurations of the JPEG library.
Applications using the library should use jmorecfg, jerror, jpeglib, and
include jconfig.inc.
CJPEG/DJPEG/JPEGTRAN
Pascal source code files:
cderror.pas Additional error and trace message codes for cjpeg/djpeg.
Not used, Those errors have been added to jdeferr.
cjpeg.pas Main program for cjpeg.
djpeg.pas Main program for djpeg.
jpegtran.pas Main program for jpegtran.
cdjpeg.pas Utility routines used by all three programs.
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.
Also used by jpegtran.
transupp.pas Support code for jpegtran: lossless image manipulations.
fcache.pas
rdswitch.pas Code to process some of cjpeg's more complex switches.
Also used by jpegtran.
Image file writer modules for djpeg:
wrbmp.pas BMP file output.
wrppm.pas PPM/PGM file output.
wrtarga.pas Targa file output.
Image file reader modules for cjpeg:
rdbmp.pas BMP file input.
rdppm.pas PPM/PGM file input.
rdtarga.pas Targa file input. - NOT READY YET
This program does not depend on the JPEG library
rdjpgcom.pas Stand-alone rdjpgcom application.
Translation
===========
TP is unit-centric, exported type definitions and routines are declared
in the "interface" part of the unit, "make" files are not needed.
Macros are not supported, they were either copied as needed or translated
to Pascal routines (procedure). The procedures will be replaced by code in
later releases.
Conditional defines that indicate whether to include various optional
functions are defined in the file JCONFIG.INC. This file is included first
in all source files.
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
in JDEFERR.PAS. jpegint.h and jpeglib.h were merged into one large unit
JPEGLIB.PAS containing type definitions with global scope.
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,
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
and usage, define labels, group variable definitions, expanding macros, etc).
The IJG source labels routines GLOBAL, METHODDEF and LOCAL. All globals
routines are in the interface section of the units. The "far" directive is
used for methods (METHODDEF).
Some C -> Pascal examples.
* "{" -> "begin" "->" -> "^." " = " -> " := " "<<" -> " shl "
"}" -> "end;" "!=" -> "<>" " == " -> " = " ">>" -> " shr "
"/*" -> "{" routine -> function "0x" -> "$"
"*/" -> "}" (void) procedure "NULL" -> "NIL"
* structs are records, Unions are variable records, pointers are always far,
the operators && and || (and/or) have not the same priority in both
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
one "switch" statement into many case statements.
* 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
a single element. I've used the Inc() statement with type casting to
translate pointer arithmetic most of the time.
C example:
typedef JSAMPLE* JSAMPROW; /* ptr to one image row of pixel samples. */
Pascal
type
JSAMPLE_PTR = ^JSAMPLE; { ptr to a single pixel sample. }
jTSample = 0..(MaxInt div SIZEOF(JSAMPLE))-1;
JSAMPLE_ARRAY = Array[jTSample] of JSAMPLE; {far}
JSAMPROW = ^JSAMPLE_ARRAY; { ptr to one image row of pixel samples. }
The following code
JSAMPROW buffer0, buffer1; /* ptr to a JSAMPLE buffer. */
...
buffer1 = buffer0 + i;
can be translated to
var
buffer0, buffer1 : JSAMPROW;
...
buffer1 := buffer0;
Inc(JSAMPLE_PTR(buffer1), i);
or
buffer1 := JSAMPROW(@ buffer0^[i]);
Declaring the variables as JSAMPLE_PTR may reduce type casting in some
places. I use help pointers to handle negative array offsets.
While translating the type of function parameter from C to Pascal, one can
often use "var", "const", or "array of" parameters instead of pointers.
While translating for(;;)-loops with more than one induction variable to
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.
Legal issues
============
Copyright (C) 1996,1998 by Jacques Nomssi Nzali
This software is provided 'as-is', without any express or implied
warranty. In no event will the author be held liable for any damages
arising from the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
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
in a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
Archive Locations:
==================
[1] Thomas G. Lane, JPEG FAQ
in comp.graphics.misc and related newsgroups
[2] Wallace, Gregory K.: The JPEG Still Picture Compression Standard
ftp.uu.net, graphics/jpeg/wallace.ps.Z
[3] The Independent JPEG Group C library for JPEG encoding and decoding,
rev 6b.
ftp://ftp.uu.net/graphics/jpeg/
or SimTel in msdos/graphics/
[4] JPEG implementation, written by the PVRG group at Stanford,
ftp havefun.stanford.edu:/pub/jpeg/JPEGv1.2.tar.Z.
[5] PASJPEG.ZIP at NView ftp site
ftp://druckfix.physik.tu-chemnitz.de/pub/nv/
http://www.tu-chemnitz.de/~nomssi/pub/pasjpeg.zip
[6] The PasJPEG home page with links
http://www.tu-chemnitz.de/~nomssi/pasjpeg.html
_____________________________________________________________________________
PASJPEG 1.1 May 29th, 1999
Based on the Independent JPEG Group's JPEG software release 6b
Copyright (C) 1996,1998,1999 by NOMSSI NZALI Jacques H. C.
[kn&n DES] See "Legal issues" for conditions of distribution and use.
_____________________________________________________________________________
Information in this file
========================
o Introduction
o Notes
o File list
o Translation
o Legal issues
o Archive Locations
Introduction
============
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
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
environments, since many compilers try to be compatible to TP.
JPEG (pronounced "jay-peg") is a standardized familly of algorithms for
compression of continous tone still images. Most JPEG processes are lossy,
the output image is not exactly identical to the input image. However, on
typical photographic images, very good compression levels can be obtained
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
(IJG) has created a free, portable C library for JPEG compression and
decompression of JPEG images.
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,
DJPEG.PAS and EXAMPLE.PAS demonstrate the usage of the JPEG decompression
and compression library. The RDJPGCOM application shows how to parse a JFIF
file.
Notes:
======
* Please report any errors/problems you may find in code and in the
documentation (e.g. this README.TXT file).
* The sample applications (CJPEG, DJPEG) doesn't support all the options
of the original C code. WRJPGCOM is not ported.
* Environment variable JPEGMEM syntax changed;
* You can modify the jpeg.pas unit from the Delphi 3 distribution to
use PasJPEG.
Change log
==========
1. bugs fixed:
* in procedure read_gif_map(), unit RDCOLMAP.PAS (used by DJPEG sample
application). Davie Lee Reed <smatters@iquest.net>
* -dct int and -dct fast now bytewise equal to the IJG output.
* -dct float produced large files
2. Support for scripts
3. BASM version of JIDCTINT.PAS for Delphi 2 and 3.
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
it with any software that uses PasJpeg. Thanks to Jannie Gerber for reporting
this with a fix: In JDSAMPLE.PAS, procedure int_upsample(),
for h := pred(h_expand) downto 0 do
begin
outptr^ := invalue;
+=> inc(outptr); { this is the culprit that was left out!!! }
Dec(outcount);
end;
File list
=========
Here is a road map to the files in the PasJPEG distribution. The
distribution includes the JPEG library proper, plus two application
programs ("cjpeg" and "djpeg") which use the library to convert JPEG
files to and from some other popular image formats. A third application
"jpegtran" uses the library to do lossless conversion between different
variants of JPEG. There is also the stand-alone applications "rdjpgcom".
Documentation(see README for a guide to the documentation files):
readme.txt Introduction, Documentation
Additional files
demo.pas Demo program, uses example.pas
example.pas Sample code for calling JPEG library.
test.pas Sample application code for demo.pas
Configuration/installation files and programs (see install.doc for more info):
jconfig.inc Configuration declarations.
*.ijg script files
Pascal source code files:
jinclude.pas Central include file used by all IJG .c files to reference
system include files.
jpeglib.pas JPEG library's internal data structures, exported data
and function declarations.
jmorecfg.pas Additional configuration declarations; need not be changed
for a standard installation.
jdeferr.pas defines the error and message text.
jerror.pas Declares JPEG library's error and trace message codes.
jinclude.pas the place to specify system depedent input/output code.
jdct.pas Private declarations for forward & reverse DCT subsystems.
These files contain most of the functions intended to be called directly by
an application program:
jcapimin.pas Application program interface: core routines for compression.
jcapistd.pas Application program interface: standard compression.
jdapimin.pas Application program interface: core routines for decompression.
jdapistd.pas Application program interface: standard decompression.
jcomapi.pas Application program interface routines common to compression
and decompression.
jcparam.pas Compression parameter setting helper routines.
jctrans.pas API and library routines for transcoding compression.
jdtrans.pas API and library routines for transcoding decompression.
Compression side of the library:
jcinit.pas Initialization: determines which other modules to use.
jcmaster.pas Master control: setup and inter-pass sequencing logic.
jcmainct.pas Main buffer controller (preprocessor => JPEG compressor).
jcprepct.pas Preprocessor buffer controller.
jccoefct.pas Buffer controller for DCT coefficient buffer.
jccolor.pas Color space conversion.
jcsample.pas Downsampling.
jcdctmgr.pas DCT manager (DCT implementation selection & control).
jfdctint.pas Forward DCT using slow-but-accurate integer method.
jfdctfst.pas Forward DCT using faster, less accurate integer method.
jfdctflt.pas Forward DCT using floating-point arithmetic.
jchuff.pas Huffman entropy coding for sequential JPEG.
jcphuff.pas Huffman entropy coding for progressive JPEG.
jcmarker.pas JPEG marker writing.
jdatadst.pas Data destination manager for stdio output.
Decompression side of the library:
jdmaster.pas Master control: determines which other modules to use.
jdinput.pas Input controller: controls input processing modules.
jdmainct.pas Main buffer controller (JPEG decompressor => postprocessor).
jdcoefct.pas Buffer controller for DCT coefficient buffer.
jdpostct.pas Postprocessor buffer controller.
jdmarker.pas JPEG marker reading.
jdhuff.pas Huffman entropy decoding for sequential JPEG.
jdphuff.pas Huffman entropy decoding for progressive JPEG.
jddctmgr.pas IDCT manager (IDCT implementation selection & control).
jidctint.pas Inverse DCT using slow-but-accurate integer method.
jidctasm.pas BASM specific version of jidctint.pas for 32bit Delphi.
jidctfst.pas Inverse DCT using faster, less accurate integer method.
jidctflt.pas Inverse DCT using floating-point arithmetic.
jidctred.pas Inverse DCTs with reduced-size outputs.
jidct2d.pas How to for a direct 2D Inverse DCT - not used
jdsample.pas Upsampling.
jdcolor.pas Color space conversion.
jdmerge.pas Merged upsampling/color conversion (faster, lower quality).
jquant1.pas One-pass color quantization using a fixed-spacing colormap.
jquant2.pas Two-pass color quantization using a custom-generated colormap.
Also handles one-pass quantization to an externally given map.
jdatasrc.pas Data source manager for stdio input.
Support files for both compression and decompression:
jerror.pas Standard error handling routines (application replaceable).
jmemmgr.pas System-independent (more or less) memory management code.
jutils.pas Miscellaneous utility routines.
jmemmgr.pas relies on a system-dependent memory management module. The
PASJPEG distribution includes the following implementations of the system-
dependent module:
jmemnobs.pas "No backing store": assumes adequate virtual memory exists.
jmemdos.pas Custom implementation for MS-DOS (16-bit environment only):
can use extended and expanded memory as well as temporary
files.
jmemsys.pas A skeleton with all the declaration you need to create a
working system-dependent JPEG memory manager on unusual
systems.
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
in MS-DOS-specific configurations of the JPEG library.
Applications using the library should use jmorecfg, jerror, jpeglib, and
include jconfig.inc.
CJPEG/DJPEG/JPEGTRAN
Pascal source code files:
cderror.pas Additional error and trace message codes for cjpeg/djpeg.
Not used, Those errors have been added to jdeferr.
cjpeg.pas Main program for cjpeg.
djpeg.pas Main program for djpeg.
jpegtran.pas Main program for jpegtran.
cdjpeg.pas Utility routines used by all three programs.
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.
Also used by jpegtran.
transupp.pas Support code for jpegtran: lossless image manipulations.
fcache.pas
rdswitch.pas Code to process some of cjpeg's more complex switches.
Also used by jpegtran.
Image file writer modules for djpeg:
wrbmp.pas BMP file output.
wrppm.pas PPM/PGM file output.
wrtarga.pas Targa file output.
Image file reader modules for cjpeg:
rdbmp.pas BMP file input.
rdppm.pas PPM/PGM file input.
rdtarga.pas Targa file input. - NOT READY YET
This program does not depend on the JPEG library
rdjpgcom.pas Stand-alone rdjpgcom application.
Translation
===========
TP is unit-centric, exported type definitions and routines are declared
in the "interface" part of the unit, "make" files are not needed.
Macros are not supported, they were either copied as needed or translated
to Pascal routines (procedure). The procedures will be replaced by code in
later releases.
Conditional defines that indicate whether to include various optional
functions are defined in the file JCONFIG.INC. This file is included first
in all source files.
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
in JDEFERR.PAS. jpegint.h and jpeglib.h were merged into one large unit
JPEGLIB.PAS containing type definitions with global scope.
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,
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
and usage, define labels, group variable definitions, expanding macros, etc).
The IJG source labels routines GLOBAL, METHODDEF and LOCAL. All globals
routines are in the interface section of the units. The "far" directive is
used for methods (METHODDEF).
Some C -> Pascal examples.
* "{" -> "begin" "->" -> "^." " = " -> " := " "<<" -> " shl "
"}" -> "end;" "!=" -> "<>" " == " -> " = " ">>" -> " shr "
"/*" -> "{" routine -> function "0x" -> "$"
"*/" -> "}" (void) procedure "NULL" -> "NIL"
* structs are records, Unions are variable records, pointers are always far,
the operators && and || (and/or) have not the same priority in both
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
one "switch" statement into many case statements.
* 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
a single element. I've used the Inc() statement with type casting to
translate pointer arithmetic most of the time.
C example:
typedef JSAMPLE* JSAMPROW; /* ptr to one image row of pixel samples. */
Pascal
type
JSAMPLE_PTR = ^JSAMPLE; { ptr to a single pixel sample. }
jTSample = 0..(MaxInt div SIZEOF(JSAMPLE))-1;
JSAMPLE_ARRAY = Array[jTSample] of JSAMPLE; {far}
JSAMPROW = ^JSAMPLE_ARRAY; { ptr to one image row of pixel samples. }
The following code
JSAMPROW buffer0, buffer1; /* ptr to a JSAMPLE buffer. */
...
buffer1 = buffer0 + i;
can be translated to
var
buffer0, buffer1 : JSAMPROW;
...
buffer1 := buffer0;
Inc(JSAMPLE_PTR(buffer1), i);
or
buffer1 := JSAMPROW(@ buffer0^[i]);
Declaring the variables as JSAMPLE_PTR may reduce type casting in some
places. I use help pointers to handle negative array offsets.
While translating the type of function parameter from C to Pascal, one can
often use "var", "const", or "array of" parameters instead of pointers.
While translating for(;;)-loops with more than one induction variable to
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.
Legal issues
============
Copyright (C) 1996,1998 by Jacques Nomssi Nzali
This software is provided 'as-is', without any express or implied
warranty. In no event will the author be held liable for any damages
arising from the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
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
in a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
Archive Locations:
==================
[1] Thomas G. Lane, JPEG FAQ
in comp.graphics.misc and related newsgroups
[2] Wallace, Gregory K.: The JPEG Still Picture Compression Standard
ftp.uu.net, graphics/jpeg/wallace.ps.Z
[3] The Independent JPEG Group C library for JPEG encoding and decoding,
rev 6b.
ftp://ftp.uu.net/graphics/jpeg/
or SimTel in msdos/graphics/
[4] JPEG implementation, written by the PVRG group at Stanford,
ftp havefun.stanford.edu:/pub/jpeg/JPEGv1.2.tar.Z.
[5] PASJPEG.ZIP at NView ftp site
ftp://druckfix.physik.tu-chemnitz.de/pub/nv/
http://www.tu-chemnitz.de/~nomssi/pub/pasjpeg.zip
[6] The PasJPEG home page with links
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;
{
adler32.c -- compute the Adler-32 checksum of a data stream
Copyright (C) 1995-1998 Mark Adler
Pascal tranlastion
Copyright (C) 1998 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt
}
interface
{$I imzconf.inc}
uses
imzutil;
function adler32(adler : uLong; buf : pBytef; len : uInt) : uLong;
{ 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
the required initial value for the checksum.
An Adler-32 checksum is almost as reliable as a CRC32 but can be computed
much faster. Usage example:
var
adler : uLong;
begin
adler := adler32(0, Z_NULL, 0);
while (read_buffer(buffer, length) <> EOF) do
adler := adler32(adler, buffer, length);
if (adler <> original_adler) then
error();
end;
}
implementation
const
BASE = uLong(65521); { largest prime smaller than 65536 }
{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 = 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 }
{ The penalty is the time loss in the extra MOD-calls. }
{ ========================================================================= }
function adler32(adler : uLong; buf : pBytef; len : uInt) : uLong;
var
s1, s2 : uLong;
k : int;
begin
s1 := adler and $ffff;
s2 := (adler shr 16) and $ffff;
if not Assigned(buf) then
begin
adler32 := uLong(1);
exit;
end;
while (len > 0) do
begin
if len < NMAX then
k := len
else
k := NMAX;
Dec(len, k);
{
while (k >= 16) do
begin
DO16(buf);
Inc(buf, 16);
Dec(k, 16);
end;
if (k <> 0) then
repeat
Inc(s1, buf^);
Inc(puf);
Inc(s2, s1);
Dec(k);
until (k = 0);
}
while (k > 0) do
begin
Inc(s1, buf^);
Inc(s2, s1);
Inc(buf);
Dec(k);
end;
s1 := s1 mod BASE;
s2 := s2 mod BASE;
end;
adler32 := (s2 shl 16) or s1;
end;
{
#define DO1(buf,i)
begin
Inc(s1, buf[i]);
Inc(s2, s1);
end;
#define DO2(buf,i) DO1(buf,i); DO1(buf,i+1);
#define DO4(buf,i) DO2(buf,i); DO2(buf,i+2);
#define DO8(buf,i) DO4(buf,i); DO4(buf,i+4);
#define DO16(buf) DO8(buf,0); DO8(buf,8);
}
end.
Unit imadler;
{
adler32.c -- compute the Adler-32 checksum of a data stream
Copyright (C) 1995-1998 Mark Adler
Pascal tranlastion
Copyright (C) 1998 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt
}
interface
{$I imzconf.inc}
uses
imzutil;
function adler32(adler : uLong; buf : pBytef; len : uInt) : uLong;
{ 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
the required initial value for the checksum.
An Adler-32 checksum is almost as reliable as a CRC32 but can be computed
much faster. Usage example:
var
adler : uLong;
begin
adler := adler32(0, Z_NULL, 0);
while (read_buffer(buffer, length) <> EOF) do
adler := adler32(adler, buffer, length);
if (adler <> original_adler) then
error();
end;
}
implementation
const
BASE = uLong(65521); { largest prime smaller than 65536 }
{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 = 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 }
{ The penalty is the time loss in the extra MOD-calls. }
{ ========================================================================= }
function adler32(adler : uLong; buf : pBytef; len : uInt) : uLong;
var
s1, s2 : uLong;
k : int;
begin
s1 := adler and $ffff;
s2 := (adler shr 16) and $ffff;
if not Assigned(buf) then
begin
adler32 := uLong(1);
exit;
end;
while (len > 0) do
begin
if len < NMAX then
k := len
else
k := NMAX;
Dec(len, k);
{
while (k >= 16) do
begin
DO16(buf);
Inc(buf, 16);
Dec(k, 16);
end;
if (k <> 0) then
repeat
Inc(s1, buf^);
Inc(puf);
Inc(s2, s1);
Dec(k);
until (k = 0);
}
while (k > 0) do
begin
Inc(s1, buf^);
Inc(s2, s1);
Inc(buf);
Dec(k);
end;
s1 := s1 mod BASE;
s2 := s2 mod BASE;
end;
adler32 := (s2 shl 16) or s1;
end;
{
#define DO1(buf,i)
begin
Inc(s1, buf[i]);
Inc(s2, s1);
end;
#define DO2(buf,i) DO1(buf,i); DO1(buf,i+1);
#define DO4(buf,i) DO2(buf,i); DO2(buf,i+2);
#define DO8(buf,i) DO4(buf,i); DO4(buf,i+4);
#define DO16(buf) DO8(buf,0); DO8(buf,8);
}
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;
{
inffast.h and
inffast.c -- process literals and length/distance pairs fast
Copyright (C) 1995-1998 Mark Adler
Pascal tranlastion
Copyright (C) 1998 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt
}
interface
{$I imzconf.inc}
uses
{$ifdef DEBUG}
SysUtils, strutils,
{$ENDIF}
imzutil, impaszlib;
function inflate_fast( bl : uInt;
bd : uInt;
tl : pInflate_huft;
td : pInflate_huft;
var s : inflate_blocks_state;
var z : z_stream) : int;
implementation
uses
iminfutil;
{ Called with number of bytes left to write in window at least 258
(the maximum string length) and number of input bytes available
at least ten. The ten bytes are six bytes for the longest length/
distance pair plus four bytes for overloading the bit buffer. }
function inflate_fast( bl : uInt;
bd : uInt;
tl : pInflate_huft;
td : pInflate_huft;
var s : inflate_blocks_state;
var z : z_stream) : int;
var
t : pInflate_huft; { temporary pointer }
e : uInt; { extra bits or operation }
b : uLong; { bit buffer }
k : uInt; { bits in bit buffer }
p : pBytef; { input data pointer }
n : uInt; { bytes available there }
q : pBytef; { output window write pointer }
m : uInt; { bytes to end of window or read pointer }
ml : uInt; { mask for literal/length tree }
md : uInt; { mask for distance tree }
c : uInt; { bytes to copy }
d : uInt; { distance back to copy from }
r : pBytef; { copy source pointer }
begin
{ load input, output, bit values (macro LOAD) }
p := z.next_in;
n := z.avail_in;
b := s.bitb;
k := s.bitk;
q := s.write;
if ptr2int(q) < ptr2int(s.read) then
m := uInt(ptr2int(s.read)-ptr2int(q)-1)
else
m := uInt(ptr2int(s.zend)-ptr2int(q));
{ initialize masks }
ml := inflate_mask[bl];
md := inflate_mask[bd];
{ do until not enough input or output space for fast loop }
repeat { assume called with (m >= 258) and (n >= 10) }
{ get literal/length code }
{GRABBITS(20);} { max bits for literal/length code }
while (k < 20) do
begin
Dec(n);
b := b or (uLong(p^) shl k);
Inc(p);
Inc(k, 8);
end;
t := @(huft_ptr(tl)^[uInt(b) and ml]);
e := t^.exop;
if (e = 0) then
begin
{DUMPBITS(t^.bits);}
b := b shr t^.bits;
Dec(k, t^.bits);
{$IFDEF DEBUG}
if (t^.base >= $20) and (t^.base < $7f) then
Tracevv('inflate: * literal '+AnsiChar(t^.base))
else
Tracevv('inflate: * literal '+ IntToStr(t^.base));
{$ENDIF}
q^ := Byte(t^.base);
Inc(q);
Dec(m);
continue;
end;
repeat
{DUMPBITS(t^.bits);}
b := b shr t^.bits;
Dec(k, t^.bits);
if (e and 16 <> 0) then
begin
{ get extra bits for length }
e := e and 15;
c := t^.base + (uInt(b) and inflate_mask[e]);
{DUMPBITS(e);}
b := b shr e;
Dec(k, e);
{$IFDEF DEBUG}
Tracevv('inflate: * length ' + IntToStr(c));
{$ENDIF}
{ decode distance base of block to copy }
{GRABBITS(15);} { max bits for distance code }
while (k < 15) do
begin
Dec(n);
b := b or (uLong(p^) shl k);
Inc(p);
Inc(k, 8);
end;
t := @huft_ptr(td)^[uInt(b) and md];
e := t^.exop;
repeat
{DUMPBITS(t^.bits);}
b := b shr t^.bits;
Dec(k, t^.bits);
if (e and 16 <> 0) then
begin
{ get extra bits to add to distance base }
e := e and 15;
{GRABBITS(e);} { get extra bits (up to 13) }
while (k < e) do
begin
Dec(n);
b := b or (uLong(p^) shl k);
Inc(p);
Inc(k, 8);
end;
d := t^.base + (uInt(b) and inflate_mask[e]);
{DUMPBITS(e);}
b := b shr e;
Dec(k, e);
{$IFDEF DEBUG}
Tracevv('inflate: * distance '+IntToStr(d));
{$ENDIF}
{ do the copy }
Dec(m, c);
if (uInt(ptr2int(q) - ptr2int(s.window)) >= d) then { offset before dest }
begin { just copy }
r := q;
Dec(r, d);
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 }
end
else { else offset after destination }
begin
e := d - uInt(ptr2int(q) - ptr2int(s.window)); { bytes from offset to end }
r := s.zend;
Dec(r, e); { pointer to offset }
if (c > e) then { if source crosses, }
begin
Dec(c, e); { copy to end of window }
repeat
q^ := r^;
Inc(q);
Inc(r);
Dec(e);
until (e=0);
r := s.window; { copy rest from start of window }
end;
end;
repeat { copy all or what's left }
q^ := r^;
Inc(q);
Inc(r);
Dec(c);
until (c = 0);
break;
end
else
if (e and 64 = 0) then
begin
Inc(t, t^.base + (uInt(b) and inflate_mask[e]));
e := t^.exop;
end
else
begin
z.msg := 'invalid distance code';
{UNGRAB}
c := z.avail_in-n;
if (k shr 3) < c then
c := k shr 3;
Inc(n, c);
Dec(p, c);
Dec(k, c shl 3);
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_fast := Z_DATA_ERROR;
exit;
end;
until FALSE;
break;
end;
if (e and 64 = 0) then
begin
{t += t->base;
e = (t += ((uInt)b & inflate_mask[e]))->exop;}
Inc(t, t^.base + (uInt(b) and inflate_mask[e]));
e := t^.exop;
if (e = 0) then
begin
{DUMPBITS(t^.bits);}
b := b shr t^.bits;
Dec(k, t^.bits);
{$IFDEF DEBUG}
if (t^.base >= $20) and (t^.base < $7f) then
Tracevv('inflate: * literal '+AnsiChar(t^.base))
else
Tracevv('inflate: * literal '+IntToStr(t^.base));
{$ENDIF}
q^ := Byte(t^.base);
Inc(q);
Dec(m);
break;
end;
end
else
if (e and 32 <> 0) then
begin
{$IFDEF DEBUG}
Tracevv('inflate: * end of block');
{$ENDIF}
{UNGRAB}
c := z.avail_in-n;
if (k shr 3) < c then
c := k shr 3;
Inc(n, c);
Dec(p, c);
Dec(k, c shl 3);
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_fast := Z_STREAM_END;
exit;
end
else
begin
z.msg := 'invalid literal/length code';
{UNGRAB}
c := z.avail_in-n;
if (k shr 3) < c then
c := k shr 3;
Inc(n, c);
Dec(p, c);
Dec(k, c shl 3);
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_fast := Z_DATA_ERROR;
exit;
end;
until FALSE;
until (m < 258) or (n < 10);
{ not enough input or output--restore pointers and return }
{UNGRAB}
c := z.avail_in-n;
if (k shr 3) < c then
c := k shr 3;
Inc(n, c);
Dec(p, c);
Dec(k, c shl 3);
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_fast := Z_OK;
end;
end.
Unit iminffast;
{
inffast.h and
inffast.c -- process literals and length/distance pairs fast
Copyright (C) 1995-1998 Mark Adler
Pascal tranlastion
Copyright (C) 1998 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt
}
interface
{$I imzconf.inc}
uses
{$ifdef DEBUG}
SysUtils, strutils,
{$ENDIF}
imzutil, impaszlib;
function inflate_fast( bl : uInt;
bd : uInt;
tl : pInflate_huft;
td : pInflate_huft;
var s : inflate_blocks_state;
var z : z_stream) : int;
implementation
uses
iminfutil;
{ Called with number of bytes left to write in window at least 258
(the maximum string length) and number of input bytes available
at least ten. The ten bytes are six bytes for the longest length/
distance pair plus four bytes for overloading the bit buffer. }
function inflate_fast( bl : uInt;
bd : uInt;
tl : pInflate_huft;
td : pInflate_huft;
var s : inflate_blocks_state;
var z : z_stream) : int;
var
t : pInflate_huft; { temporary pointer }
e : uInt; { extra bits or operation }
b : uLong; { bit buffer }
k : uInt; { bits in bit buffer }
p : pBytef; { input data pointer }
n : uInt; { bytes available there }
q : pBytef; { output window write pointer }
m : uInt; { bytes to end of window or read pointer }
ml : uInt; { mask for literal/length tree }
md : uInt; { mask for distance tree }
c : uInt; { bytes to copy }
d : uInt; { distance back to copy from }
r : pBytef; { copy source pointer }
begin
{ load input, output, bit values (macro LOAD) }
p := z.next_in;
n := z.avail_in;
b := s.bitb;
k := s.bitk;
q := s.write;
if ptr2int(q) < ptr2int(s.read) then
m := uInt(ptr2int(s.read)-ptr2int(q)-1)
else
m := uInt(ptr2int(s.zend)-ptr2int(q));
{ initialize masks }
ml := inflate_mask[bl];
md := inflate_mask[bd];
{ do until not enough input or output space for fast loop }
repeat { assume called with (m >= 258) and (n >= 10) }
{ get literal/length code }
{GRABBITS(20);} { max bits for literal/length code }
while (k < 20) do
begin
Dec(n);
b := b or (uLong(p^) shl k);
Inc(p);
Inc(k, 8);
end;
t := @(huft_ptr(tl)^[uInt(b) and ml]);
e := t^.exop;
if (e = 0) then
begin
{DUMPBITS(t^.bits);}
b := b shr t^.bits;
Dec(k, t^.bits);
{$IFDEF DEBUG}
if (t^.base >= $20) and (t^.base < $7f) then
Tracevv('inflate: * literal '+AnsiChar(t^.base))
else
Tracevv('inflate: * literal '+ IntToStr(t^.base));
{$ENDIF}
q^ := Byte(t^.base);
Inc(q);
Dec(m);
continue;
end;
repeat
{DUMPBITS(t^.bits);}
b := b shr t^.bits;
Dec(k, t^.bits);
if (e and 16 <> 0) then
begin
{ get extra bits for length }
e := e and 15;
c := t^.base + (uInt(b) and inflate_mask[e]);
{DUMPBITS(e);}
b := b shr e;
Dec(k, e);
{$IFDEF DEBUG}
Tracevv('inflate: * length ' + IntToStr(c));
{$ENDIF}
{ decode distance base of block to copy }
{GRABBITS(15);} { max bits for distance code }
while (k < 15) do
begin
Dec(n);
b := b or (uLong(p^) shl k);
Inc(p);
Inc(k, 8);
end;
t := @huft_ptr(td)^[uInt(b) and md];
e := t^.exop;
repeat
{DUMPBITS(t^.bits);}
b := b shr t^.bits;
Dec(k, t^.bits);
if (e and 16 <> 0) then
begin
{ get extra bits to add to distance base }
e := e and 15;
{GRABBITS(e);} { get extra bits (up to 13) }
while (k < e) do
begin
Dec(n);
b := b or (uLong(p^) shl k);
Inc(p);
Inc(k, 8);
end;
d := t^.base + (uInt(b) and inflate_mask[e]);
{DUMPBITS(e);}
b := b shr e;
Dec(k, e);
{$IFDEF DEBUG}
Tracevv('inflate: * distance '+IntToStr(d));
{$ENDIF}
{ do the copy }
Dec(m, c);
if (uInt(ptr2int(q) - ptr2int(s.window)) >= d) then { offset before dest }
begin { just copy }
r := q;
Dec(r, d);
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 }
end
else { else offset after destination }
begin
e := d - uInt(ptr2int(q) - ptr2int(s.window)); { bytes from offset to end }
r := s.zend;
Dec(r, e); { pointer to offset }
if (c > e) then { if source crosses, }
begin
Dec(c, e); { copy to end of window }
repeat
q^ := r^;
Inc(q);
Inc(r);
Dec(e);
until (e=0);
r := s.window; { copy rest from start of window }
end;
end;
repeat { copy all or what's left }
q^ := r^;
Inc(q);
Inc(r);
Dec(c);
until (c = 0);
break;
end
else
if (e and 64 = 0) then
begin
Inc(t, t^.base + (uInt(b) and inflate_mask[e]));
e := t^.exop;
end
else
begin
z.msg := 'invalid distance code';
{UNGRAB}
c := z.avail_in-n;
if (k shr 3) < c then
c := k shr 3;
Inc(n, c);
Dec(p, c);
Dec(k, c shl 3);
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_fast := Z_DATA_ERROR;
exit;
end;
until FALSE;
break;
end;
if (e and 64 = 0) then
begin
{t += t->base;
e = (t += ((uInt)b & inflate_mask[e]))->exop;}
Inc(t, t^.base + (uInt(b) and inflate_mask[e]));
e := t^.exop;
if (e = 0) then
begin
{DUMPBITS(t^.bits);}
b := b shr t^.bits;
Dec(k, t^.bits);
{$IFDEF DEBUG}
if (t^.base >= $20) and (t^.base < $7f) then
Tracevv('inflate: * literal '+AnsiChar(t^.base))
else
Tracevv('inflate: * literal '+IntToStr(t^.base));
{$ENDIF}
q^ := Byte(t^.base);
Inc(q);
Dec(m);
break;
end;
end
else
if (e and 32 <> 0) then
begin
{$IFDEF DEBUG}
Tracevv('inflate: * end of block');
{$ENDIF}
{UNGRAB}
c := z.avail_in-n;
if (k shr 3) < c then
c := k shr 3;
Inc(n, c);
Dec(p, c);
Dec(k, c shl 3);
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_fast := Z_STREAM_END;
exit;
end
else
begin
z.msg := 'invalid literal/length code';
{UNGRAB}
c := z.avail_in-n;
if (k shr 3) < c then
c := k shr 3;
Inc(n, c);
Dec(p, c);
Dec(k, c shl 3);
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_fast := Z_DATA_ERROR;
exit;
end;
until FALSE;
until (m < 258) or (n < 10);
{ not enough input or output--restore pointers and return }
{UNGRAB}
c := z.avail_in-n;
if (k shr 3) < c then
c := k shr 3;
Inc(n, c);
Dec(p, c);
Dec(k, c shl 3);
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in));
z.next_in := p;
s.write := q;
inflate_fast := Z_OK;
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;
{ types and macros common to blocks and codes
Copyright (C) 1995-1998 Mark Adler
WARNING: this file should *not* be used by applications. It is
part of the implementation of the compression library and is
subject to change.
Pascal tranlastion
Copyright (C) 1998 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt
}
interface
{$I imzconf.inc}
uses
imzutil, impaszlib;
{ copy as much as possible from the sliding window to the output area }
function inflate_flush(var s : inflate_blocks_state;
var z : z_stream;
r : int) : int;
{ And'ing with mask[n] masks the lower n bits }
const
inflate_mask : array[0..17-1] of uInt = (
$0000,
$0001, $0003, $0007, $000f, $001f, $003f, $007f, $00ff,
$01ff, $03ff, $07ff, $0fff, $1fff, $3fff, $7fff, $ffff);
{procedure GRABBITS(j : int);}
{procedure DUMPBITS(j : int);}
{procedure NEEDBITS(j : int);}
implementation
{ macros for bit input with no checking and for returning unused bytes }
procedure GRABBITS(j : int);
begin
{while (k < j) do
begin
Dec(z^.avail_in);
Inc(z^.total_in);
b := b or (uLong(z^.next_in^) shl k);
Inc(z^.next_in);
Inc(k, 8);
end;}
end;
procedure DUMPBITS(j : int);
begin
{b := b shr j;
Dec(k, j);}
end;
procedure NEEDBITS(j : int);
begin
(*
while (k < j) do
begin
{NEEDBYTE;}
if (n <> 0) then
r :=Z_OK
else
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, LongInt(p)-LongInt(z.next_in));
z.next_in := p;
s.write := q;
result := inflate_flush(s,z,r);
exit;
end;
Dec(n);
b := b or (uLong(p^) shl k);
Inc(p);
Inc(k, 8);
end;
*)
end;
procedure NEEDOUT;
begin
(*
if (m = 0) then
begin
{WRAP}
if (q = s.zend) and (s.read <> s.window) then
begin
q := s.window;
if LongInt(q) < LongInt(s.read) then
m := uInt(LongInt(s.read)-LongInt(q)-1)
else
m := uInt(LongInt(s.zend)-LongInt(q));
end;
if (m = 0) then
begin
{FLUSH}
s.write := q;
r := inflate_flush(s,z,r);
q := s.write;
if LongInt(q) < LongInt(s.read) then
m := uInt(LongInt(s.read)-LongInt(q)-1)
else
m := uInt(LongInt(s.zend)-LongInt(q));
{WRAP}
if (q = s.zend) and (s.read <> s.window) then
begin
q := s.window;
if LongInt(q) < LongInt(s.read) then
m := uInt(LongInt(s.read)-LongInt(q)-1)
else
m := uInt(LongInt(s.zend)-LongInt(q));
end;
if (m = 0) then
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, LongInt(p)-LongInt(z.next_in));
z.next_in := p;
s.write := q;
result := inflate_flush(s,z,r);
exit;
end;
end;
end;
r := Z_OK;
*)
end;
{ copy as much as possible from the sliding window to the output area }
function inflate_flush(var s : inflate_blocks_state;
var z : z_stream;
r : int) : int;
var
n : uInt;
p : pBytef;
q : pBytef;
begin
{ local copies of source and destination pointers }
p := z.next_out;
q := s.read;
{ compute number of bytes to copy as far as end of window }
if ptr2int(q) <= ptr2int(s.write) then
n := uInt(ptr2int(s.write) - ptr2int(q))
else
n := uInt(ptr2int(s.zend) - ptr2int(q));
if (n > z.avail_out) then
n := z.avail_out;
if (n <> 0) and (r = Z_BUF_ERROR) then
r := Z_OK;
{ update counters }
Dec(z.avail_out, n);
Inc(z.total_out, n);
{ update check information }
if Assigned(s.checkfn) then
begin
s.check := s.checkfn(s.check, q, n);
z.adler := s.check;
end;
{ copy as far as end of window }
zmemcpy(p, q, n);
Inc(p, n);
Inc(q, n);
{ see if more to copy at beginning of window }
if (q = s.zend) then
begin
{ wrap pointers }
q := s.window;
if (s.write = s.zend) then
s.write := s.window;
{ compute bytes to copy }
n := uInt(ptr2int(s.write) - ptr2int(q));
if (n > z.avail_out) then
n := z.avail_out;
if (n <> 0) and (r = Z_BUF_ERROR) then
r := Z_OK;
{ update counters }
Dec( z.avail_out, n);
Inc( z.total_out, n);
{ update check information }
if Assigned(s.checkfn) then
begin
s.check := s.checkfn(s.check, q, n);
z.adler := s.check;
end;
{ copy }
zmemcpy(p, q, n);
Inc(p, n);
Inc(q, n);
end;
{ update pointers }
z.next_out := p;
s.read := q;
{ done }
inflate_flush := r;
end;
end.
Unit iminfutil;
{ types and macros common to blocks and codes
Copyright (C) 1995-1998 Mark Adler
WARNING: this file should *not* be used by applications. It is
part of the implementation of the compression library and is
subject to change.
Pascal tranlastion
Copyright (C) 1998 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt
}
interface
{$I imzconf.inc}
uses
imzutil, impaszlib;
{ copy as much as possible from the sliding window to the output area }
function inflate_flush(var s : inflate_blocks_state;
var z : z_stream;
r : int) : int;
{ And'ing with mask[n] masks the lower n bits }
const
inflate_mask : array[0..17-1] of uInt = (
$0000,
$0001, $0003, $0007, $000f, $001f, $003f, $007f, $00ff,
$01ff, $03ff, $07ff, $0fff, $1fff, $3fff, $7fff, $ffff);
{procedure GRABBITS(j : int);}
{procedure DUMPBITS(j : int);}
{procedure NEEDBITS(j : int);}
implementation
{ macros for bit input with no checking and for returning unused bytes }
procedure GRABBITS(j : int);
begin
{while (k < j) do
begin
Dec(z^.avail_in);
Inc(z^.total_in);
b := b or (uLong(z^.next_in^) shl k);
Inc(z^.next_in);
Inc(k, 8);
end;}
end;
procedure DUMPBITS(j : int);
begin
{b := b shr j;
Dec(k, j);}
end;
procedure NEEDBITS(j : int);
begin
(*
while (k < j) do
begin
{NEEDBYTE;}
if (n <> 0) then
r :=Z_OK
else
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, LongInt(p)-LongInt(z.next_in));
z.next_in := p;
s.write := q;
result := inflate_flush(s,z,r);
exit;
end;
Dec(n);
b := b or (uLong(p^) shl k);
Inc(p);
Inc(k, 8);
end;
*)
end;
procedure NEEDOUT;
begin
(*
if (m = 0) then
begin
{WRAP}
if (q = s.zend) and (s.read <> s.window) then
begin
q := s.window;
if LongInt(q) < LongInt(s.read) then
m := uInt(LongInt(s.read)-LongInt(q)-1)
else
m := uInt(LongInt(s.zend)-LongInt(q));
end;
if (m = 0) then
begin
{FLUSH}
s.write := q;
r := inflate_flush(s,z,r);
q := s.write;
if LongInt(q) < LongInt(s.read) then
m := uInt(LongInt(s.read)-LongInt(q)-1)
else
m := uInt(LongInt(s.zend)-LongInt(q));
{WRAP}
if (q = s.zend) and (s.read <> s.window) then
begin
q := s.window;
if LongInt(q) < LongInt(s.read) then
m := uInt(LongInt(s.read)-LongInt(q)-1)
else
m := uInt(LongInt(s.zend)-LongInt(q));
end;
if (m = 0) then
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, LongInt(p)-LongInt(z.next_in));
z.next_in := p;
s.write := q;
result := inflate_flush(s,z,r);
exit;
end;
end;
end;
r := Z_OK;
*)
end;
{ copy as much as possible from the sliding window to the output area }
function inflate_flush(var s : inflate_blocks_state;
var z : z_stream;
r : int) : int;
var
n : uInt;
p : pBytef;
q : pBytef;
begin
{ local copies of source and destination pointers }
p := z.next_out;
q := s.read;
{ compute number of bytes to copy as far as end of window }
if ptr2int(q) <= ptr2int(s.write) then
n := uInt(ptr2int(s.write) - ptr2int(q))
else
n := uInt(ptr2int(s.zend) - ptr2int(q));
if (n > z.avail_out) then
n := z.avail_out;
if (n <> 0) and (r = Z_BUF_ERROR) then
r := Z_OK;
{ update counters }
Dec(z.avail_out, n);
Inc(z.total_out, n);
{ update check information }
if Assigned(s.checkfn) then
begin
s.check := s.checkfn(s.check, q, n);
z.adler := s.check;
end;
{ copy as far as end of window }
zmemcpy(p, q, n);
Inc(p, n);
Inc(q, n);
{ see if more to copy at beginning of window }
if (q = s.zend) then
begin
{ wrap pointers }
q := s.window;
if (s.write = s.zend) then
s.write := s.window;
{ compute bytes to copy }
n := uInt(ptr2int(s.write) - ptr2int(q));
if (n > z.avail_out) then
n := z.avail_out;
if (n <> 0) and (r = Z_BUF_ERROR) then
r := Z_OK;
{ update counters }
Dec( z.avail_out, n);
Inc( z.total_out, n);
{ update check information }
if Assigned(s.checkfn) then
begin
s.check := s.checkfn(s.check, q, n);
z.adler := s.check;
end;
{ copy }
zmemcpy(p, q, n);
Inc(p, n);
Inc(q, n);
end;
{ update pointers }
z.next_out := p;
s.read := q;
{ done }
inflate_flush := r;
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}
{ Compile with -DMAXSEG_64K if the alloc function cannot allocate more
than 64k bytes at a time (needed on systems with 16-bit int). }
{$UNDEF MAXSEG_64K}
{$DEFINE UNALIGNED_OK} { requires SizeOf(ush) = 2 ! }
{$UNDEF DYNAMIC_CRC_TABLE}
{$UNDEF FASTEST}
{$DEFINE Use32}
{$DEFINE patch112} { apply patch from the zlib home page }
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
{$UNDEF DEBUG} // for Delphi 2007 in DEBUG mode
{$RANGECHECKS OFF}
{$OVERFLOWCHECKS OFF}
{ -------------------------------------------------------------------- }
{ -------------------------------------------------------------------- }
{$DEFINE MAX_MATCH_IS_258}
{ Compile with -DMAXSEG_64K if the alloc function cannot allocate more
than 64k bytes at a time (needed on systems with 16-bit int). }
{$UNDEF MAXSEG_64K}
{$DEFINE UNALIGNED_OK} { requires SizeOf(ush) = 2 ! }
{$UNDEF DYNAMIC_CRC_TABLE}
{$UNDEF FASTEST}
{$DEFINE Use32}
{$DEFINE patch112} { apply patch from the zlib home page }
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
{$UNDEF DEBUG} // for Delphi 2007 in DEBUG mode
{$RANGECHECKS 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;
{
Copyright (C) 1998 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt
}
interface
{$I imzconf.inc}
{ Type declarations }
type
{Byte = usigned char; 8 bits}
Bytef = byte;
charf = byte;
int = longint;
intf = int;
uInt = cardinal; { 16 bits or more }
uIntf = uInt;
Long = longint;
uLong = Cardinal;
uLongf = uLong;
voidp = pointer;
voidpf = voidp;
pBytef = ^Bytef;
pIntf = ^intf;
puIntf = ^uIntf;
puLong = ^uLongf;
ptr2int = uInt;
{ a pointer to integer casting is used to do pointer arithmetic.
ptr2int must be an integer type and sizeof(ptr2int) must be less
than sizeof(pointer) - Nomssi }
type
zByteArray = array[0..(MaxInt div SizeOf(Bytef))-1] of Bytef;
pzByteArray = ^zByteArray;
type
zIntfArray = array[0..(MaxInt div SizeOf(Intf))-1] of Intf;
pzIntfArray = ^zIntfArray;
type
zuIntArray = array[0..(MaxInt div SizeOf(uInt))-1] of uInt;
PuIntArray = ^zuIntArray;
{ Type declarations - only for deflate }
type
uch = Byte;
uchf = uch; { FAR }
ush = Word;
ushf = ush;
ulg = LongInt;
unsigned = uInt;
pcharf = ^charf;
puchf = ^uchf;
pushf = ^ushf;
type
zuchfArray = zByteArray;
puchfArray = ^zuchfArray;
type
zushfArray = array[0..(MaxInt div SizeOf(ushf))-1] of ushf;
pushfArray = ^zushfArray;
procedure zmemcpy(destp : pBytef; sourcep : pBytef; len : uInt);
function zmemcmp(s1p, s2p : pBytef; len : uInt) : int;
procedure zmemzero(destp : pBytef; len : uInt);
procedure zcfree(opaque : voidpf; ptr : voidpf);
function zcalloc (opaque : voidpf; items : uInt; size : uInt) : voidpf;
implementation
procedure zmemcpy(destp : pBytef; sourcep : pBytef; len : uInt);
begin
Move(sourcep^, destp^, len);
end;
function zmemcmp(s1p, s2p : pBytef; len : uInt) : int;
var
j : uInt;
source,
dest : pBytef;
begin
source := s1p;
dest := s2p;
for j := 0 to pred(len) do
begin
if (source^ <> dest^) then
begin
zmemcmp := 2*Ord(source^ > dest^)-1;
exit;
end;
Inc(source);
Inc(dest);
end;
zmemcmp := 0;
end;
procedure zmemzero(destp : pBytef; len : uInt);
begin
FillChar(destp^, len, 0);
end;
procedure zcfree(opaque : voidpf; ptr : voidpf);
{$ifdef Delphi16}
var
Handle : THandle;
{$endif}
{$IFDEF FPC}
var
memsize : uint;
{$ENDIF}
begin
(*
{$IFDEF DPMI}
{h :=} GlobalFreePtr(ptr);
{$ELSE}
{$IFDEF CALL_DOS}
dosFree(ptr);
{$ELSE}
{$ifdef HugeMem}
FreeMemHuge(ptr);
{$else}
{$ifdef Delphi16}
Handle := GlobalHandle(LH(ptr).H); { HiWord(LongInt(ptr)) }
GlobalUnLock(Handle);
GlobalFree(Handle);
{$else}
{$IFDEF FPC}
Dec(puIntf(ptr));
memsize := puIntf(ptr)^;
FreeMem(ptr, memsize+SizeOf(uInt));
{$ELSE}
FreeMem(ptr); { Delphi 2,3,4 }
{$ENDIF}
{$endif}
{$endif}
{$ENDIF}
{$ENDIF}
*)
FreeMem(ptr);
end;
function zcalloc (opaque : voidpf; items : uInt; size : uInt) : voidpf;
var
p : voidpf;
memsize : uLong;
{$ifdef Delphi16}
handle : THandle;
{$endif}
begin
memsize := uLong(items) * size;
(*
{ $IFDEF DPMI}
p := GlobalAllocPtr(gmem_moveable, memsize);
{ $ELSE}
{ $IFDEF CALLDOS}
p := dosAlloc(memsize);
{ $ELSE}
{$ifdef HugeMem}
GetMemHuge(p, memsize);
{ $else}
{ $ifdef Delphi16}
Handle := GlobalAlloc(HeapAllocFlags, memsize);
p := GlobalLock(Handle);
{ $else}
{ $IFDEF FPC}
GetMem(p, memsize+SizeOf(uInt));
puIntf(p)^:= memsize;
Inc(puIntf(p));
{ $ELSE}
GetMem(p, memsize); { Delphi: p := AllocMem(memsize); }
{ $ENDIF}
{ $endif}
{ $endif}
{ $ENDIF}
{ $ENDIF}
*)
GetMem(p, memsize);
zcalloc := p;
end;
end.
Unit imzutil;
{
Copyright (C) 1998 by Jacques Nomssi Nzali
For conditions of distribution and use, see copyright notice in readme.txt
}
interface
{$I imzconf.inc}
{ Type declarations }
type
{Byte = usigned char; 8 bits}
Bytef = byte;
charf = byte;
int = longint;
intf = int;
uInt = cardinal; { 16 bits or more }
uIntf = uInt;
Long = longint;
uLong = Cardinal;
uLongf = uLong;
voidp = pointer;
voidpf = voidp;
pBytef = ^Bytef;
pIntf = ^intf;
puIntf = ^uIntf;
puLong = ^uLongf;
{$IF Defined(FPC)}
ptr2int = PtrUInt;
{$ELSEIF CompilerVersion >= 20}
ptr2int = NativeUInt;
{$ELSE}
ptr2int = Cardinal;
{$IFEND}
{ a pointer to integer casting is used to do pointer arithmetic. }
type
zByteArray = array[0..(MaxInt div SizeOf(Bytef))-1] of Bytef;
pzByteArray = ^zByteArray;
type
zIntfArray = array[0..(MaxInt div SizeOf(Intf))-1] of Intf;
pzIntfArray = ^zIntfArray;
type
zuIntArray = array[0..(MaxInt div SizeOf(uInt))-1] of uInt;
PuIntArray = ^zuIntArray;
{ Type declarations - only for deflate }
type
uch = Byte;
uchf = uch; { FAR }
ush = Word;
ushf = ush;
ulg = LongInt;
unsigned = uInt;
pcharf = ^charf;
puchf = ^uchf;
pushf = ^ushf;
type
zuchfArray = zByteArray;
puchfArray = ^zuchfArray;
type
zushfArray = array[0..(MaxInt div SizeOf(ushf))-1] of ushf;
pushfArray = ^zushfArray;
procedure zmemcpy(destp : pBytef; sourcep : pBytef; len : uInt);
function zmemcmp(s1p, s2p : pBytef; len : uInt) : int;
procedure zmemzero(destp : pBytef; len : uInt);
procedure zcfree(opaque : voidpf; ptr : voidpf);
function zcalloc (opaque : voidpf; items : uInt; size : uInt) : voidpf;
implementation
procedure zmemcpy(destp : pBytef; sourcep : pBytef; len : uInt);
begin
Move(sourcep^, destp^, len);
end;
function zmemcmp(s1p, s2p : pBytef; len : uInt) : int;
var
j : uInt;
source,
dest : pBytef;
begin
source := s1p;
dest := s2p;
for j := 0 to pred(len) do
begin
if (source^ <> dest^) then
begin
zmemcmp := 2*Ord(source^ > dest^)-1;
exit;
end;
Inc(source);
Inc(dest);
end;
zmemcmp := 0;
end;
procedure zmemzero(destp : pBytef; len : uInt);
begin
FillChar(destp^, len, 0);
end;
procedure zcfree(opaque : voidpf; ptr : voidpf);
{$ifdef Delphi16}
var
Handle : THandle;
{$endif}
{$IFDEF FPC}
var
memsize : uint;
{$ENDIF}
begin
(*
{$IFDEF DPMI}
{h :=} GlobalFreePtr(ptr);
{$ELSE}
{$IFDEF CALL_DOS}
dosFree(ptr);
{$ELSE}
{$ifdef HugeMem}
FreeMemHuge(ptr);
{$else}
{$ifdef Delphi16}
Handle := GlobalHandle(LH(ptr).H); { HiWord(LongInt(ptr)) }
GlobalUnLock(Handle);
GlobalFree(Handle);
{$else}
{$IFDEF FPC}
Dec(puIntf(ptr));
memsize := puIntf(ptr)^;
FreeMem(ptr, memsize+SizeOf(uInt));
{$ELSE}
FreeMem(ptr); { Delphi 2,3,4 }
{$ENDIF}
{$endif}
{$endif}
{$ENDIF}
{$ENDIF}
*)
FreeMem(ptr);
end;
function zcalloc (opaque : voidpf; items : uInt; size : uInt) : voidpf;
var
p : voidpf;
memsize : uLong;
{$ifdef Delphi16}
handle : THandle;
{$endif}
begin
memsize := uLong(items) * size;
(*
{ $IFDEF DPMI}
p := GlobalAllocPtr(gmem_moveable, memsize);
{ $ELSE}
{ $IFDEF CALLDOS}
p := dosAlloc(memsize);
{ $ELSE}
{$ifdef HugeMem}
GetMemHuge(p, memsize);
{ $else}
{ $ifdef Delphi16}
Handle := GlobalAlloc(HeapAllocFlags, memsize);
p := GlobalLock(Handle);
{ $else}
{ $IFDEF FPC}
GetMem(p, memsize+SizeOf(uInt));
puIntf(p)^:= memsize;
Inc(puIntf(p));
{ $ELSE}
GetMem(p, memsize); { Delphi: p := AllocMem(memsize); }
{ $ENDIF}
{ $endif}
{ $endif}
{ $ENDIF}
{ $ENDIF}
*)
GetMem(p, memsize);
zcalloc := p;
end;
end.

256
Imaging/ZLib/readme.txt
View File

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