From 49599fdcf4ca89774f0f5993badd1ed0f86157e7 Mon Sep 17 00:00:00 2001 From: Andreas Schneider Date: Sun, 25 Jul 2010 00:18:54 +0200 Subject: [PATCH] - Added hgeol - Fixed repository side eol to be LF --- .hgeol | 6 + Client/Tools/UfrmConfirmation.lfm | 74 +- Client/Tools/UfrmConfirmation.pas | 114 +- Client/Tools/UfrmDrawSettings.lfm | 246 +-- Client/Tools/UfrmDrawSettings.pas | 258 +-- Client/Tools/UfrmFilter.lfm | 634 +++--- Client/Tools/UfrmLightlevel.lfm | 44 +- Client/Tools/UfrmToolWindow.pas | 208 +- Client/UGameResources.pas | 250 +-- Client/UOverlayUI.pas | 510 ++--- Client/UPacketHandlers.pas | 300 +-- Client/UPackets.pas | 746 +++---- Client/UResourceManager.pas | 210 +- Client/UdmNetwork.pas | 742 +++---- Client/UfrmAccountControl.lfm | 762 +++---- Client/UfrmAccountControl.pas | 822 ++++---- Client/UfrmEditAccount.lfm | 334 +-- Client/UfrmInitialize.lfm | 80 +- Client/UfrmInitialize.pas | 192 +- Client/UfrmLargeScaleCommand.lfm | 3146 ++++++++++++++--------------- Client/UfrmLargeScaleCommand.pas | 1564 +++++++------- Client/UfrmLogin.lfm | 1368 ++++++------- Client/UfrmLogin.pas | 384 ++-- Client/UfrmRegionControl.lfm | 1270 ++++++------ Client/UfrmRegionControl.pas | 1480 +++++++------- Imaging/JpegLib/imjcapimin.pas | 802 ++++---- Imaging/JpegLib/imjcapistd.pas | 444 ++-- Imaging/JpegLib/imjccoefct.pas | 1042 +++++----- Imaging/JpegLib/imjccolor.pas | 1066 +++++----- Imaging/JpegLib/imjcdctmgr.pas | 1028 +++++----- Imaging/JpegLib/imjchuff.pas | 2232 ++++++++++---------- Imaging/JpegLib/imjcinit.pas | 190 +- Imaging/JpegLib/imjcmainct.pas | 686 +++---- Imaging/JpegLib/imjcmarker.pas | 1448 ++++++------- Imaging/JpegLib/imjcmaster.pas | 1402 ++++++------- Imaging/JpegLib/imjcomapi.pas | 260 +-- Imaging/JpegLib/imjconfig.inc | 248 +-- Imaging/JpegLib/imjcparam.pas | 1402 ++++++------- Imaging/JpegLib/imjcphuff.pas | 1924 +++++++++--------- Imaging/JpegLib/imjcprepct.pas | 812 ++++---- Imaging/JpegLib/imjcsample.pas | 1262 ++++++------ Imaging/JpegLib/imjdapimin.pas | 1010 ++++----- Imaging/JpegLib/imjdapistd.pas | 754 +++---- Imaging/JpegLib/imjdcoefct.pas | 1790 ++++++++-------- Imaging/JpegLib/imjdcolor.pas | 1002 ++++----- Imaging/JpegLib/imjdct.pas | 218 +- Imaging/JpegLib/imjddctmgr.pas | 660 +++--- Imaging/JpegLib/imjdeferr.pas | 994 ++++----- Imaging/JpegLib/imjdhuff.pas | 2408 +++++++++++----------- Imaging/JpegLib/imjdinput.pas | 832 ++++---- Imaging/JpegLib/imjdmainct.pas | 1220 +++++------ Imaging/JpegLib/imjdmaster.pas | 1358 ++++++------- Imaging/JpegLib/imjdmerge.pas | 1028 +++++----- Imaging/JpegLib/imjdphuff.pas | 2122 +++++++++---------- Imaging/JpegLib/imjdpostct.pas | 682 +++---- Imaging/JpegLib/imjdsample.pas | 1184 +++++------ Imaging/JpegLib/imjerror.pas | 924 ++++----- Imaging/JpegLib/imjfdctflt.pas | 352 ++-- Imaging/JpegLib/imjfdctfst.pas | 474 ++--- Imaging/JpegLib/imjfdctint.pas | 594 +++--- Imaging/JpegLib/imjidctasm.pas | 1586 +++++++-------- Imaging/JpegLib/imjidctflt.pas | 572 +++--- Imaging/JpegLib/imjidctfst.pas | 820 ++++---- Imaging/JpegLib/imjidctint.pas | 880 ++++---- Imaging/JpegLib/imjidctred.pas | 1050 +++++----- Imaging/JpegLib/imjinclude.pas | 252 +-- Imaging/JpegLib/imjmorecfg.pas | 494 ++--- Imaging/JpegLib/imjpeglib.pas | 2600 ++++++++++++------------ Imaging/JpegLib/imjquant1.pas | 2018 +++++++++--------- Imaging/JpegLib/imjquant2.pas | 3102 ++++++++++++++-------------- Imaging/JpegLib/imjutils.pas | 464 ++--- Imaging/JpegLib/readme.txt | 760 +++---- Imaging/ZLib/imadler.pas | 228 +-- Imaging/ZLib/iminfblock.pas | 1902 ++++++++--------- Imaging/ZLib/iminftrees.pas | 1560 +++++++------- Imaging/ZLib/iminfutil.pas | 444 ++-- Imaging/ZLib/imzconf.inc | 50 +- Imaging/ZLib/imzutil.pas | 382 ++-- Imaging/ZLib/readme.txt | 256 +-- Logging.pas | 78 +- MulProvider/UAnimDataProvider.pas | 266 +-- MulProvider/UArtProvider.pas | 202 +- MulProvider/UGumpProvider.pas | 126 +- MulProvider/UHueProvider.pas | 306 +-- MulProvider/ULightProvider.pas | 124 +- MulProvider/UMulManager.pas | 258 +-- MulProvider/UMulProvider.pas | 782 +++---- MulProvider/URadarProvider.pas | 212 +- MulProvider/UTileDataProvider.pas | 342 ++-- ResourceBuilder.pas | 138 +- Server/UNetState.pas | 178 +- Server/UPacketHandlers.pas | 436 ++-- Server/UPackets.pas | 452 ++--- UBufferedStreams.pas | 288 +-- UEnhancedMemoryStream.pas | 508 ++--- ULinkedList.pas | 334 +-- UOLib/UArt.pas | 650 +++--- UOLib/UGenericIndex.pas | 166 +- UOLib/UGraphicHelper.pas | 170 +- UOLib/UGump.pas | 466 ++--- UOLib/UHue.pas | 438 ++-- UOLib/ULight.pas | 242 +-- UOLib/ULocalization.pas | 184 +- UOLib/UMulBlock.pas | 342 ++-- UOLib/UMultiMap.pas | 314 +-- UOLib/UTexture.pas | 272 +-- UOLib/UTiledata.pas | 752 +++---- UOLib/UVerdata.pas | 184 +- UPacket.pas | 156 +- bin/nodraw.txt | 26 +- 110 files changed, 40208 insertions(+), 40202 deletions(-) create mode 100644 .hgeol diff --git a/.hgeol b/.hgeol new file mode 100644 index 0000000..46a0dbe --- /dev/null +++ b/.hgeol @@ -0,0 +1,6 @@ +[patterns] +**.* = native +bin/nodraw.txt = CRLF + +[repository] +native = LF \ No newline at end of file diff --git a/Client/Tools/UfrmConfirmation.lfm b/Client/Tools/UfrmConfirmation.lfm index 88288b0..ab5dab7 100644 --- a/Client/Tools/UfrmConfirmation.lfm +++ b/Client/Tools/UfrmConfirmation.lfm @@ -1,37 +1,37 @@ -object frmConfirmation: TfrmConfirmation - Left = 290 - Height = 43 - Top = 171 - Width = 108 - BorderIcons = [] - BorderStyle = bsToolWindow - Caption = 'Apply?' - ClientHeight = 43 - ClientWidth = 108 - Font.Height = -11 - LCLVersion = '0.9.25' - object btnYes: TButton - Left = 8 - Height = 25 - Top = 8 - Width = 40 - BorderSpacing.InnerBorder = 4 - Caption = 'Yes' - Default = True - ModalResult = 6 - ParentFont = True - TabOrder = 0 - end - object btnNo: TButton - Left = 56 - Height = 25 - Top = 8 - Width = 40 - BorderSpacing.InnerBorder = 4 - Cancel = True - Caption = 'No' - ModalResult = 7 - ParentFont = True - TabOrder = 1 - end -end +object frmConfirmation: TfrmConfirmation + Left = 290 + Height = 43 + Top = 171 + Width = 108 + BorderIcons = [] + BorderStyle = bsToolWindow + Caption = 'Apply?' + ClientHeight = 43 + ClientWidth = 108 + Font.Height = -11 + LCLVersion = '0.9.25' + object btnYes: TButton + Left = 8 + Height = 25 + Top = 8 + Width = 40 + BorderSpacing.InnerBorder = 4 + Caption = 'Yes' + Default = True + ModalResult = 6 + ParentFont = True + TabOrder = 0 + end + object btnNo: TButton + Left = 56 + Height = 25 + Top = 8 + Width = 40 + BorderSpacing.InnerBorder = 4 + Cancel = True + Caption = 'No' + ModalResult = 7 + ParentFont = True + TabOrder = 1 + end +end diff --git a/Client/Tools/UfrmConfirmation.pas b/Client/Tools/UfrmConfirmation.pas index 1aca43e..abd00cd 100644 --- a/Client/Tools/UfrmConfirmation.pas +++ b/Client/Tools/UfrmConfirmation.pas @@ -1,57 +1,57 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2007 Andreas Schneider - *) -unit UfrmConfirmation; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls; - -type - - { TfrmConfirmation } - - TfrmConfirmation = class(TForm) - btnYes: TButton; - btnNo: TButton; - private - { private declarations } - public - { public declarations } - end; - -var - frmConfirmation: TfrmConfirmation; - -implementation - -initialization - {$I UfrmConfirmation.lrs} - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2007 Andreas Schneider + *) +unit UfrmConfirmation; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls; + +type + + { TfrmConfirmation } + + TfrmConfirmation = class(TForm) + btnYes: TButton; + btnNo: TButton; + private + { private declarations } + public + { public declarations } + end; + +var + frmConfirmation: TfrmConfirmation; + +implementation + +initialization + {$I UfrmConfirmation.lrs} + +end. + diff --git a/Client/Tools/UfrmDrawSettings.lfm b/Client/Tools/UfrmDrawSettings.lfm index fe3840a..591409a 100644 --- a/Client/Tools/UfrmDrawSettings.lfm +++ b/Client/Tools/UfrmDrawSettings.lfm @@ -1,123 +1,123 @@ -inherited frmDrawSettings: TfrmDrawSettings - Left = 268 - Height = 180 - Top = 165 - Width = 242 - ActiveControl = rbTileList - Caption = 'Draw settings' - ClientHeight = 180 - ClientWidth = 242 - OnCreate = FormCreate - object rbTileList: TRadioButton[0] - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = Owner - Left = 8 - Height = 22 - Top = 8 - Width = 146 - BorderSpacing.Left = 8 - BorderSpacing.Top = 8 - BorderSpacing.Bottom = 4 - Caption = 'Use tile from the list' - Checked = True - State = cbChecked - TabOrder = 0 - end - object rbRandom: TRadioButton[1] - AnchorSideLeft.Control = rbTileList - AnchorSideTop.Control = rbTileList - AnchorSideTop.Side = asrBottom - Left = 8 - Height = 22 - Top = 34 - Width = 213 - BorderSpacing.Top = 4 - Caption = 'Use tiles from the random pool' - TabOrder = 1 - TabStop = False - end - object gbHue: TGroupBox[2] - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = seRandomHeight - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = Owner - AnchorSideRight.Side = asrBottom - Left = 8 - Height = 49 - Top = 132 - Width = 226 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Around = 8 - Caption = 'Hue (Statics only)' - ClientHeight = 45 - ClientWidth = 222 - TabOrder = 2 - object pbHue: TPaintBox - Cursor = crHandPoint - Left = 4 - Height = 41 - Top = 0 - Width = 214 - Align = alClient - BorderSpacing.Left = 4 - BorderSpacing.Right = 4 - BorderSpacing.Bottom = 4 - OnClick = pbHueClick - OnPaint = pbHuePaint - end - end - object cbRandomHeight: TCheckBox[3] - AnchorSideLeft.Control = cbForceAltitude - AnchorSideTop.Control = cbForceAltitude - AnchorSideTop.Side = asrBottom - Left = 8 - Height = 22 - Top = 102 - Width = 149 - BorderSpacing.Top = 12 - Caption = 'Add Random Altitude' - TabOrder = 3 - end - object seRandomHeight: TSpinEdit[4] - AnchorSideTop.Control = cbRandomHeight - AnchorSideTop.Side = asrCenter - AnchorSideRight.Control = Owner - AnchorSideRight.Side = asrBottom - Left = 184 - Height = 21 - Top = 103 - Width = 50 - Anchors = [akTop, akRight] - BorderSpacing.Right = 8 - TabOrder = 4 - end - object cbForceAltitude: TCheckBox[5] - AnchorSideLeft.Control = rbRandom - AnchorSideTop.Control = rbRandom - AnchorSideTop.Side = asrBottom - Left = 8 - Height = 22 - Top = 68 - Width = 111 - BorderSpacing.Top = 12 - Caption = 'Force altitude:' - TabOrder = 5 - end - object seForceAltitude: TSpinEdit[6] - AnchorSideTop.Control = cbForceAltitude - AnchorSideTop.Side = asrCenter - AnchorSideRight.Control = Owner - AnchorSideRight.Side = asrBottom - Left = 184 - Height = 21 - Top = 69 - Width = 50 - Anchors = [akTop, akRight] - BorderSpacing.Right = 8 - MaxValue = 127 - MinValue = -128 - TabOrder = 6 - end - inherited tmClose: TTimer[7] - end -end +inherited frmDrawSettings: TfrmDrawSettings + Left = 268 + Height = 180 + Top = 165 + Width = 242 + ActiveControl = rbTileList + Caption = 'Draw settings' + ClientHeight = 180 + ClientWidth = 242 + OnCreate = FormCreate + object rbTileList: TRadioButton[0] + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 22 + Top = 8 + Width = 146 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 4 + Caption = 'Use tile from the list' + Checked = True + State = cbChecked + TabOrder = 0 + end + object rbRandom: TRadioButton[1] + AnchorSideLeft.Control = rbTileList + AnchorSideTop.Control = rbTileList + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 22 + Top = 34 + Width = 213 + BorderSpacing.Top = 4 + Caption = 'Use tiles from the random pool' + TabOrder = 1 + TabStop = False + end + object gbHue: TGroupBox[2] + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = seRandomHeight + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 49 + Top = 132 + Width = 226 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Around = 8 + Caption = 'Hue (Statics only)' + ClientHeight = 45 + ClientWidth = 222 + TabOrder = 2 + object pbHue: TPaintBox + Cursor = crHandPoint + Left = 4 + Height = 41 + Top = 0 + Width = 214 + Align = alClient + BorderSpacing.Left = 4 + BorderSpacing.Right = 4 + BorderSpacing.Bottom = 4 + OnClick = pbHueClick + OnPaint = pbHuePaint + end + end + object cbRandomHeight: TCheckBox[3] + AnchorSideLeft.Control = cbForceAltitude + AnchorSideTop.Control = cbForceAltitude + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 22 + Top = 102 + Width = 149 + BorderSpacing.Top = 12 + Caption = 'Add Random Altitude' + TabOrder = 3 + end + object seRandomHeight: TSpinEdit[4] + AnchorSideTop.Control = cbRandomHeight + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 184 + Height = 21 + Top = 103 + Width = 50 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + TabOrder = 4 + end + object cbForceAltitude: TCheckBox[5] + AnchorSideLeft.Control = rbRandom + AnchorSideTop.Control = rbRandom + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 22 + Top = 68 + Width = 111 + BorderSpacing.Top = 12 + Caption = 'Force altitude:' + TabOrder = 5 + end + object seForceAltitude: TSpinEdit[6] + AnchorSideTop.Control = cbForceAltitude + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 184 + Height = 21 + Top = 69 + Width = 50 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + MaxValue = 127 + MinValue = -128 + TabOrder = 6 + end + inherited tmClose: TTimer[7] + end +end diff --git a/Client/Tools/UfrmDrawSettings.pas b/Client/Tools/UfrmDrawSettings.pas index 96d32ae..05183ac 100644 --- a/Client/Tools/UfrmDrawSettings.pas +++ b/Client/Tools/UfrmDrawSettings.pas @@ -1,129 +1,129 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2009 Andreas Schneider - *) -unit UfrmDrawSettings; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, - Spin, ExtCtrls, LMessages, UfrmToolWindow; - -type - - { TfrmDrawSettings } - - TfrmDrawSettings = class(TfrmToolWindow) - cbForceAltitude: TCheckBox; - cbRandomHeight: TCheckBox; - gbHue: TGroupBox; - pbHue: TPaintBox; - rbRandom: TRadioButton; - rbTileList: TRadioButton; - seForceAltitude: TSpinEdit; - seRandomHeight: TSpinEdit; - procedure FormCreate(Sender: TObject); - procedure pbHueClick(Sender: TObject); - procedure pbHuePaint(Sender: TObject); - procedure seForceAltitudeChange(Sender: TObject); - procedure seRandomHeightChange(Sender: TObject); - private - FCanClose: Boolean; - function CanClose: Boolean; override; - procedure OnHueClose(Sender: TObject; var ACloseAction: TCloseAction); - end; - -var - frmDrawSettings: TfrmDrawSettings; - -implementation - -uses - UGameResources, UHue, UfrmHueSettings; - -{ TfrmDrawSettings } - -procedure TfrmDrawSettings.pbHueClick(Sender: TObject); -begin - frmHueSettings.Left := Mouse.CursorPos.x - 8; - frmHueSettings.Top := Mouse.CursorPos.y - 8; - frmHueSettings.OnClose := @OnHueClose; - frmHueSettings.Show; - FCanClose := False; -end; - -procedure TfrmDrawSettings.FormCreate(Sender: TObject); -begin - FCanClose := True; -end; - -procedure TfrmDrawSettings.pbHuePaint(Sender: TObject); -var - hue: THue; -begin - if frmHueSettings <> nil then - begin - if frmHueSettings.lbHue.ItemIndex > 0 then - hue := ResMan.Hue.Hues[frmHueSettings.lbHue.ItemIndex - 1] - else - hue := nil; - TfrmHueSettings.DrawHue(hue, pbHue.Canvas, pbHue.Canvas.ClipRect, - frmHueSettings.lbHue.Items.Strings[frmHueSettings.lbHue.ItemIndex]); - end; -end; - -procedure TfrmDrawSettings.seForceAltitudeChange(Sender: TObject); -begin - cbForceAltitude.Checked := True; -end; - -procedure TfrmDrawSettings.seRandomHeightChange(Sender: TObject); -begin - cbRandomHeight.Checked := True; -end; - -function TfrmDrawSettings.CanClose: Boolean; -begin - Result := FCanClose and inherited CanClose; -end; - -procedure TfrmDrawSettings.OnHueClose(Sender: TObject; - var ACloseAction: TCloseAction); -var - msg: TLMessage; -begin - FCanClose := True; - frmHueSettings.OnClose := nil; - pbHue.Repaint; - MouseLeave(msg); -end; - -initialization - {$I UfrmDrawSettings.lrs} - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2009 Andreas Schneider + *) +unit UfrmDrawSettings; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, + Spin, ExtCtrls, LMessages, UfrmToolWindow; + +type + + { TfrmDrawSettings } + + TfrmDrawSettings = class(TfrmToolWindow) + cbForceAltitude: TCheckBox; + cbRandomHeight: TCheckBox; + gbHue: TGroupBox; + pbHue: TPaintBox; + rbRandom: TRadioButton; + rbTileList: TRadioButton; + seForceAltitude: TSpinEdit; + seRandomHeight: TSpinEdit; + procedure FormCreate(Sender: TObject); + procedure pbHueClick(Sender: TObject); + procedure pbHuePaint(Sender: TObject); + procedure seForceAltitudeChange(Sender: TObject); + procedure seRandomHeightChange(Sender: TObject); + private + FCanClose: Boolean; + function CanClose: Boolean; override; + procedure OnHueClose(Sender: TObject; var ACloseAction: TCloseAction); + end; + +var + frmDrawSettings: TfrmDrawSettings; + +implementation + +uses + UGameResources, UHue, UfrmHueSettings; + +{ TfrmDrawSettings } + +procedure TfrmDrawSettings.pbHueClick(Sender: TObject); +begin + frmHueSettings.Left := Mouse.CursorPos.x - 8; + frmHueSettings.Top := Mouse.CursorPos.y - 8; + frmHueSettings.OnClose := @OnHueClose; + frmHueSettings.Show; + FCanClose := False; +end; + +procedure TfrmDrawSettings.FormCreate(Sender: TObject); +begin + FCanClose := True; +end; + +procedure TfrmDrawSettings.pbHuePaint(Sender: TObject); +var + hue: THue; +begin + if frmHueSettings <> nil then + begin + if frmHueSettings.lbHue.ItemIndex > 0 then + hue := ResMan.Hue.Hues[frmHueSettings.lbHue.ItemIndex - 1] + else + hue := nil; + TfrmHueSettings.DrawHue(hue, pbHue.Canvas, pbHue.Canvas.ClipRect, + frmHueSettings.lbHue.Items.Strings[frmHueSettings.lbHue.ItemIndex]); + end; +end; + +procedure TfrmDrawSettings.seForceAltitudeChange(Sender: TObject); +begin + cbForceAltitude.Checked := True; +end; + +procedure TfrmDrawSettings.seRandomHeightChange(Sender: TObject); +begin + cbRandomHeight.Checked := True; +end; + +function TfrmDrawSettings.CanClose: Boolean; +begin + Result := FCanClose and inherited CanClose; +end; + +procedure TfrmDrawSettings.OnHueClose(Sender: TObject; + var ACloseAction: TCloseAction); +var + msg: TLMessage; +begin + FCanClose := True; + frmHueSettings.OnClose := nil; + pbHue.Repaint; + MouseLeave(msg); +end; + +initialization + {$I UfrmDrawSettings.lrs} + +end. + diff --git a/Client/Tools/UfrmFilter.lfm b/Client/Tools/UfrmFilter.lfm index 793c7fe..441af9b 100644 --- a/Client/Tools/UfrmFilter.lfm +++ b/Client/Tools/UfrmFilter.lfm @@ -1,317 +1,317 @@ -object frmFilter: TfrmFilter - Left = 290 - Height = 492 - Top = 171 - Width = 232 - ActiveControl = rgFilterType.RadioButton0 - BorderIcons = [biSystemMenu, biMinimize] - BorderStyle = bsToolWindow - Caption = 'Filter' - ClientHeight = 492 - ClientWidth = 232 - Font.Height = -11 - OnCreate = FormCreate - OnDestroy = FormDestroy - OnShow = FormShow - LCLVersion = '0.9.29' - object rgFilterType: TRadioGroup - Left = 4 - Height = 40 - Top = 4 - Width = 224 - Align = alTop - AutoFill = True - BorderSpacing.Around = 4 - Caption = 'Filter rule' - ChildSizing.LeftRightSpacing = 6 - ChildSizing.TopBottomSpacing = 6 - ChildSizing.EnlargeHorizontal = crsHomogenousChildResize - ChildSizing.EnlargeVertical = crsHomogenousChildResize - ChildSizing.ShrinkHorizontal = crsScaleChilds - ChildSizing.ShrinkVertical = crsScaleChilds - ChildSizing.Layout = cclLeftToRightThenTopToBottom - ChildSizing.ControlsPerLine = 2 - ClientHeight = 26 - ClientWidth = 222 - Columns = 2 - ItemIndex = 0 - Items.Strings = ( - 'Exclusive' - 'Inclusive' - ) - OnClick = rgFilterTypeClick - TabOrder = 0 - end - object GroupBox1: TGroupBox - Left = 4 - Height = 259 - Top = 48 - Width = 224 - Align = alClient - BorderSpacing.Around = 4 - Caption = 'Tile filter' - ClientHeight = 245 - ClientWidth = 222 - TabOrder = 1 - object Label1: TLabel - AnchorSideLeft.Control = GroupBox1 - AnchorSideTop.Control = cbTileFilter - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = GroupBox1 - AnchorSideRight.Side = asrBottom - Left = 4 - Height = 30 - Top = 30 - Width = 214 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Around = 4 - Caption = 'Drag and Drop static tiles from the tile list on this list to add them to the filter.' - ParentColor = False - WordWrap = True - end - object btnClear: TSpeedButton - AnchorSideLeft.Control = btnDelete - AnchorSideLeft.Side = asrBottom - AnchorSideRight.Control = GroupBox1 - AnchorSideRight.Side = asrCenter - AnchorSideBottom.Control = btnDelete - AnchorSideBottom.Side = asrBottom - Left = 30 - Height = 22 - Hint = 'Clear' - Top = 219 - Width = 22 - Anchors = [akLeft, akBottom] - Color = clBtnFace - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 20000000000000040000640000006400000000000000000000003ADCFE004800 - 3A00FEFF4800FCFF1C00FCFF1C0080FF9C00003BD700AF9AFF00002CC600FDEB - 9B000000000000000000000000000000000000000000000000000EECFF00B2FC - FF000046C00078D0FF000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000 - EFFF0000EDFF0000EDFFCBF3FC008905000024AEEF00E4A81C000000DB00B29E - FF0088000D000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443 - F7FF3242F7FF141BF1FF0000EDFFFCFF1C00FCFF1C0080FF9C0004000000FFBC - 00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909 - F5FF161BF5FF3343F7FF141BF1FF0000EDFFE4FF5C000050FF004C0000000000 - F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333 - F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF000008000052FF000000 - FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA - FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF0000CC0088005B000000 - FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1 - FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00B8FF00E3FFA8000000 - FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC - FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF08009000FCFF72000000 - FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC - FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF02000000E4FF5C000000 - FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2 - FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FFFCFF1C00000000000000 - FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC - FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000CCFF4C000000 - FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B - FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000 - 00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D - FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000 - 0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663 - FEFF5461FEFF2227FCFF0000FBFFFCFF1C00000000000000000008000000EFEF - EF00EFEFEF00EFEFEF000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000 - FDFF0000FDFF0000FDFF000000000000000000000000000000009034DE009034 - DE00D86FDF00D86FDF00E0A223004AC6080000000000580000005870DF000C70 - DF000000000000000000000000002070DF000000000000000000 - } - NumGlyphs = 0 - OnClick = btnClearClick - ShowHint = True - ParentShowHint = False - end - object btnDelete: TSpeedButton - AnchorSideLeft.Control = GroupBox1 - AnchorSideBottom.Control = GroupBox1 - AnchorSideBottom.Side = asrBottom - Left = 4 - Height = 22 - Hint = 'Delete' - Top = 219 - Width = 22 - Anchors = [akLeft, akBottom] - BorderSpacing.Around = 4 - Color = clBtnFace - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 20000000000000040000640000006400000000000000000000004F91AB005588 - 9C0043718A004E6974003E4B4C00457796003E6A950037556C005C7E8800548B - A00031464100FFFFFF002B3238002D3B430074B9C8007FC4D5004788A7004A92 - B500435E6F002E3040002E3538003D5E7B003853BEFF3551BDFF304BBCFF2E4E - B8FF303B3600FFFFFF00313637002C2D2B00588997007BC3D400365F8400396E - 9A003B6282003A5564004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178 - E4FF334DC1FF2B4AB7FFFFFFFF0036423900486B710061B4CE00396F9600375C - 83004085B1004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84 - EEFF9EA0F4FF515DD7FF2B4AB7FFFFFFFF00354C4C004D94AF00375D7F003348 - 5C005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56 - E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FFFFFFFF004A90A6003B5864003D5B - 6A004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59 - E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF57929C00498BA40047676D005C62 - D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59 - E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF54839500FFFFFF005F63 - DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF6FA2AF00000000006469 - DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF58B2E00000000000676A - DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F - ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF000000000800000000E8 - 1D007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84 - F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF000000000000000001000100DB12 - C0006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92 - F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF00000000000000002401AD00BA02 - AE002301AE006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9 - FBFFBAC7FCFF707BE9FF4C5BCCFFBB02F00000010000D8000000000000000000 - 000008000000010008006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4 - F4FF6670E2FF535ED1FF5031DE005031DE002501AC00B902AD000D040400F804 - 0500F20005000A0106000C040500F8040600686ADDFF6364DCFF6164DAFF5D63 - D9FFF2000700F804610000000000710900005031DE005031DE004034DE004034 - DE0068B0E00068B0E0000E049300F8049500F2009500070102000F049500F804 - 0200F2000200080104000E040200F8040400F200040009010500 - } - NumGlyphs = 0 - OnClick = btnDeleteClick - ShowHint = True - ParentShowHint = False - end - object vdtFilter: TVirtualDrawTree - Tag = 1 - AnchorSideLeft.Control = GroupBox1 - AnchorSideTop.Control = Label1 - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = GroupBox1 - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = btnDelete - Cursor = 63 - Left = 4 - Height = 151 - Top = 64 - Width = 214 - Anchors = [akTop, akLeft, akRight, akBottom] - BorderSpacing.Around = 4 - DefaultNodeHeight = 44 - DragType = dtVCL - Header.AutoSizeIndex = 0 - Header.Columns = < - item - Position = 0 - Text = 'ID' - end - item - Position = 1 - Text = 'Tile' - Width = 44 - end - item - Position = 2 - Text = 'Name' - Width = 100 - end> - Header.DefaultHeight = 17 - Header.Options = [hoColumnResize, hoDrag, hoVisible] - Header.ParentFont = True - Header.Style = hsFlatButtons - TabOrder = 0 - TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] - TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect] - OnDragOver = vdtFilterDragOver - OnDragDrop = vdtFilterDragDrop - OnDrawNode = vdtFilterDrawNode - end - object cbTileFilter: TCheckBox - AnchorSideLeft.Control = GroupBox1 - AnchorSideTop.Control = GroupBox1 - Left = 4 - Height = 22 - Top = 4 - Width = 85 - BorderSpacing.Around = 4 - Caption = 'Filter active' - OnChange = cbTileFilterChange - TabOrder = 1 - end - end - object GroupBox2: TGroupBox - Left = 4 - Height = 168 - Top = 320 - Width = 224 - Align = alBottom - BorderSpacing.Around = 4 - Caption = 'Hue filter' - ClientHeight = 154 - ClientWidth = 222 - TabOrder = 2 - object cbHueFilter: TCheckBox - Left = 4 - Height = 22 - Top = 4 - Width = 214 - Align = alTop - BorderSpacing.Around = 4 - Caption = 'Filter active' - OnChange = cbHueFilterChange - TabOrder = 0 - end - object vdtHues: TVirtualDrawTree - Cursor = 63 - Left = 4 - Height = 120 - Top = 30 - Width = 214 - Align = alClient - BorderSpacing.Around = 4 - Header.AutoSizeIndex = 2 - Header.Columns = < - item - Position = 0 - Width = 20 - end - item - Position = 1 - Text = 'Hue' - Width = 38 - end - item - Position = 2 - Text = 'Name' - Width = 154 - end> - Header.DefaultHeight = 17 - Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible] - Header.ParentFont = True - Header.Style = hsFlatButtons - PopupMenu = pmHues - TabOrder = 1 - TreeOptions.MiscOptions = [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning] - TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] - TreeOptions.SelectionOptions = [toFullRowSelect] - OnChecked = vdtHuesChecked - OnDrawNode = vdtHuesDrawNode - end - end - object Splitter1: TSplitter - Cursor = crVSplit - Left = 0 - Height = 5 - Top = 311 - Width = 232 - Align = alBottom - ResizeAnchor = akBottom - end - object pmHues: TPopupMenu - left = 148 - top = 404 - object mnuCheckHues: TMenuItem - Caption = 'Check all hues' - OnClick = mnuCheckHuesClick - end - object mnuUncheckHues: TMenuItem - Caption = 'Uncheck all hues' - OnClick = mnuUncheckHuesClick - end - end -end +object frmFilter: TfrmFilter + Left = 290 + Height = 492 + Top = 171 + Width = 232 + ActiveControl = rgFilterType.RadioButton0 + BorderIcons = [biSystemMenu, biMinimize] + BorderStyle = bsToolWindow + Caption = 'Filter' + ClientHeight = 492 + ClientWidth = 232 + Font.Height = -11 + OnCreate = FormCreate + OnDestroy = FormDestroy + OnShow = FormShow + LCLVersion = '0.9.29' + object rgFilterType: TRadioGroup + Left = 4 + Height = 40 + Top = 4 + Width = 224 + Align = alTop + AutoFill = True + BorderSpacing.Around = 4 + Caption = 'Filter rule' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 26 + ClientWidth = 222 + Columns = 2 + ItemIndex = 0 + Items.Strings = ( + 'Exclusive' + 'Inclusive' + ) + OnClick = rgFilterTypeClick + TabOrder = 0 + end + object GroupBox1: TGroupBox + Left = 4 + Height = 259 + Top = 48 + Width = 224 + Align = alClient + BorderSpacing.Around = 4 + Caption = 'Tile filter' + ClientHeight = 245 + ClientWidth = 222 + TabOrder = 1 + object Label1: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = cbTileFilter + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox1 + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 30 + Top = 30 + Width = 214 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Around = 4 + Caption = 'Drag and Drop static tiles from the tile list on this list to add them to the filter.' + ParentColor = False + WordWrap = True + end + object btnClear: TSpeedButton + AnchorSideLeft.Control = btnDelete + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = GroupBox1 + AnchorSideRight.Side = asrCenter + AnchorSideBottom.Control = btnDelete + AnchorSideBottom.Side = asrBottom + Left = 30 + Height = 22 + Hint = 'Clear' + Top = 219 + Width = 22 + Anchors = [akLeft, akBottom] + Color = clBtnFace + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 20000000000000040000640000006400000000000000000000003ADCFE004800 + 3A00FEFF4800FCFF1C00FCFF1C0080FF9C00003BD700AF9AFF00002CC600FDEB + 9B000000000000000000000000000000000000000000000000000EECFF00B2FC + FF000046C00078D0FF000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000 + EFFF0000EDFF0000EDFFCBF3FC008905000024AEEF00E4A81C000000DB00B29E + FF0088000D000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443 + F7FF3242F7FF141BF1FF0000EDFFFCFF1C00FCFF1C0080FF9C0004000000FFBC + 00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909 + F5FF161BF5FF3343F7FF141BF1FF0000EDFFE4FF5C000050FF004C0000000000 + F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333 + F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF000008000052FF000000 + FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA + FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF0000CC0088005B000000 + FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1 + FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00B8FF00E3FFA8000000 + FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC + FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF08009000FCFF72000000 + FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC + FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF02000000E4FF5C000000 + FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2 + FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FFFCFF1C00000000000000 + FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC + FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000CCFF4C000000 + FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B + FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000 + 00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D + FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000 + 0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663 + FEFF5461FEFF2227FCFF0000FBFFFCFF1C00000000000000000008000000EFEF + EF00EFEFEF00EFEFEF000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000 + FDFF0000FDFF0000FDFF000000000000000000000000000000009034DE009034 + DE00D86FDF00D86FDF00E0A223004AC6080000000000580000005870DF000C70 + DF000000000000000000000000002070DF000000000000000000 + } + NumGlyphs = 0 + OnClick = btnClearClick + ShowHint = True + ParentShowHint = False + end + object btnDelete: TSpeedButton + AnchorSideLeft.Control = GroupBox1 + AnchorSideBottom.Control = GroupBox1 + AnchorSideBottom.Side = asrBottom + Left = 4 + Height = 22 + Hint = 'Delete' + Top = 219 + Width = 22 + Anchors = [akLeft, akBottom] + BorderSpacing.Around = 4 + Color = clBtnFace + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 20000000000000040000640000006400000000000000000000004F91AB005588 + 9C0043718A004E6974003E4B4C00457796003E6A950037556C005C7E8800548B + A00031464100FFFFFF002B3238002D3B430074B9C8007FC4D5004788A7004A92 + B500435E6F002E3040002E3538003D5E7B003853BEFF3551BDFF304BBCFF2E4E + B8FF303B3600FFFFFF00313637002C2D2B00588997007BC3D400365F8400396E + 9A003B6282003A5564004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178 + E4FF334DC1FF2B4AB7FFFFFFFF0036423900486B710061B4CE00396F9600375C + 83004085B1004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84 + EEFF9EA0F4FF515DD7FF2B4AB7FFFFFFFF00354C4C004D94AF00375D7F003348 + 5C005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56 + E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FFFFFFFF004A90A6003B5864003D5B + 6A004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59 + E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF57929C00498BA40047676D005C62 + D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59 + E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF54839500FFFFFF005F63 + DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF6FA2AF00000000006469 + DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF58B2E00000000000676A + DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F + ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF000000000800000000E8 + 1D007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84 + F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF000000000000000001000100DB12 + C0006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92 + F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF00000000000000002401AD00BA02 + AE002301AE006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9 + FBFFBAC7FCFF707BE9FF4C5BCCFFBB02F00000010000D8000000000000000000 + 000008000000010008006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4 + F4FF6670E2FF535ED1FF5031DE005031DE002501AC00B902AD000D040400F804 + 0500F20005000A0106000C040500F8040600686ADDFF6364DCFF6164DAFF5D63 + D9FFF2000700F804610000000000710900005031DE005031DE004034DE004034 + DE0068B0E00068B0E0000E049300F8049500F2009500070102000F049500F804 + 0200F2000200080104000E040200F8040400F200040009010500 + } + NumGlyphs = 0 + OnClick = btnDeleteClick + ShowHint = True + ParentShowHint = False + end + object vdtFilter: TVirtualDrawTree + Tag = 1 + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = btnDelete + Cursor = 63 + Left = 4 + Height = 151 + Top = 64 + Width = 214 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Around = 4 + DefaultNodeHeight = 44 + DragType = dtVCL + Header.AutoSizeIndex = 0 + Header.Columns = < + item + Position = 0 + Text = 'ID' + end + item + Position = 1 + Text = 'Tile' + Width = 44 + end + item + Position = 2 + Text = 'Name' + Width = 100 + end> + Header.DefaultHeight = 17 + Header.Options = [hoColumnResize, hoDrag, hoVisible] + Header.ParentFont = True + Header.Style = hsFlatButtons + TabOrder = 0 + TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] + TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect] + OnDragOver = vdtFilterDragOver + OnDragDrop = vdtFilterDragDrop + OnDrawNode = vdtFilterDrawNode + end + object cbTileFilter: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = GroupBox1 + Left = 4 + Height = 22 + Top = 4 + Width = 85 + BorderSpacing.Around = 4 + Caption = 'Filter active' + OnChange = cbTileFilterChange + TabOrder = 1 + end + end + object GroupBox2: TGroupBox + Left = 4 + Height = 168 + Top = 320 + Width = 224 + Align = alBottom + BorderSpacing.Around = 4 + Caption = 'Hue filter' + ClientHeight = 154 + ClientWidth = 222 + TabOrder = 2 + object cbHueFilter: TCheckBox + Left = 4 + Height = 22 + Top = 4 + Width = 214 + Align = alTop + BorderSpacing.Around = 4 + Caption = 'Filter active' + OnChange = cbHueFilterChange + TabOrder = 0 + end + object vdtHues: TVirtualDrawTree + Cursor = 63 + Left = 4 + Height = 120 + Top = 30 + Width = 214 + Align = alClient + BorderSpacing.Around = 4 + Header.AutoSizeIndex = 2 + Header.Columns = < + item + Position = 0 + Width = 20 + end + item + Position = 1 + Text = 'Hue' + Width = 38 + end + item + Position = 2 + Text = 'Name' + Width = 154 + end> + Header.DefaultHeight = 17 + Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible] + Header.ParentFont = True + Header.Style = hsFlatButtons + PopupMenu = pmHues + TabOrder = 1 + TreeOptions.MiscOptions = [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning] + TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] + TreeOptions.SelectionOptions = [toFullRowSelect] + OnChecked = vdtHuesChecked + OnDrawNode = vdtHuesDrawNode + end + end + object Splitter1: TSplitter + Cursor = crVSplit + Left = 0 + Height = 5 + Top = 311 + Width = 232 + Align = alBottom + ResizeAnchor = akBottom + end + object pmHues: TPopupMenu + left = 148 + top = 404 + object mnuCheckHues: TMenuItem + Caption = 'Check all hues' + OnClick = mnuCheckHuesClick + end + object mnuUncheckHues: TMenuItem + Caption = 'Uncheck all hues' + OnClick = mnuUncheckHuesClick + end + end +end diff --git a/Client/Tools/UfrmLightlevel.lfm b/Client/Tools/UfrmLightlevel.lfm index 0eec6a7..1b5d12f 100644 --- a/Client/Tools/UfrmLightlevel.lfm +++ b/Client/Tools/UfrmLightlevel.lfm @@ -1,22 +1,22 @@ -inherited frmLightlevel: TfrmLightlevel - Height = 171 - Width = 40 - ActiveControl = tbLightlevel - Caption = 'Lightlevel' - ClientHeight = 171 - ClientWidth = 40 - object tbLightlevel: TTrackBar[0] - Left = 0 - Height = 171 - Top = 0 - Width = 40 - Max = 32 - OnChange = tbLightlevelChange - Orientation = trVertical - Position = 0 - Align = alClient - TabOrder = 0 - end - inherited tmClose: TTimer[1] - end -end +inherited frmLightlevel: TfrmLightlevel + Height = 171 + Width = 40 + ActiveControl = tbLightlevel + Caption = 'Lightlevel' + ClientHeight = 171 + ClientWidth = 40 + object tbLightlevel: TTrackBar[0] + Left = 0 + Height = 171 + Top = 0 + Width = 40 + Max = 32 + OnChange = tbLightlevelChange + Orientation = trVertical + Position = 0 + Align = alClient + TabOrder = 0 + end + inherited tmClose: TTimer[1] + end +end diff --git a/Client/Tools/UfrmToolWindow.pas b/Client/Tools/UfrmToolWindow.pas index dc7f43d..cf1fc08 100644 --- a/Client/Tools/UfrmToolWindow.pas +++ b/Client/Tools/UfrmToolWindow.pas @@ -1,104 +1,104 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2009 Andreas Schneider - *) -unit UfrmToolWindow; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, - LCLIntf, LMessages, ExtCtrls; - -type - - { TfrmToolWindow } - - TfrmToolWindow = class(TForm) - tmClose: TTimer; - procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); - procedure FormDeactivate(Sender: TObject); virtual; - procedure FormShow(Sender: TObject); virtual; - procedure tmCloseTimer(Sender: TObject); - protected - function CanClose: Boolean; virtual; - procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave; - public - { public declarations } - end; - -var - frmToolWindow: TfrmToolWindow; - -implementation - -{ TfrmToolWindow } - -procedure TfrmToolWindow.FormDeactivate(Sender: TObject); -begin - if CanClose then - Close; -end; - -procedure TfrmToolWindow.FormClose(Sender: TObject; - var CloseAction: TCloseAction); -begin - CloseAction := caHide; -end; - -procedure TfrmToolWindow.FormShow(Sender: TObject); -begin - Top := Mouse.CursorPos.y - 8; - Left := Mouse.CursorPos.x - 8; - - OnDeactivate := nil; - tmClose.Enabled := True; -end; - -procedure TfrmToolWindow.tmCloseTimer(Sender: TObject); -begin - tmClose.Enabled := False; - OnDeactivate := @FormDeactivate; - if CanClose then - Close; -end; - -function TfrmToolWindow.CanClose: Boolean; -begin - Result := not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos)); -end; - -procedure TfrmToolWindow.MouseLeave(var msg: TLMessage); -begin - if CanClose then - Close; -end; - -initialization - {$I UfrmToolWindow.lrs} - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2009 Andreas Schneider + *) +unit UfrmToolWindow; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + LCLIntf, LMessages, ExtCtrls; + +type + + { TfrmToolWindow } + + TfrmToolWindow = class(TForm) + tmClose: TTimer; + procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); + procedure FormDeactivate(Sender: TObject); virtual; + procedure FormShow(Sender: TObject); virtual; + procedure tmCloseTimer(Sender: TObject); + protected + function CanClose: Boolean; virtual; + procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave; + public + { public declarations } + end; + +var + frmToolWindow: TfrmToolWindow; + +implementation + +{ TfrmToolWindow } + +procedure TfrmToolWindow.FormDeactivate(Sender: TObject); +begin + if CanClose then + Close; +end; + +procedure TfrmToolWindow.FormClose(Sender: TObject; + var CloseAction: TCloseAction); +begin + CloseAction := caHide; +end; + +procedure TfrmToolWindow.FormShow(Sender: TObject); +begin + Top := Mouse.CursorPos.y - 8; + Left := Mouse.CursorPos.x - 8; + + OnDeactivate := nil; + tmClose.Enabled := True; +end; + +procedure TfrmToolWindow.tmCloseTimer(Sender: TObject); +begin + tmClose.Enabled := False; + OnDeactivate := @FormDeactivate; + if CanClose then + Close; +end; + +function TfrmToolWindow.CanClose: Boolean; +begin + Result := not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos)); +end; + +procedure TfrmToolWindow.MouseLeave(var msg: TLMessage); +begin + if CanClose then + Close; +end; + +initialization + {$I UfrmToolWindow.lrs} + +end. + diff --git a/Client/UGameResources.pas b/Client/UGameResources.pas index f5302d8..f99e885 100644 --- a/Client/UGameResources.pas +++ b/Client/UGameResources.pas @@ -1,125 +1,125 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2009 Andreas Schneider - *) -unit UGameResources; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, UArtProvider, UTileDataProvider, UTexmapProvider, - ULandscape, UHueProvider, UAnimDataProvider, ULightProvider; - -type - - { TGameResourceManager } - - TGameResourceManager = class - constructor Create(ADataDir: String); - destructor Destroy; override; - protected - { Members } - FDataDir: String; - FArtProvider: TArtProvider; - FTiledataProvider: TTiledataProvider; - FAnimdataProvider: TAnimdataProvider; - FTexmapProvider: TTexmapProvider; - FHueProvider: THueProvider; - FLightProvider: TLightProvider; - FLandscape: TLandscape; - public - { Fields } - property Art: TArtProvider read FArtProvider; - property Hue: THueProvider read FHueProvider; - property Landscape: TLandscape read FLandscape; - property Tiledata: TTiledataProvider read FTiledataProvider; - property Animdata: TAnimDataProvider read FAnimdataProvider; - property Texmaps: TTexmapProvider read FTexmapProvider; - property Lights: TLightProvider read FLightProvider; - - { Methods } - function GetFile(AFileName: String): String; - procedure InitLandscape(AWidth, AHeight: Word); - end; - -var - GameResourceManager: TGameResourceManager; - ResMan: TGameResourceManager absolute GameResourceManager; - -procedure InitGameResourceManager(ADataDir: String); - -implementation - -procedure InitGameResourceManager(ADataDir: String); -begin - FreeAndNil(GameResourceManager); - GameResourceManager := TGameResourceManager.Create(ADataDir); -end; - -{ TGameResourceManager } - -constructor TGameResourceManager.Create(ADataDir: String); -begin - inherited Create; - FDataDir := IncludeTrailingPathDelimiter(ADataDir); - - FArtProvider := TArtProvider.Create(GetFile('art.mul'), GetFile('artidx.mul'), True); - FTiledataProvider := TTiledataProvider.Create(GetFile('tiledata.mul'), True); - FAnimdataProvider := TAnimDataProvider.Create(GetFile('animdata.mul'), True); - FTexmapProvider := TTexmapProvider.Create(GetFile('texmaps.mul'), - GetFile('texidx.mul'), True); - FHueProvider := THueProvider.Create(GetFile('hues.mul'), True); - FLightProvider := TLightProvider.Create(GetFile('light.mul'), - GetFile('lightidx.mul'), True); -end; - -destructor TGameResourceManager.Destroy; -begin - FreeAndNil(FArtProvider); - FreeAndNil(FTiledataProvider); - FreeAndNil(FAnimdataProvider); - FreeAndNil(FTexmapProvider); - FreeAndNil(FHueProvider); - FreeAndNil(FLightProvider); - FreeAndNil(FLandscape); - inherited Destroy; -end; - -function TGameResourceManager.GetFile(AFileName: String): String; -begin - Result := FDataDir + AFileName; -end; - -procedure TGameResourceManager.InitLandscape(AWidth, AHeight: Word); -begin - FreeAndNil(FLandscape); - FLandscape := TLandscape.Create(AWidth, AHeight); -end; - -finalization - FreeAndNil(GameResourceManager); - -end. +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2009 Andreas Schneider + *) +unit UGameResources; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, UArtProvider, UTileDataProvider, UTexmapProvider, + ULandscape, UHueProvider, UAnimDataProvider, ULightProvider; + +type + + { TGameResourceManager } + + TGameResourceManager = class + constructor Create(ADataDir: String); + destructor Destroy; override; + protected + { Members } + FDataDir: String; + FArtProvider: TArtProvider; + FTiledataProvider: TTiledataProvider; + FAnimdataProvider: TAnimdataProvider; + FTexmapProvider: TTexmapProvider; + FHueProvider: THueProvider; + FLightProvider: TLightProvider; + FLandscape: TLandscape; + public + { Fields } + property Art: TArtProvider read FArtProvider; + property Hue: THueProvider read FHueProvider; + property Landscape: TLandscape read FLandscape; + property Tiledata: TTiledataProvider read FTiledataProvider; + property Animdata: TAnimDataProvider read FAnimdataProvider; + property Texmaps: TTexmapProvider read FTexmapProvider; + property Lights: TLightProvider read FLightProvider; + + { Methods } + function GetFile(AFileName: String): String; + procedure InitLandscape(AWidth, AHeight: Word); + end; + +var + GameResourceManager: TGameResourceManager; + ResMan: TGameResourceManager absolute GameResourceManager; + +procedure InitGameResourceManager(ADataDir: String); + +implementation + +procedure InitGameResourceManager(ADataDir: String); +begin + FreeAndNil(GameResourceManager); + GameResourceManager := TGameResourceManager.Create(ADataDir); +end; + +{ TGameResourceManager } + +constructor TGameResourceManager.Create(ADataDir: String); +begin + inherited Create; + FDataDir := IncludeTrailingPathDelimiter(ADataDir); + + FArtProvider := TArtProvider.Create(GetFile('art.mul'), GetFile('artidx.mul'), True); + FTiledataProvider := TTiledataProvider.Create(GetFile('tiledata.mul'), True); + FAnimdataProvider := TAnimDataProvider.Create(GetFile('animdata.mul'), True); + FTexmapProvider := TTexmapProvider.Create(GetFile('texmaps.mul'), + GetFile('texidx.mul'), True); + FHueProvider := THueProvider.Create(GetFile('hues.mul'), True); + FLightProvider := TLightProvider.Create(GetFile('light.mul'), + GetFile('lightidx.mul'), True); +end; + +destructor TGameResourceManager.Destroy; +begin + FreeAndNil(FArtProvider); + FreeAndNil(FTiledataProvider); + FreeAndNil(FAnimdataProvider); + FreeAndNil(FTexmapProvider); + FreeAndNil(FHueProvider); + FreeAndNil(FLightProvider); + FreeAndNil(FLandscape); + inherited Destroy; +end; + +function TGameResourceManager.GetFile(AFileName: String): String; +begin + Result := FDataDir + AFileName; +end; + +procedure TGameResourceManager.InitLandscape(AWidth, AHeight: Word); +begin + FreeAndNil(FLandscape); + FLandscape := TLandscape.Create(AWidth, AHeight); +end; + +finalization + FreeAndNil(GameResourceManager); + +end. diff --git a/Client/UOverlayUI.pas b/Client/UOverlayUI.pas index 80757fa..5817786 100644 --- a/Client/UOverlayUI.pas +++ b/Client/UOverlayUI.pas @@ -1,255 +1,255 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2007 Andreas Schneider - *) -unit UOverlayUI; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, Gl, GLU, Imaging, ImagingTypes, ImagingClasses, - ImagingOpenGL, OpenGLContext, ImagingUtility; - -type - - { TGLArrow } - - TGLArrow = class(TObject) - constructor Create(AGraphic: TSingleImage); - destructor Destroy; override; - protected - FGraphic: TSingleImage; - FTexture: GLuint; - FRealWidth: Integer; - FRealHeight: Integer; - FWidth: Integer; - FHeight: Integer; - FCurrentX: Integer; - FCurrentY: Integer; - procedure UpdateTexture; - public - property Width: Integer read FWidth; - property Height: Integer read FHeight; - property CurrentX: Integer read FCurrentX; - property CurrentY: Integer read FCurrentY; - - function HitTest(AX, AY: Integer): Boolean; - procedure DrawGL(AX, AY: Integer; AActive: Boolean = False); - end; - - { TOverlayUI } - - TOverlayUI = class(TObject) - constructor Create; - destructor Destroy; override; - protected - FArrows: array[0..7] of TGLArrow; - FActiveArrow: Integer; - FVisible: Boolean; - public - property ActiveArrow: Integer read FActiveArrow write FActiveArrow; - property Visible: Boolean read FVisible write FVisible; - function HitTest(AX, AY: Integer): Integer; - procedure Draw(AContext: TOpenGLControl); - end; - -implementation - -uses - UResourceManager; - -{ TGLArrow } - -constructor TGLArrow.Create(AGraphic: TSingleImage); -var - caps: TGLTextureCaps; -begin - inherited Create; - FRealWidth := AGraphic.Width; - FRealHeight := AGraphic.Height; - GetGLTextureCaps(caps); - if caps.NonPowerOfTwo then - begin - FWidth := FRealWidth; - FHeight := FRealHeight; - end else - begin - if IsPow2(FRealWidth) then FWidth := FRealWidth else FWidth := NextPow2(FRealWidth); - if IsPow2(FRealHeight) then FHeight := FRealHeight else FHeight := NextPow2(FRealHeight); - end; - FGraphic := TSingleImage.CreateFromParams(FWidth, FHeight, ifA8R8G8B8); - AGraphic.CopyTo(0, 0, FRealWidth, FRealHeight, FGraphic, 0, 0); - FTexture := 0; -end; - -destructor TGLArrow.Destroy; -begin - if FGraphic <> nil then FreeAndNil(FGraphic); - if FTexture <> 0 then glDeleteTextures(1, @FTexture); - inherited Destroy; -end; - -procedure TGLArrow.UpdateTexture; -begin - if (FGraphic <> nil) and (FRealWidth > 0) and (FRealWidth > 0) then - begin - FTexture := CreateGLTextureFromImage(FGraphic.ImageDataPointer^, 0, 0, False); - - glBindTexture(GL_TEXTURE_2D, FTexture); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST); - glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP); - glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); - end; -end; - -function TGLArrow.HitTest(AX, AY: Integer): Boolean; -var - pixel: TColor32Rec; -begin - if (AX > -1) and (AX < FRealWidth) and (AY > -1) and (AY < FRealHeight) then - begin - pixel := GetPixel32(FGraphic.ImageDataPointer^, AX, AY); - Result := pixel.A > 0; - end else - Result := False; -end; - -procedure TGLArrow.DrawGL(AX, AY: Integer; AActive: Boolean = False); -begin - FCurrentX := AX; - FCurrentY := AY; - - if FTexture = 0 then UpdateTexture; - - if FTexture <> 0 then - begin - if AActive then - begin - glEnable(GL_COLOR_LOGIC_OP); - glLogicOp(GL_COPY_INVERTED); - end; - - glBindTexture(GL_TEXTURE_2D, FTexture); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2d(AX, AY); - glTexCoord2f(1, 0); glVertex2d(AX + FWidth, AY); - glTexCoord2f(1, 1); glVertex2d(AX + FWidth, AY + FHeight); - glTexCoord2f(0, 1); glVertex2d(AX, AY + FHeight); - glEnd; - - if AActive then - glDisable(GL_COLOR_LOGIC_OP); - end; -end; - -{ TOverlayUI } - -constructor TOverlayUI.Create; -var - i: Integer; - arrow: TSingleImage; -begin - inherited Create; - FActiveArrow := -1; - FVisible := False; - - arrow := TSingleImage.CreateFromStream(ResourceManager.GetResource(0)); - for i := 0 to 3 do - begin - FArrows[2*i] := TGLArrow.Create(arrow); - if i < 3 then - arrow.Rotate(-90); - end; - arrow.Free; - - arrow := TSingleImage.CreateFromStream(ResourceManager.GetResource(1)); - for i := 0 to 3 do - begin - FArrows[2*i+1] := TGLArrow.Create(arrow); - if i < 3 then - arrow.Rotate(-90); - end; - arrow.Free; -end; - -destructor TOverlayUI.Destroy; -var - i: Integer; -begin - for i := 0 to 7 do - if FArrows[i] <> nil then FreeAndNil(FArrows[i]); - - inherited Destroy; -end; - -function TOverlayUI.HitTest(AX, AY: Integer): Integer; -var - i: Integer; -begin - Result := -1; - i := 0; - while (i <= 7) and (Result = -1) do - begin - if FArrows[i].HitTest(AX - FArrows[i].CurrentX, AY - FArrows[i].CurrentY) then - Result := i; - Inc(i); - end; -end; - -procedure TOverlayUI.Draw(AContext: TOpenGLControl); -begin - if FVisible then - begin - glColor4f(1.0, 1.0, 1.0, 1.0); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - - FArrows[0].DrawGL(10, 10, FActiveArrow = 0); - FArrows[1].DrawGL(AContext.Width div 2 - FArrows[1].Width div 2, 10, - FActiveArrow = 1); - FArrows[2].DrawGL(AContext.Width - 10 - FArrows[2].Width, 10, - FActiveArrow = 2); - - FArrows[3].DrawGL(AContext.Width - 10 - FArrows[3].Width, - AContext.Height div 2 - FArrows[3].Height div 2, - FActiveArrow = 3); - - FArrows[4].DrawGL(AContext.Width - 10 - FArrows[4].Width, - AContext.Height - 10 - FArrows[4].Height, - FActiveArrow = 4); - FArrows[5].DrawGL(AContext.Width div 2 - FArrows[5].Width div 2, - AContext.Height - 10 - FArrows[5].Height, - FActiveArrow = 5); - FArrows[6].DrawGL(10, AContext.Height - 10 - FArrows[6].Height, - FActiveArrow = 6); - - FArrows[7].DrawGL(10, AContext.Height div 2 - FArrows[7].Height div 2, - FActiveArrow = 7); - end; -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2007 Andreas Schneider + *) +unit UOverlayUI; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Gl, GLU, Imaging, ImagingTypes, ImagingClasses, + ImagingOpenGL, OpenGLContext, ImagingUtility; + +type + + { TGLArrow } + + TGLArrow = class(TObject) + constructor Create(AGraphic: TSingleImage); + destructor Destroy; override; + protected + FGraphic: TSingleImage; + FTexture: GLuint; + FRealWidth: Integer; + FRealHeight: Integer; + FWidth: Integer; + FHeight: Integer; + FCurrentX: Integer; + FCurrentY: Integer; + procedure UpdateTexture; + public + property Width: Integer read FWidth; + property Height: Integer read FHeight; + property CurrentX: Integer read FCurrentX; + property CurrentY: Integer read FCurrentY; + + function HitTest(AX, AY: Integer): Boolean; + procedure DrawGL(AX, AY: Integer; AActive: Boolean = False); + end; + + { TOverlayUI } + + TOverlayUI = class(TObject) + constructor Create; + destructor Destroy; override; + protected + FArrows: array[0..7] of TGLArrow; + FActiveArrow: Integer; + FVisible: Boolean; + public + property ActiveArrow: Integer read FActiveArrow write FActiveArrow; + property Visible: Boolean read FVisible write FVisible; + function HitTest(AX, AY: Integer): Integer; + procedure Draw(AContext: TOpenGLControl); + end; + +implementation + +uses + UResourceManager; + +{ TGLArrow } + +constructor TGLArrow.Create(AGraphic: TSingleImage); +var + caps: TGLTextureCaps; +begin + inherited Create; + FRealWidth := AGraphic.Width; + FRealHeight := AGraphic.Height; + GetGLTextureCaps(caps); + if caps.NonPowerOfTwo then + begin + FWidth := FRealWidth; + FHeight := FRealHeight; + end else + begin + if IsPow2(FRealWidth) then FWidth := FRealWidth else FWidth := NextPow2(FRealWidth); + if IsPow2(FRealHeight) then FHeight := FRealHeight else FHeight := NextPow2(FRealHeight); + end; + FGraphic := TSingleImage.CreateFromParams(FWidth, FHeight, ifA8R8G8B8); + AGraphic.CopyTo(0, 0, FRealWidth, FRealHeight, FGraphic, 0, 0); + FTexture := 0; +end; + +destructor TGLArrow.Destroy; +begin + if FGraphic <> nil then FreeAndNil(FGraphic); + if FTexture <> 0 then glDeleteTextures(1, @FTexture); + inherited Destroy; +end; + +procedure TGLArrow.UpdateTexture; +begin + if (FGraphic <> nil) and (FRealWidth > 0) and (FRealWidth > 0) then + begin + FTexture := CreateGLTextureFromImage(FGraphic.ImageDataPointer^, 0, 0, False); + + glBindTexture(GL_TEXTURE_2D, FTexture); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST); + glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP); + glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); + end; +end; + +function TGLArrow.HitTest(AX, AY: Integer): Boolean; +var + pixel: TColor32Rec; +begin + if (AX > -1) and (AX < FRealWidth) and (AY > -1) and (AY < FRealHeight) then + begin + pixel := GetPixel32(FGraphic.ImageDataPointer^, AX, AY); + Result := pixel.A > 0; + end else + Result := False; +end; + +procedure TGLArrow.DrawGL(AX, AY: Integer; AActive: Boolean = False); +begin + FCurrentX := AX; + FCurrentY := AY; + + if FTexture = 0 then UpdateTexture; + + if FTexture <> 0 then + begin + if AActive then + begin + glEnable(GL_COLOR_LOGIC_OP); + glLogicOp(GL_COPY_INVERTED); + end; + + glBindTexture(GL_TEXTURE_2D, FTexture); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2d(AX, AY); + glTexCoord2f(1, 0); glVertex2d(AX + FWidth, AY); + glTexCoord2f(1, 1); glVertex2d(AX + FWidth, AY + FHeight); + glTexCoord2f(0, 1); glVertex2d(AX, AY + FHeight); + glEnd; + + if AActive then + glDisable(GL_COLOR_LOGIC_OP); + end; +end; + +{ TOverlayUI } + +constructor TOverlayUI.Create; +var + i: Integer; + arrow: TSingleImage; +begin + inherited Create; + FActiveArrow := -1; + FVisible := False; + + arrow := TSingleImage.CreateFromStream(ResourceManager.GetResource(0)); + for i := 0 to 3 do + begin + FArrows[2*i] := TGLArrow.Create(arrow); + if i < 3 then + arrow.Rotate(-90); + end; + arrow.Free; + + arrow := TSingleImage.CreateFromStream(ResourceManager.GetResource(1)); + for i := 0 to 3 do + begin + FArrows[2*i+1] := TGLArrow.Create(arrow); + if i < 3 then + arrow.Rotate(-90); + end; + arrow.Free; +end; + +destructor TOverlayUI.Destroy; +var + i: Integer; +begin + for i := 0 to 7 do + if FArrows[i] <> nil then FreeAndNil(FArrows[i]); + + inherited Destroy; +end; + +function TOverlayUI.HitTest(AX, AY: Integer): Integer; +var + i: Integer; +begin + Result := -1; + i := 0; + while (i <= 7) and (Result = -1) do + begin + if FArrows[i].HitTest(AX - FArrows[i].CurrentX, AY - FArrows[i].CurrentY) then + Result := i; + Inc(i); + end; +end; + +procedure TOverlayUI.Draw(AContext: TOpenGLControl); +begin + if FVisible then + begin + glColor4f(1.0, 1.0, 1.0, 1.0); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + FArrows[0].DrawGL(10, 10, FActiveArrow = 0); + FArrows[1].DrawGL(AContext.Width div 2 - FArrows[1].Width div 2, 10, + FActiveArrow = 1); + FArrows[2].DrawGL(AContext.Width - 10 - FArrows[2].Width, 10, + FActiveArrow = 2); + + FArrows[3].DrawGL(AContext.Width - 10 - FArrows[3].Width, + AContext.Height div 2 - FArrows[3].Height div 2, + FActiveArrow = 3); + + FArrows[4].DrawGL(AContext.Width - 10 - FArrows[4].Width, + AContext.Height - 10 - FArrows[4].Height, + FActiveArrow = 4); + FArrows[5].DrawGL(AContext.Width div 2 - FArrows[5].Width div 2, + AContext.Height - 10 - FArrows[5].Height, + FActiveArrow = 5); + FArrows[6].DrawGL(10, AContext.Height - 10 - FArrows[6].Height, + FActiveArrow = 6); + + FArrows[7].DrawGL(10, AContext.Height div 2 - FArrows[7].Height div 2, + FActiveArrow = 7); + end; +end; + +end. + diff --git a/Client/UPacketHandlers.pas b/Client/UPacketHandlers.pas index f710d1e..f460a88 100644 --- a/Client/UPacketHandlers.pas +++ b/Client/UPacketHandlers.pas @@ -1,150 +1,150 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2007 Andreas Schneider - *) -unit UPacketHandlers; - -interface - -uses - SysUtils, dzlib, UEnhancedMemoryStream; - -type - TPacketProcessor = procedure(ABuffer: TEnhancedMemoryStream); - TPacketProcessorMethod = procedure(ABuffer: TEnhancedMemoryStream) of object; - - { TPacketHandler } - - TPacketHandler = class(TObject) - constructor Create(ALength: Cardinal; APacketProcessor: TPacketProcessor); overload; - constructor Create(ALength: Cardinal; APacketProcessorMethod: TPacketProcessorMethod); overload; - procedure Process(ABuffer: TEnhancedMemoryStream); - protected - FLength: Cardinal; - FPacketProcessor: TPacketProcessor; - FPacketProcessorMethod: TPacketProcessorMethod; - published - property PacketLength: Cardinal read FLength; - end; - -var - PacketHandlers: array[0..$FF] of TPacketHandler; - -procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler); - -implementation - -uses - UAdminHandling; - -procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler); -begin - FreeAndNil(PacketHandlers[AID]); - PacketHandlers[AID] := APacketHandler; -end; - -{ TPacketHandler } - -constructor TPacketHandler.Create(ALength: Cardinal; APacketProcessor: TPacketProcessor); -begin - inherited Create; - FLength := ALength; - FPacketProcessor := APacketProcessor; - FPacketProcessorMethod := nil; -end; - -constructor TPacketHandler.Create(ALength: Cardinal; - APacketProcessorMethod: TPacketProcessorMethod); -begin - inherited Create; - FLength := ALength; - FPacketProcessor := nil; - FPacketProcessorMethod := APacketProcessorMethod; -end; - -procedure TPacketHandler.Process(ABuffer: TEnhancedMemoryStream); -begin - if Assigned(FPacketProcessor) then - FPacketProcessor(ABuffer) - else if Assigned(FPacketProcessorMethod) then - FPacketProcessorMethod(ABuffer); -end; - -procedure OnCompressedPacket(ABuffer: TEnhancedMemoryStream); -var - uncompStream: TEnhancedMemoryStream; - uncompBuffer: TDecompressionStream; - targetSize: Cardinal; - packetID: Byte; -begin - //writeln('compressed size: ', ABuffer.Size); - targetSize := ABuffer.ReadCardinal; - //writeln('uncompressed size: ', targetSize); - uncompBuffer := TDecompressionStream.Create(ABuffer); - uncompStream := TEnhancedMemoryStream.Create; - try - uncompStream.CopyFrom(uncompBuffer, targetSize); - uncompStream.Position := 0; - packetID := uncompStream.ReadByte; - if PacketHandlers[packetID] <> nil then - begin - if PacketHandlers[PacketID].PacketLength = 0 then - uncompStream.Position := uncompStream.Position + 4; - uncompStream.Lock(uncompStream.Position, uncompStream.Size - uncompStream.Position); - PacketHandlers[PacketID].Process(uncompStream); - uncompStream.Unlock; - end else - begin - {Writeln('Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress); - ANetState.Socket.Disconnect; - ANetState.ReceiveQueue.Clear;} - end; - finally - if uncompBuffer <> nil then uncompBuffer.Free; - if uncompStream <> nil then uncompStream.Free; - end; -end; - - -{$WARNINGS OFF} -var - i: Integer; - -initialization - for i := 0 to $FF do - PacketHandlers[i] := nil; - PacketHandlers[$01] := TPacketHandler.Create(0, @OnCompressedPacket); - //$02 --> ConnectionHandling, done by TdmNetwork - PacketHandlers[$03] := TPacketHandler.Create(0, @OnAdminHandlerPacket);; - //$04 --> handled by TLandscape - //$06-$0B --> handled by TLandscape - //$0C --> ClientHandling, done by TfrmMain - //$0D --> RadarMapHandling, done by TfrmRadarMap -finalization - for i := 0 to $FF do - if PacketHandlers[i] <> nil then - PacketHandlers[i].Free; -{$WARNINGS ON} -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2007 Andreas Schneider + *) +unit UPacketHandlers; + +interface + +uses + SysUtils, dzlib, UEnhancedMemoryStream; + +type + TPacketProcessor = procedure(ABuffer: TEnhancedMemoryStream); + TPacketProcessorMethod = procedure(ABuffer: TEnhancedMemoryStream) of object; + + { TPacketHandler } + + TPacketHandler = class(TObject) + constructor Create(ALength: Cardinal; APacketProcessor: TPacketProcessor); overload; + constructor Create(ALength: Cardinal; APacketProcessorMethod: TPacketProcessorMethod); overload; + procedure Process(ABuffer: TEnhancedMemoryStream); + protected + FLength: Cardinal; + FPacketProcessor: TPacketProcessor; + FPacketProcessorMethod: TPacketProcessorMethod; + published + property PacketLength: Cardinal read FLength; + end; + +var + PacketHandlers: array[0..$FF] of TPacketHandler; + +procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler); + +implementation + +uses + UAdminHandling; + +procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler); +begin + FreeAndNil(PacketHandlers[AID]); + PacketHandlers[AID] := APacketHandler; +end; + +{ TPacketHandler } + +constructor TPacketHandler.Create(ALength: Cardinal; APacketProcessor: TPacketProcessor); +begin + inherited Create; + FLength := ALength; + FPacketProcessor := APacketProcessor; + FPacketProcessorMethod := nil; +end; + +constructor TPacketHandler.Create(ALength: Cardinal; + APacketProcessorMethod: TPacketProcessorMethod); +begin + inherited Create; + FLength := ALength; + FPacketProcessor := nil; + FPacketProcessorMethod := APacketProcessorMethod; +end; + +procedure TPacketHandler.Process(ABuffer: TEnhancedMemoryStream); +begin + if Assigned(FPacketProcessor) then + FPacketProcessor(ABuffer) + else if Assigned(FPacketProcessorMethod) then + FPacketProcessorMethod(ABuffer); +end; + +procedure OnCompressedPacket(ABuffer: TEnhancedMemoryStream); +var + uncompStream: TEnhancedMemoryStream; + uncompBuffer: TDecompressionStream; + targetSize: Cardinal; + packetID: Byte; +begin + //writeln('compressed size: ', ABuffer.Size); + targetSize := ABuffer.ReadCardinal; + //writeln('uncompressed size: ', targetSize); + uncompBuffer := TDecompressionStream.Create(ABuffer); + uncompStream := TEnhancedMemoryStream.Create; + try + uncompStream.CopyFrom(uncompBuffer, targetSize); + uncompStream.Position := 0; + packetID := uncompStream.ReadByte; + if PacketHandlers[packetID] <> nil then + begin + if PacketHandlers[PacketID].PacketLength = 0 then + uncompStream.Position := uncompStream.Position + 4; + uncompStream.Lock(uncompStream.Position, uncompStream.Size - uncompStream.Position); + PacketHandlers[PacketID].Process(uncompStream); + uncompStream.Unlock; + end else + begin + {Writeln('Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress); + ANetState.Socket.Disconnect; + ANetState.ReceiveQueue.Clear;} + end; + finally + if uncompBuffer <> nil then uncompBuffer.Free; + if uncompStream <> nil then uncompStream.Free; + end; +end; + + +{$WARNINGS OFF} +var + i: Integer; + +initialization + for i := 0 to $FF do + PacketHandlers[i] := nil; + PacketHandlers[$01] := TPacketHandler.Create(0, @OnCompressedPacket); + //$02 --> ConnectionHandling, done by TdmNetwork + PacketHandlers[$03] := TPacketHandler.Create(0, @OnAdminHandlerPacket);; + //$04 --> handled by TLandscape + //$06-$0B --> handled by TLandscape + //$0C --> ClientHandling, done by TfrmMain + //$0D --> RadarMapHandling, done by TfrmRadarMap +finalization + for i := 0 to $FF do + if PacketHandlers[i] <> nil then + PacketHandlers[i].Free; +{$WARNINGS ON} +end. + diff --git a/Client/UPackets.pas b/Client/UPackets.pas index f26dd06..bbd7c12 100644 --- a/Client/UPackets.pas +++ b/Client/UPackets.pas @@ -1,373 +1,373 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2009 Andreas Schneider - *) -unit UPackets; - -interface - -uses - Classes, dzlib, UEnhancedMemoryStream, UPacket, UStatics; - -type - TBlockCoords = packed record - X: Word; - Y: Word; - end; - TBlockCoordsArray = array of TBlockCoords; - - { TCompressedPacket } - - TCompressedPacket = class(TPacket) - constructor Create(APacket: TPacket); - end; - - { TLoginRequestPacket } - - TLoginRequestPacket = class(TPacket) - constructor Create(AUsername, APassword: string); - end; - - { TQuitPacket } - - TQuitPacket = class(TPacket) - constructor Create; - end; - - { TRequestBlocksPacket } - - TRequestBlocksPacket = class(TPacket) - constructor Create(ACoords: TBlockCoordsArray); - end; - - { TFreeBlockPacket } - - TFreeBlockPacket = class(TPacket) - constructor Create(AX, AY: Word); - end; - - { TDrawMapPacket } - - TDrawMapPacket = class(TPacket) - constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word); - end; - - { TStaticPacket } - - TStaticPacket = class(TPacket) - protected - procedure WriteStaticItem(AStaticItem: TStaticItem); - end; - - { TInsertStaticPacket } - - TInsertStaticPacket = class(TPacket) - constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word); - end; - - { TDeleteStaticPacket } - - TDeleteStaticPacket = class(TStaticPacket) - constructor Create(AStaticItem: TStaticItem); - end; - - { TElevateStaticPacket } - - TElevateStaticPacket = class(TStaticPacket) - constructor Create(AStaticItem: TStaticItem; ANewZ: ShortInt); - constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word; - ANewZ: Word); - end; - - { TMoveStaticPacket } - - TMoveStaticPacket = class(TStaticPacket) - constructor Create(AStaticItem: TStaticItem; ANewX, ANewY: Word); - constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word; - ANewX, ANewY: Word); - end; - - { THueStaticPacket } - - THueStaticPacket = class(TStaticPacket) - constructor Create(AStaticItem: TStaticItem; ANewHue: Word); - constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word; - ANewHue: Word); - end; - - { TUpdateClientPosPacket } - - TUpdateClientPosPacket = class(TPacket) - constructor Create(AX, AY: Word); - end; - - { TChatMessagePacket } - - TChatMessagePacket = class(TPacket) - constructor Create(AMessage: string); - end; - - { TGotoClientPosPacket } - - TGotoClientPosPacket = class(TPacket) - constructor Create(AUsername: string); - end; - - { TRequestRadarChecksumPacket } - - TRequestRadarChecksumPacket = class(TPacket) - constructor Create; - end; - - { TRequestRadarMapPacket } - - TRequestRadarMapPacket = class(TPacket) - constructor Create; - end; - - { TNoOpPacket } - - TNoOpPacket = class(TPacket) - constructor Create; - end; - -implementation - -{ TCompressedPacket } - -constructor TCompressedPacket.Create(APacket: TPacket); -var - compBuffer: TEnhancedMemoryStream; - compStream: TCompressionStream; - sourceStream: TStream; -begin - inherited Create($01, 0); - compBuffer := TEnhancedMemoryStream.Create; - compStream := TCompressionStream.Create(clMax, compBuffer); - sourceStream := APacket.Stream; - compStream.CopyFrom(sourceStream, 0); - compStream.Free; - FStream.WriteCardinal(sourceStream.Size); - FStream.CopyFrom(compBuffer, 0); - compBuffer.Free; - APacket.Free; -end; - -{ TLoginRequestPacket } - -constructor TLoginRequestPacket.Create(AUsername, APassword: string); -begin - inherited Create($02, 0); - FStream.WriteByte($03); - FStream.WriteStringNull(AUsername); - FStream.WriteStringNull(APassword); -end; - -{ TQuitPacket } - -constructor TQuitPacket.Create; -begin - inherited Create($02, 0); - FStream.WriteByte($05); -end; - -{ TRequestBlocksPacket } - -constructor TRequestBlocksPacket.Create(ACoords: TBlockCoordsArray); -begin - inherited Create($04, 0); - FStream.Write(ACoords[0], Length(ACoords) * SizeOf(TBlockCoords)); -end; - -{ TFreeBlockPacket } - -constructor TFreeBlockPacket.Create(AX, AY: Word); -begin - inherited Create($05, 5); - FStream.WriteWord(AX); - FStream.WriteWord(AY); -end; - -{ TDrawMapPacket } - -constructor TDrawMapPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word); -begin - inherited Create($06, 8); - FStream.WriteWord(AX); - FStream.WriteWord(AY); - FStream.WriteShortInt(AZ); - FStream.WriteWord(ATileID); -end; - -{ TStaticPacket } - -procedure TStaticPacket.WriteStaticItem(AStaticItem: TStaticItem); -begin - FStream.WriteWord(AStaticItem.X); - FStream.WriteWord(AStaticItem.Y); - FStream.WriteShortInt(AStaticItem.Z); - FStream.WriteWord(AStaticItem.TileID); - FStream.WriteWord(AStaticItem.Hue); -end; - -{ TInsertStaticPacket } - -constructor TInsertStaticPacket.Create(AX, AY: Word; AZ: ShortInt; - ATileID: Word; AHue: Word); -begin - inherited Create($07, 10); - FStream.WriteWord(AX); - FStream.WriteWord(AY); - FStream.WriteShortInt(AZ); - FStream.WriteWord(ATileID); - FStream.WriteWord(AHue); -end; - -{ TDeleteStaticPacket } - -constructor TDeleteStaticPacket.Create(AStaticItem: TStaticItem); -begin - inherited Create($08, 10); - WriteStaticItem(AStaticItem); -end; - -{ TElevateStaticPacket } - -constructor TElevateStaticPacket.Create(AStaticItem: TStaticItem; ANewZ: ShortInt); -begin - inherited Create($09, 11); - WriteStaticItem(AStaticItem); - FStream.WriteShortInt(ANewZ); -end; - -constructor TElevateStaticPacket.Create(AX, AY: Word; AZ: ShortInt; - ATileID: Word; AHue: Word; ANewZ: Word); -begin - inherited Create($09, 11); - FStream.WriteWord(AX); - FStream.WriteWord(AY); - FStream.WriteShortInt(AZ); - FStream.WriteWord(ATileID); - FStream.WriteWord(AHue); - FStream.WriteShortInt(ANewZ); -end; - -{ TMoveStaticPacket } - -constructor TMoveStaticPacket.Create(AStaticItem: TStaticItem; ANewX, - ANewY: Word); -begin - inherited Create($0A, 14); - WriteStaticItem(AStaticItem); - FStream.WriteWord(ANewX); - FStream.WriteWord(ANewY); -end; - -constructor TMoveStaticPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; - AHue: Word; ANewX, ANewY: Word); -begin - inherited Create($0A, 14); - FStream.WriteWord(AX); - FStream.WriteWord(AY); - FStream.WriteShortInt(AZ); - FStream.WriteWord(ATileID); - FStream.WriteWord(AHue); - FStream.WriteWord(ANewX); - FStream.WriteWord(ANewY); -end; - -{ THueStaticPacket } - -constructor THueStaticPacket.Create(AStaticItem: TStaticItem; ANewHue: Word); -begin - inherited Create($0B, 12); - WriteStaticItem(AStaticItem); - FStream.WriteWord(ANewHue); -end; - -constructor THueStaticPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; - AHue: Word; ANewHue: Word); -begin - inherited Create($0B, 12); - FStream.WriteWord(AX); - FStream.WriteWord(AY); - FStream.WriteShortInt(AZ); - FStream.WriteWord(ATileID); - FStream.WriteWord(AHue); - FStream.WriteWord(ANewHue); -end; - -{ TUpdateClientPosPacket } - -constructor TUpdateClientPosPacket.Create(AX, AY: Word); -begin - inherited Create($0C, 0); - FStream.WriteByte($04); - FStream.WriteWord(AX); - FStream.WriteWord(AY); -end; - -{ TChatMessagePacket } - -constructor TChatMessagePacket.Create(AMessage: string); -begin - inherited Create($0C, 0); - FStream.WriteByte($05); - FStream.WriteStringNull(AMessage); -end; - -{ TGotoClientPosPacket } - -constructor TGotoClientPosPacket.Create(AUsername: string); -begin - inherited Create($0C, 0); - FStream.WriteByte($06); - FStream.WriteStringNull(AUsername); -end; - -{ TRequestRadarChecksumPacket } - -constructor TRequestRadarChecksumPacket.Create; -begin - inherited Create($0D, 2); - FStream.WriteByte($01); -end; - -{ TRequestRadarMapPacket } - -constructor TRequestRadarMapPacket.Create; -begin - inherited Create($0D, 2); - FStream.WriteByte($02); -end; - -{ TNoOpPacket } - -constructor TNoOpPacket.Create; -begin - inherited Create($FF, 1); -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2009 Andreas Schneider + *) +unit UPackets; + +interface + +uses + Classes, dzlib, UEnhancedMemoryStream, UPacket, UStatics; + +type + TBlockCoords = packed record + X: Word; + Y: Word; + end; + TBlockCoordsArray = array of TBlockCoords; + + { TCompressedPacket } + + TCompressedPacket = class(TPacket) + constructor Create(APacket: TPacket); + end; + + { TLoginRequestPacket } + + TLoginRequestPacket = class(TPacket) + constructor Create(AUsername, APassword: string); + end; + + { TQuitPacket } + + TQuitPacket = class(TPacket) + constructor Create; + end; + + { TRequestBlocksPacket } + + TRequestBlocksPacket = class(TPacket) + constructor Create(ACoords: TBlockCoordsArray); + end; + + { TFreeBlockPacket } + + TFreeBlockPacket = class(TPacket) + constructor Create(AX, AY: Word); + end; + + { TDrawMapPacket } + + TDrawMapPacket = class(TPacket) + constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word); + end; + + { TStaticPacket } + + TStaticPacket = class(TPacket) + protected + procedure WriteStaticItem(AStaticItem: TStaticItem); + end; + + { TInsertStaticPacket } + + TInsertStaticPacket = class(TPacket) + constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word); + end; + + { TDeleteStaticPacket } + + TDeleteStaticPacket = class(TStaticPacket) + constructor Create(AStaticItem: TStaticItem); + end; + + { TElevateStaticPacket } + + TElevateStaticPacket = class(TStaticPacket) + constructor Create(AStaticItem: TStaticItem; ANewZ: ShortInt); + constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word; + ANewZ: Word); + end; + + { TMoveStaticPacket } + + TMoveStaticPacket = class(TStaticPacket) + constructor Create(AStaticItem: TStaticItem; ANewX, ANewY: Word); + constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word; + ANewX, ANewY: Word); + end; + + { THueStaticPacket } + + THueStaticPacket = class(TStaticPacket) + constructor Create(AStaticItem: TStaticItem; ANewHue: Word); + constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word; + ANewHue: Word); + end; + + { TUpdateClientPosPacket } + + TUpdateClientPosPacket = class(TPacket) + constructor Create(AX, AY: Word); + end; + + { TChatMessagePacket } + + TChatMessagePacket = class(TPacket) + constructor Create(AMessage: string); + end; + + { TGotoClientPosPacket } + + TGotoClientPosPacket = class(TPacket) + constructor Create(AUsername: string); + end; + + { TRequestRadarChecksumPacket } + + TRequestRadarChecksumPacket = class(TPacket) + constructor Create; + end; + + { TRequestRadarMapPacket } + + TRequestRadarMapPacket = class(TPacket) + constructor Create; + end; + + { TNoOpPacket } + + TNoOpPacket = class(TPacket) + constructor Create; + end; + +implementation + +{ TCompressedPacket } + +constructor TCompressedPacket.Create(APacket: TPacket); +var + compBuffer: TEnhancedMemoryStream; + compStream: TCompressionStream; + sourceStream: TStream; +begin + inherited Create($01, 0); + compBuffer := TEnhancedMemoryStream.Create; + compStream := TCompressionStream.Create(clMax, compBuffer); + sourceStream := APacket.Stream; + compStream.CopyFrom(sourceStream, 0); + compStream.Free; + FStream.WriteCardinal(sourceStream.Size); + FStream.CopyFrom(compBuffer, 0); + compBuffer.Free; + APacket.Free; +end; + +{ TLoginRequestPacket } + +constructor TLoginRequestPacket.Create(AUsername, APassword: string); +begin + inherited Create($02, 0); + FStream.WriteByte($03); + FStream.WriteStringNull(AUsername); + FStream.WriteStringNull(APassword); +end; + +{ TQuitPacket } + +constructor TQuitPacket.Create; +begin + inherited Create($02, 0); + FStream.WriteByte($05); +end; + +{ TRequestBlocksPacket } + +constructor TRequestBlocksPacket.Create(ACoords: TBlockCoordsArray); +begin + inherited Create($04, 0); + FStream.Write(ACoords[0], Length(ACoords) * SizeOf(TBlockCoords)); +end; + +{ TFreeBlockPacket } + +constructor TFreeBlockPacket.Create(AX, AY: Word); +begin + inherited Create($05, 5); + FStream.WriteWord(AX); + FStream.WriteWord(AY); +end; + +{ TDrawMapPacket } + +constructor TDrawMapPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word); +begin + inherited Create($06, 8); + FStream.WriteWord(AX); + FStream.WriteWord(AY); + FStream.WriteShortInt(AZ); + FStream.WriteWord(ATileID); +end; + +{ TStaticPacket } + +procedure TStaticPacket.WriteStaticItem(AStaticItem: TStaticItem); +begin + FStream.WriteWord(AStaticItem.X); + FStream.WriteWord(AStaticItem.Y); + FStream.WriteShortInt(AStaticItem.Z); + FStream.WriteWord(AStaticItem.TileID); + FStream.WriteWord(AStaticItem.Hue); +end; + +{ TInsertStaticPacket } + +constructor TInsertStaticPacket.Create(AX, AY: Word; AZ: ShortInt; + ATileID: Word; AHue: Word); +begin + inherited Create($07, 10); + FStream.WriteWord(AX); + FStream.WriteWord(AY); + FStream.WriteShortInt(AZ); + FStream.WriteWord(ATileID); + FStream.WriteWord(AHue); +end; + +{ TDeleteStaticPacket } + +constructor TDeleteStaticPacket.Create(AStaticItem: TStaticItem); +begin + inherited Create($08, 10); + WriteStaticItem(AStaticItem); +end; + +{ TElevateStaticPacket } + +constructor TElevateStaticPacket.Create(AStaticItem: TStaticItem; ANewZ: ShortInt); +begin + inherited Create($09, 11); + WriteStaticItem(AStaticItem); + FStream.WriteShortInt(ANewZ); +end; + +constructor TElevateStaticPacket.Create(AX, AY: Word; AZ: ShortInt; + ATileID: Word; AHue: Word; ANewZ: Word); +begin + inherited Create($09, 11); + FStream.WriteWord(AX); + FStream.WriteWord(AY); + FStream.WriteShortInt(AZ); + FStream.WriteWord(ATileID); + FStream.WriteWord(AHue); + FStream.WriteShortInt(ANewZ); +end; + +{ TMoveStaticPacket } + +constructor TMoveStaticPacket.Create(AStaticItem: TStaticItem; ANewX, + ANewY: Word); +begin + inherited Create($0A, 14); + WriteStaticItem(AStaticItem); + FStream.WriteWord(ANewX); + FStream.WriteWord(ANewY); +end; + +constructor TMoveStaticPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; + AHue: Word; ANewX, ANewY: Word); +begin + inherited Create($0A, 14); + FStream.WriteWord(AX); + FStream.WriteWord(AY); + FStream.WriteShortInt(AZ); + FStream.WriteWord(ATileID); + FStream.WriteWord(AHue); + FStream.WriteWord(ANewX); + FStream.WriteWord(ANewY); +end; + +{ THueStaticPacket } + +constructor THueStaticPacket.Create(AStaticItem: TStaticItem; ANewHue: Word); +begin + inherited Create($0B, 12); + WriteStaticItem(AStaticItem); + FStream.WriteWord(ANewHue); +end; + +constructor THueStaticPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; + AHue: Word; ANewHue: Word); +begin + inherited Create($0B, 12); + FStream.WriteWord(AX); + FStream.WriteWord(AY); + FStream.WriteShortInt(AZ); + FStream.WriteWord(ATileID); + FStream.WriteWord(AHue); + FStream.WriteWord(ANewHue); +end; + +{ TUpdateClientPosPacket } + +constructor TUpdateClientPosPacket.Create(AX, AY: Word); +begin + inherited Create($0C, 0); + FStream.WriteByte($04); + FStream.WriteWord(AX); + FStream.WriteWord(AY); +end; + +{ TChatMessagePacket } + +constructor TChatMessagePacket.Create(AMessage: string); +begin + inherited Create($0C, 0); + FStream.WriteByte($05); + FStream.WriteStringNull(AMessage); +end; + +{ TGotoClientPosPacket } + +constructor TGotoClientPosPacket.Create(AUsername: string); +begin + inherited Create($0C, 0); + FStream.WriteByte($06); + FStream.WriteStringNull(AUsername); +end; + +{ TRequestRadarChecksumPacket } + +constructor TRequestRadarChecksumPacket.Create; +begin + inherited Create($0D, 2); + FStream.WriteByte($01); +end; + +{ TRequestRadarMapPacket } + +constructor TRequestRadarMapPacket.Create; +begin + inherited Create($0D, 2); + FStream.WriteByte($02); +end; + +{ TNoOpPacket } + +constructor TNoOpPacket.Create; +begin + inherited Create($FF, 1); +end; + +end. + diff --git a/Client/UResourceManager.pas b/Client/UResourceManager.pas index 59c8e60..9857dbd 100644 --- a/Client/UResourceManager.pas +++ b/Client/UResourceManager.pas @@ -1,105 +1,105 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2009 Andreas Schneider - *) -unit UResourceManager; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils; - -type - - { TResourceManager } - - TResourceManager = class - constructor Create(AFileName: string); - destructor Destroy; override; - protected - FFileStream: TFileStream; - FCount: Integer; - FLookupTable: array of Cardinal; - FCurrentResource: Integer; - FResourceStream: TMemoryStream; - public - function GetResource(AIndex: Integer): TStream; - end; - -var - ResourceManager: TResourceManager; - -implementation - -{ TResourceManager } - -constructor TResourceManager.Create(AFileName: string); -begin - inherited Create; - FFileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite); - FFileStream.Position := 0; - FFileStream.Read(FCount, SizeOf(Integer)); - SetLength(FLookupTable, FCount); - FFileStream.Read(FLookupTable[0], FCount * SizeOf(Cardinal)); - FCurrentResource := -1; -end; - -destructor TResourceManager.Destroy; -begin - FreeAndNil(FFileStream); - FreeAndNil(FResourceStream); - inherited Destroy; -end; - -function TResourceManager.GetResource(AIndex: Integer): TStream; -var - size: Cardinal; -begin - if AIndex <> FCurrentResource then - begin - FFileStream.Position := FLookupTable[AIndex]; - FResourceStream.Free; - FResourceStream := TMemoryStream.Create; - FFileStream.Read(size, SizeOf(Cardinal)); - FResourceStream.CopyFrom(FFileStream, size); - FCurrentResource := AIndex; - end; - FResourceStream.Position := 0; - Result := FResourceStream; -end; - -initialization -begin - ResourceManager := TResourceManager.Create(ChangeFileExt(ParamStr(0), '.dat')); -end; - -finalization -begin - if ResourceManager <> nil then FreeAndNil(ResourceManager); -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2009 Andreas Schneider + *) +unit UResourceManager; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +type + + { TResourceManager } + + TResourceManager = class + constructor Create(AFileName: string); + destructor Destroy; override; + protected + FFileStream: TFileStream; + FCount: Integer; + FLookupTable: array of Cardinal; + FCurrentResource: Integer; + FResourceStream: TMemoryStream; + public + function GetResource(AIndex: Integer): TStream; + end; + +var + ResourceManager: TResourceManager; + +implementation + +{ TResourceManager } + +constructor TResourceManager.Create(AFileName: string); +begin + inherited Create; + FFileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite); + FFileStream.Position := 0; + FFileStream.Read(FCount, SizeOf(Integer)); + SetLength(FLookupTable, FCount); + FFileStream.Read(FLookupTable[0], FCount * SizeOf(Cardinal)); + FCurrentResource := -1; +end; + +destructor TResourceManager.Destroy; +begin + FreeAndNil(FFileStream); + FreeAndNil(FResourceStream); + inherited Destroy; +end; + +function TResourceManager.GetResource(AIndex: Integer): TStream; +var + size: Cardinal; +begin + if AIndex <> FCurrentResource then + begin + FFileStream.Position := FLookupTable[AIndex]; + FResourceStream.Free; + FResourceStream := TMemoryStream.Create; + FFileStream.Read(size, SizeOf(Cardinal)); + FResourceStream.CopyFrom(FFileStream, size); + FCurrentResource := AIndex; + end; + FResourceStream.Position := 0; + Result := FResourceStream; +end; + +initialization +begin + ResourceManager := TResourceManager.Create(ChangeFileExt(ParamStr(0), '.dat')); +end; + +finalization +begin + if ResourceManager <> nil then FreeAndNil(ResourceManager); +end; + +end. + diff --git a/Client/UdmNetwork.pas b/Client/UdmNetwork.pas index a983e73..0f5110c 100644 --- a/Client/UdmNetwork.pas +++ b/Client/UdmNetwork.pas @@ -1,371 +1,371 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2009 Andreas Schneider - *) -unit UdmNetwork; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, LResources, Forms, Controls, Dialogs, lNetComponents, lNet, - UEnhancedMemoryStream, UPacket, UEnums, ExtCtrls, dateutils; - -type - - { TdmNetwork } - - TdmNetwork = class(TDataModule) - TCPClient: TLTCPComponent; - tmNoOp: TTimer; - procedure DataModuleCreate(Sender: TObject); - procedure DataModuleDestroy(Sender: TObject); - procedure TCPClientConnect(aSocket: TLSocket); - procedure TCPClientDisconnect(aSocket: TLSocket); - procedure TCPClientError(const msg: string; aSocket: TLSocket); - procedure TCPClientReceive(aSocket: TLSocket); - procedure tmNoOpStartTimer(Sender: TObject); - procedure tmNoOpTimer(Sender: TObject); - protected - FSendQueue: TEnhancedMemoryStream; - FReceiveQueue: TEnhancedMemoryStream; - FUsername: string; - FPassword: string; - FAccessLevel: TAccessLevel; - FDataDir: string; - FLastPacket: TDateTime; - procedure OnCanSend(ASocket: TLSocket); - procedure OnConnectionHandlingPacket(ABuffer: TEnhancedMemoryStream); - procedure ProcessQueue; - procedure DoLogin; - public - property Username: string read FUsername; - property AccessLevel: TAccessLevel read FAccessLevel write FAccessLevel; - procedure Send(APacket: TPacket); - procedure Disconnect; - procedure CheckClose(ASender: TForm); - end; - -var - dmNetwork: TdmNetwork; - -implementation - -uses - UPacketHandlers, UPackets, UfrmMain, UfrmLogin, UfrmInitialize, - UGameResources, UfrmAccountControl, UfrmEditAccount, UfrmDrawSettings, - UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings, - UfrmAbout, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand, - UfrmVirtualLayer, UfrmFilter, UfrmRegionControl, UfrmLightlevel; - -{$I version.inc} - -{ TdmNetwork } - -procedure TdmNetwork.DataModuleCreate(Sender: TObject); -begin - FSendQueue := TEnhancedMemoryStream.Create; - FReceiveQueue := TEnhancedMemoryStream.Create; - TCPClient.OnCanSend := @OnCanSend; - PacketHandlers[$02] := TPacketHandler.Create(0, @OnConnectionHandlingPacket); - DoLogin; -end; - -procedure TdmNetwork.DataModuleDestroy(Sender: TObject); -begin - FreeAndNil(FSendQueue); - FreeAndNil(FReceiveQueue); - FreeAndNil(PacketHandlers[$02]); -end; - -procedure TdmNetwork.TCPClientConnect(aSocket: TLSocket); -begin - FSendQueue.Clear; - FReceiveQueue.Clear; -end; - -procedure TdmNetwork.TCPClientDisconnect(aSocket: TLSocket); -begin - FSendQueue.Clear; - FReceiveQueue.Clear; - DoLogin; -end; - -procedure TdmNetwork.TCPClientError(const msg: string; aSocket: TLSocket); -begin - MessageDlg('Connection error', msg, mtError, [mbOK], 0); - if not TCPClient.Connected then - TCPClientDisconnect(aSocket); -end; - -procedure TdmNetwork.TCPClientReceive(aSocket: TLSocket); -var - buffer: array[0..4095] of byte; - size: Integer; -begin - repeat - size := TCPClient.Get(buffer, 4096); - if size > 0 then - FReceiveQueue.Enqueue(buffer, size); - until size <= 0; - ProcessQueue; -end; - -procedure TdmNetwork.tmNoOpStartTimer(Sender: TObject); -begin - FLastPacket := Now; -end; - -procedure TdmNetwork.tmNoOpTimer(Sender: TObject); -begin - if SecondsBetween(FLastPacket, Now) > 25 then - Send(TNoOpPacket.Create); -end; - -procedure TdmNetwork.OnCanSend(ASocket: TLSocket); -var - size: Integer; -begin - while FSendQueue.Size > 0 do - begin - FLastPacket := Now; - size := TCPClient.Send(FSendQueue.Memory^, FSendQueue.Size); - if size > 0 then - FSendQueue.Dequeue(size) - else - Break; - end; -end; - -procedure TdmNetwork.OnConnectionHandlingPacket(ABuffer: TEnhancedMemoryStream); -var - subID: Byte; - loginState: TLoginState; - width, height: Word; - serverState: TServerState; -begin - subID := ABuffer.ReadByte; - case subID of - $01: - begin - if ABuffer.ReadCardinal = ProtocolVersion then - begin - frmInitialize.lblStatus.Caption := 'Authenticating'; - Send(TLoginRequestPacket.Create(FUsername, FPassword)); - end else - begin - MessageDlg('Error', 'Invalid protocol version. Maybe your client is outdated.', mtError, [mbOK], 0); - Disconnect; - end; - end; - $03: - begin - loginState := TLoginState(ABuffer.ReadByte); - if loginState = lsOK then - begin - frmInitialize.lblStatus.Caption := 'Initializing'; - frmInitialize.Repaint; - frmInitialize.lblStatus.Repaint; - Application.ProcessMessages; - FAccessLevel := TAccessLevel(ABuffer.ReadByte); - InitGameResourceManager(FDataDir); - width := ABuffer.ReadWord; - height := ABuffer.ReadWord; - ResMan.InitLandscape(width, height); - ResMan.Landscape.UpdateWriteMap(ABuffer); - - frmMain := TfrmMain.Create(dmNetwork); - frmRadarMap := TfrmRadarMap.Create(frmMain); - frmLargeScaleCommand := TfrmLargeScaleCommand.Create(frmMain); - frmRegionControl := TfrmRegionControl.Create(frmMain); - frmAccountControl := TfrmAccountControl.Create(frmMain); - frmEditAccount := TfrmEditAccount.Create(frmAccountControl); - frmConfirmation := TfrmConfirmation.Create(frmMain); - frmDrawSettings := TfrmDrawSettings.Create(frmMain); - frmMoveSettings := TfrmMoveSettings.Create(frmMain); - frmElevateSettings := TfrmElevateSettings.Create(frmMain); - frmHueSettings := TfrmHueSettings.Create(frmMain); - frmBoundaries := TfrmBoundaries.Create(frmMain); - frmFilter := TfrmFilter.Create(frmMain); - frmVirtualLayer := TfrmVirtualLayer.Create(frmMain); - frmLightlevel := TfrmLightlevel.Create(frmMain); - frmAbout := TfrmAbout.Create(frmMain); - frmMain.Show; - frmInitialize.Hide; - tmNoOp.Enabled := True; - end else - begin - if loginState = lsInvalidUser then - MessageDlg('Error', 'The username you specified is incorrect.', mtWarning, [mbOK], 0) - else if loginState = lsInvalidPassword then - MessageDlg('Error', 'The password you specified is incorrect.', mtWarning, [mbOK], 0) - else if loginState = lsAlreadyLoggedIn then - MessageDlg('Error', 'There is already a client logged in using that account.', mtWarning, [mbOK], 0) - else if loginState = lsNoAccess then - MessageDlg('Error', 'This account has no access.', mtWarning, [mbOK], 0); - end; - end; - $04: //Server state - begin - serverState := TServerState(ABuffer.ReadByte); - if serverState = ssRunning then - begin - frmInitialize.UnsetModal; - frmInitialize.Hide; - tmNoOp.Enabled := True; - end else - begin - case serverState of - ssFrozen: frmInitialize.lblStatus.Caption := 'The server is currently paused.'; - ssOther: frmInitialize.lblStatus.Caption := ABuffer.ReadStringNull - end; - tmNoOp.Enabled := False; - frmInitialize.Show; - frmInitialize.SetModal; - end; - end; - end; -end; - -procedure TdmNetwork.ProcessQueue; -var - packetHandler: TPacketHandler; - size: Cardinal; -begin - FReceiveQueue.Position := 0; - while FReceiveQueue.Size >= 1 do - begin - packetHandler := PacketHandlers[FReceiveQueue.ReadByte]; - if packetHandler <> nil then - begin - size := packetHandler.PacketLength; - if size = 0 then - begin - if FReceiveQueue.Size > 5 then - size := FReceiveQueue.ReadCardinal - else - Break; //wait for more data - end; - - if FReceiveQueue.Size >= size then - begin - FReceiveQueue.Lock(FReceiveQueue.Position, size - FReceiveQueue.Position); //prevent handler from reading too much - packetHandler.Process(FReceiveQueue); - FReceiveQueue.Unlock; - FReceiveQueue.Dequeue(size); - end else - Break; //wait for more data - end else - begin - {Writeln('Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress);} - Disconnect; - FReceiveQueue.Clear; - end; - end; -end; - -procedure TdmNetwork.DoLogin; -begin - tmNoOp.Enabled := False; - frmLogin := TfrmLogin.Create(dmNetwork); - if frmInitialize = nil then - frmInitialize := TfrmInitialize.Create(dmNetwork); - - FreeAndNil(frmEditAccount); - FreeAndNil(frmAccountControl); - FreeAndNil(frmConfirmation); - FreeAndNil(frmDrawSettings); - FreeAndNil(frmMoveSettings); - FreeAndNil(frmElevateSettings); - FreeAndNil(frmHueSettings); - FreeAndNil(frmBoundaries); - FreeAndNil(frmFilter); - FreeAndNil(frmVirtualLayer); - FreeAndNil(frmAbout); - FreeAndNil(frmRegionControl); - FreeAndNil(frmLargeScaleCommand); - FreeAndNil(frmRadarMap); - FreeAndNil(frmLightlevel); - - if frmMain <> nil then - begin - frmMain.ApplicationProperties1.OnIdle := nil; - FreeAndNil(frmMain); - end; - - FreeAndNil(GameResourceManager); - - frmInitialize.Hide; - while frmLogin.ShowModal = mrOK do - begin - if TCPClient.Connect(frmLogin.edHost.Text, frmLogin.edPort.Value) then - begin - FUsername := frmLogin.edUsername.Text; - FPassword := frmLogin.edPassword.Text; - FDataDir := frmLogin.edData.Text; - frmInitialize.lblStatus.Caption := 'Connecting'; - frmInitialize.Show; - Break; - end else - MessageDlg('Error', 'Cannot connect to the specified server.', mtError, [mbOK], 0); - end; - frmLogin.Close; - FreeAndNil(frmLogin); -end; - -procedure TdmNetwork.Send(APacket: TPacket); -var - source: TEnhancedMemoryStream; -begin - if TCPClient.Connected then - begin - FSendQueue.Seek(0, soFromEnd); - source := APacket.Stream; - FSendQueue.CopyFrom(source, 0); - OnCanSend(nil); - end; - APacket.Free; -end; - -procedure TdmNetwork.Disconnect; -begin - Send(TQuitPacket.Create); -end; - -procedure TdmNetwork.CheckClose(ASender: TForm); -begin - if ((frmLogin = nil) or (ASender = frmLogin)) and - ((frmMain = nil) or (ASender = frmMain)) and - ((frmInitialize = nil) or (not frmInitialize.Visible)) then - begin - Application.Terminate; - end; -end; - -initialization - {$I UdmNetwork.lrs} - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2009 Andreas Schneider + *) +unit UdmNetwork; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Dialogs, lNetComponents, lNet, + UEnhancedMemoryStream, UPacket, UEnums, ExtCtrls, dateutils; + +type + + { TdmNetwork } + + TdmNetwork = class(TDataModule) + TCPClient: TLTCPComponent; + tmNoOp: TTimer; + procedure DataModuleCreate(Sender: TObject); + procedure DataModuleDestroy(Sender: TObject); + procedure TCPClientConnect(aSocket: TLSocket); + procedure TCPClientDisconnect(aSocket: TLSocket); + procedure TCPClientError(const msg: string; aSocket: TLSocket); + procedure TCPClientReceive(aSocket: TLSocket); + procedure tmNoOpStartTimer(Sender: TObject); + procedure tmNoOpTimer(Sender: TObject); + protected + FSendQueue: TEnhancedMemoryStream; + FReceiveQueue: TEnhancedMemoryStream; + FUsername: string; + FPassword: string; + FAccessLevel: TAccessLevel; + FDataDir: string; + FLastPacket: TDateTime; + procedure OnCanSend(ASocket: TLSocket); + procedure OnConnectionHandlingPacket(ABuffer: TEnhancedMemoryStream); + procedure ProcessQueue; + procedure DoLogin; + public + property Username: string read FUsername; + property AccessLevel: TAccessLevel read FAccessLevel write FAccessLevel; + procedure Send(APacket: TPacket); + procedure Disconnect; + procedure CheckClose(ASender: TForm); + end; + +var + dmNetwork: TdmNetwork; + +implementation + +uses + UPacketHandlers, UPackets, UfrmMain, UfrmLogin, UfrmInitialize, + UGameResources, UfrmAccountControl, UfrmEditAccount, UfrmDrawSettings, + UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings, + UfrmAbout, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand, + UfrmVirtualLayer, UfrmFilter, UfrmRegionControl, UfrmLightlevel; + +{$I version.inc} + +{ TdmNetwork } + +procedure TdmNetwork.DataModuleCreate(Sender: TObject); +begin + FSendQueue := TEnhancedMemoryStream.Create; + FReceiveQueue := TEnhancedMemoryStream.Create; + TCPClient.OnCanSend := @OnCanSend; + PacketHandlers[$02] := TPacketHandler.Create(0, @OnConnectionHandlingPacket); + DoLogin; +end; + +procedure TdmNetwork.DataModuleDestroy(Sender: TObject); +begin + FreeAndNil(FSendQueue); + FreeAndNil(FReceiveQueue); + FreeAndNil(PacketHandlers[$02]); +end; + +procedure TdmNetwork.TCPClientConnect(aSocket: TLSocket); +begin + FSendQueue.Clear; + FReceiveQueue.Clear; +end; + +procedure TdmNetwork.TCPClientDisconnect(aSocket: TLSocket); +begin + FSendQueue.Clear; + FReceiveQueue.Clear; + DoLogin; +end; + +procedure TdmNetwork.TCPClientError(const msg: string; aSocket: TLSocket); +begin + MessageDlg('Connection error', msg, mtError, [mbOK], 0); + if not TCPClient.Connected then + TCPClientDisconnect(aSocket); +end; + +procedure TdmNetwork.TCPClientReceive(aSocket: TLSocket); +var + buffer: array[0..4095] of byte; + size: Integer; +begin + repeat + size := TCPClient.Get(buffer, 4096); + if size > 0 then + FReceiveQueue.Enqueue(buffer, size); + until size <= 0; + ProcessQueue; +end; + +procedure TdmNetwork.tmNoOpStartTimer(Sender: TObject); +begin + FLastPacket := Now; +end; + +procedure TdmNetwork.tmNoOpTimer(Sender: TObject); +begin + if SecondsBetween(FLastPacket, Now) > 25 then + Send(TNoOpPacket.Create); +end; + +procedure TdmNetwork.OnCanSend(ASocket: TLSocket); +var + size: Integer; +begin + while FSendQueue.Size > 0 do + begin + FLastPacket := Now; + size := TCPClient.Send(FSendQueue.Memory^, FSendQueue.Size); + if size > 0 then + FSendQueue.Dequeue(size) + else + Break; + end; +end; + +procedure TdmNetwork.OnConnectionHandlingPacket(ABuffer: TEnhancedMemoryStream); +var + subID: Byte; + loginState: TLoginState; + width, height: Word; + serverState: TServerState; +begin + subID := ABuffer.ReadByte; + case subID of + $01: + begin + if ABuffer.ReadCardinal = ProtocolVersion then + begin + frmInitialize.lblStatus.Caption := 'Authenticating'; + Send(TLoginRequestPacket.Create(FUsername, FPassword)); + end else + begin + MessageDlg('Error', 'Invalid protocol version. Maybe your client is outdated.', mtError, [mbOK], 0); + Disconnect; + end; + end; + $03: + begin + loginState := TLoginState(ABuffer.ReadByte); + if loginState = lsOK then + begin + frmInitialize.lblStatus.Caption := 'Initializing'; + frmInitialize.Repaint; + frmInitialize.lblStatus.Repaint; + Application.ProcessMessages; + FAccessLevel := TAccessLevel(ABuffer.ReadByte); + InitGameResourceManager(FDataDir); + width := ABuffer.ReadWord; + height := ABuffer.ReadWord; + ResMan.InitLandscape(width, height); + ResMan.Landscape.UpdateWriteMap(ABuffer); + + frmMain := TfrmMain.Create(dmNetwork); + frmRadarMap := TfrmRadarMap.Create(frmMain); + frmLargeScaleCommand := TfrmLargeScaleCommand.Create(frmMain); + frmRegionControl := TfrmRegionControl.Create(frmMain); + frmAccountControl := TfrmAccountControl.Create(frmMain); + frmEditAccount := TfrmEditAccount.Create(frmAccountControl); + frmConfirmation := TfrmConfirmation.Create(frmMain); + frmDrawSettings := TfrmDrawSettings.Create(frmMain); + frmMoveSettings := TfrmMoveSettings.Create(frmMain); + frmElevateSettings := TfrmElevateSettings.Create(frmMain); + frmHueSettings := TfrmHueSettings.Create(frmMain); + frmBoundaries := TfrmBoundaries.Create(frmMain); + frmFilter := TfrmFilter.Create(frmMain); + frmVirtualLayer := TfrmVirtualLayer.Create(frmMain); + frmLightlevel := TfrmLightlevel.Create(frmMain); + frmAbout := TfrmAbout.Create(frmMain); + frmMain.Show; + frmInitialize.Hide; + tmNoOp.Enabled := True; + end else + begin + if loginState = lsInvalidUser then + MessageDlg('Error', 'The username you specified is incorrect.', mtWarning, [mbOK], 0) + else if loginState = lsInvalidPassword then + MessageDlg('Error', 'The password you specified is incorrect.', mtWarning, [mbOK], 0) + else if loginState = lsAlreadyLoggedIn then + MessageDlg('Error', 'There is already a client logged in using that account.', mtWarning, [mbOK], 0) + else if loginState = lsNoAccess then + MessageDlg('Error', 'This account has no access.', mtWarning, [mbOK], 0); + end; + end; + $04: //Server state + begin + serverState := TServerState(ABuffer.ReadByte); + if serverState = ssRunning then + begin + frmInitialize.UnsetModal; + frmInitialize.Hide; + tmNoOp.Enabled := True; + end else + begin + case serverState of + ssFrozen: frmInitialize.lblStatus.Caption := 'The server is currently paused.'; + ssOther: frmInitialize.lblStatus.Caption := ABuffer.ReadStringNull + end; + tmNoOp.Enabled := False; + frmInitialize.Show; + frmInitialize.SetModal; + end; + end; + end; +end; + +procedure TdmNetwork.ProcessQueue; +var + packetHandler: TPacketHandler; + size: Cardinal; +begin + FReceiveQueue.Position := 0; + while FReceiveQueue.Size >= 1 do + begin + packetHandler := PacketHandlers[FReceiveQueue.ReadByte]; + if packetHandler <> nil then + begin + size := packetHandler.PacketLength; + if size = 0 then + begin + if FReceiveQueue.Size > 5 then + size := FReceiveQueue.ReadCardinal + else + Break; //wait for more data + end; + + if FReceiveQueue.Size >= size then + begin + FReceiveQueue.Lock(FReceiveQueue.Position, size - FReceiveQueue.Position); //prevent handler from reading too much + packetHandler.Process(FReceiveQueue); + FReceiveQueue.Unlock; + FReceiveQueue.Dequeue(size); + end else + Break; //wait for more data + end else + begin + {Writeln('Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress);} + Disconnect; + FReceiveQueue.Clear; + end; + end; +end; + +procedure TdmNetwork.DoLogin; +begin + tmNoOp.Enabled := False; + frmLogin := TfrmLogin.Create(dmNetwork); + if frmInitialize = nil then + frmInitialize := TfrmInitialize.Create(dmNetwork); + + FreeAndNil(frmEditAccount); + FreeAndNil(frmAccountControl); + FreeAndNil(frmConfirmation); + FreeAndNil(frmDrawSettings); + FreeAndNil(frmMoveSettings); + FreeAndNil(frmElevateSettings); + FreeAndNil(frmHueSettings); + FreeAndNil(frmBoundaries); + FreeAndNil(frmFilter); + FreeAndNil(frmVirtualLayer); + FreeAndNil(frmAbout); + FreeAndNil(frmRegionControl); + FreeAndNil(frmLargeScaleCommand); + FreeAndNil(frmRadarMap); + FreeAndNil(frmLightlevel); + + if frmMain <> nil then + begin + frmMain.ApplicationProperties1.OnIdle := nil; + FreeAndNil(frmMain); + end; + + FreeAndNil(GameResourceManager); + + frmInitialize.Hide; + while frmLogin.ShowModal = mrOK do + begin + if TCPClient.Connect(frmLogin.edHost.Text, frmLogin.edPort.Value) then + begin + FUsername := frmLogin.edUsername.Text; + FPassword := frmLogin.edPassword.Text; + FDataDir := frmLogin.edData.Text; + frmInitialize.lblStatus.Caption := 'Connecting'; + frmInitialize.Show; + Break; + end else + MessageDlg('Error', 'Cannot connect to the specified server.', mtError, [mbOK], 0); + end; + frmLogin.Close; + FreeAndNil(frmLogin); +end; + +procedure TdmNetwork.Send(APacket: TPacket); +var + source: TEnhancedMemoryStream; +begin + if TCPClient.Connected then + begin + FSendQueue.Seek(0, soFromEnd); + source := APacket.Stream; + FSendQueue.CopyFrom(source, 0); + OnCanSend(nil); + end; + APacket.Free; +end; + +procedure TdmNetwork.Disconnect; +begin + Send(TQuitPacket.Create); +end; + +procedure TdmNetwork.CheckClose(ASender: TForm); +begin + if ((frmLogin = nil) or (ASender = frmLogin)) and + ((frmMain = nil) or (ASender = frmMain)) and + ((frmInitialize = nil) or (not frmInitialize.Visible)) then + begin + Application.Terminate; + end; +end; + +initialization + {$I UdmNetwork.lrs} + +end. + diff --git a/Client/UfrmAccountControl.lfm b/Client/UfrmAccountControl.lfm index 6a18568..094889c 100644 --- a/Client/UfrmAccountControl.lfm +++ b/Client/UfrmAccountControl.lfm @@ -1,381 +1,381 @@ -object frmAccountControl: TfrmAccountControl - Left = 290 - Height = 378 - Top = 171 - Width = 369 - ActiveControl = vstAccounts - BorderIcons = [biSystemMenu] - BorderStyle = bsDialog - Caption = 'Account Management' - ClientHeight = 378 - ClientWidth = 369 - Font.Height = -11 - OnClose = FormClose - OnCreate = FormCreate - OnDestroy = FormDestroy - OnShow = FormShow - Position = poOwnerFormCenter - LCLVersion = '0.9.29' - object tbMain: TToolBar - Left = 0 - Height = 26 - Top = 0 - Width = 369 - Caption = 'tbMain' - Images = ilToolbar - TabOrder = 0 - object tbRefresh: TToolButton - Left = 1 - Hint = 'Refresh' - Top = 2 - Caption = 'Refresh' - ImageIndex = 0 - ParentShowHint = False - ShowHint = True - OnClick = tbRefreshClick - end - object tbAddUser: TToolButton - Left = 32 - Hint = 'Add User' - Top = 2 - Caption = 'Add User' - ImageIndex = 1 - ParentShowHint = False - ShowHint = True - OnClick = tbAddUserClick - end - object tbEditUser: TToolButton - Left = 55 - Hint = 'Edit User' - Top = 2 - Caption = 'Edit User' - ImageIndex = 2 - ParentShowHint = False - ShowHint = True - OnClick = tbEditUserClick - end - object tbDeleteUser: TToolButton - Left = 78 - Hint = 'Delete User' - Top = 2 - Caption = 'Delete User' - ImageIndex = 3 - ParentShowHint = False - ShowHint = True - OnClick = tbDeleteUserClick - end - object tbSeparator1: TToolButton - Left = 24 - Top = 2 - Width = 8 - Caption = 'tbSeparator1' - Style = tbsDivider - end - end - object vstAccounts: TVirtualStringTree - Left = 0 - Height = 352 - Top = 26 - Width = 369 - Align = alClient - DefaultText = 'Node' - Header.AutoSizeIndex = 1 - Header.Columns = < - item - Position = 0 - Width = 30 - end - item - Position = 1 - Text = 'Username' - Width = 200 - end - item - Position = 2 - Text = 'Accesslevel' - Width = 100 - end> - Header.DefaultHeight = 17 - Header.Options = [hoColumnResize, hoDrag, hoVisible] - Header.ParentFont = True - Header.Style = hsFlatButtons - Images = ilAccesslevel - TabOrder = 1 - TreeOptions.AutoOptions = [toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes] - TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning] - TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] - TreeOptions.SelectionOptions = [toFullRowSelect] - OnDblClick = vstAccountsDblClick - OnFreeNode = vstAccountsFreeNode - OnGetText = vstAccountsGetText - OnGetImageIndex = vstAccountsGetImageIndex - end - object ilToolbar: TImageList - left = 144 - Bitmap = { - 4C69040000001000000010000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000047994FFF419149FF000000000000 - 0000000000000000000000000000000000000000000000000000000000005BB4 - 65FF56AD5FFF50A65AFF4B9E53FF45964DFF60A868FF5BA262FF347E3AFF0000 - 000000000000000000000000000000000000000000005EB968FF79C383FF89CA - 92FF94D09CFF95D19EFF90CF99FF8CCB94FF87C98FFF80C487FF4E9554FF276D - 2CFF000000000000000000000000000000005CB667FF85C98EFF9BD4A4FF8FCE - 98FF92CF9AFF8DCC95FF88CA90FF83C68BFF7EC485FF79C17FFF478D4CFF2265 - 25FF0000000000000000000000000000000075BF7EFF98D2A1FF94CF9CFF86C7 - 8DFF5EA765FF398640FF347E3AFF2E7633FF49904FFF458B4AFF206324FF0000 - 000000000000000000000000000054AB5EFF80C389FF8DCC95FF83C48AFF3D8B - 44FF37833EFF000000000000000000000000236627FF1F6123FF000000000000 - 00000000000000000000000000004DA155FF47994FFF419149FF3B8842FF3580 - 3CFF000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000000000004DA155FF4799 - 4FFF419149FF3B8842FF35803CFF000000000000000000000000000000000000 - 000063C06EFF5FBB6AFF0000000000000000000000004B9E53FF45964DFF86C6 - 8EFF88C98FFF6FB376FF2E7633FF0000000000000000000000000000000062BE - 6DFF7BC785FF77C281FF54AB5EFF4EA357FF499B51FF63AC6BFF83C38BFF87C9 - 8FFF82C689FF509756FF0000000000000000000000000000000060BC6CFF79C4 - 83FF9ED7A7FF9BD4A4FF97D29FFF92CF9AFF8DCC95FF88CA90FF7AC282FF7EC4 - 85FF5DA463FF266B2AFF000000000000000000000000000000005BB465FF73BD - 7CFF96D19FFF94CF9CFF8FCD96FF8ACA91FF85C78BFF7ABE81FF65AD6CFF4B92 - 51FF246829FF0000000000000000000000000000000000000000000000004EA3 - 57FF66B06EFF61AA68FF3D8B44FF37833EFF327B37FF2C7432FF276D2CFF0000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000419149FF3B8842FF00000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000012488DFF104B90FF0F488AFF11427DFF15335BFF000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000114E96FF12589BFF125899FF115393FF0F4A87FF0E3E71FF132E4BFF0000 - 0000000000000000000000000000000000000000000000000000000000000F4B - 97FF12589FFF0F4A8AFF0F4B87FF114B87FF154C85FF124175FF0F335CFF0000 - 0000000000000000000000000000000000000000000000000000000000000C3E - 87FF7C97B8FF8AB7E4FF719CC8FF15406EFF194472FF22456BFF113B66FF0000 - 0000000000000000000000000000000000000000000000000000000000001F5E - 9BFFD9E8F7FF97C5F1FF8EBBE5FF7FA9D1FF89B5DFFFCDDFEEFF2368A7FF0000 - 0000000000000000000000000000000000000000000000000000000000002A5B - 92FFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2D629AFF0000 - 0000000000000000000000000000000000000000000000000000000000006A3C - 25FF346DA7FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF3474AEFF683E2DFF0000 - 000000000000000000000000000000000000000000000000000000000000BC48 - 1CFFF4E2D4FF4E7BA9FF4D7BA8FF4D7BA8FF4E7BA9FFF3D6C3FFBE461CFF0000 - 0000000000000000000000000000000000000000000000000000C44C1FFFF6E4 - D6FFFFE4A4FFFFD472FFFFC969FFFFC063FFFFB65FFFAEAB78FF609772FF4F8E - 66FF428357FF000000000000000000000000000000008A5444FFFCC8ABFFFFD1 - 98FFFEC76DFFFEBF68FFFEB964FFFEB15EFFA79B61FF61AB81FF95D4B4FFBAE6 - D0FF6ABB8FFF2D8F57FF196B37FF00000000287CCEFF78B3EAFFB39E94FFFFB7 - 60FFFFB663FFFEB261FFFEAC5DFFFEA559FF4A885DFF90D3B1FF92D6B1FFFFFF - FFFF65BC8CFF67BC8FFF196B37FF00000000297DD1FF82BAEEFF9F6658FFF5BB - 84FFFFAC5BFFFEA85AFFFEA257FFFE9C53FF317B4CFF9CD4B6FFFFFFFFFFFFFF - FFFFFFFFFFFF95D2B2FF196B37FF00000000000000002579CDFF866161FFBF60 - 35FFFEB961FFFEB962FFFEB962FFFEB962FF226E3AFF62BA8BFF60BA87FFFFFF - FFFF60B987FF67BC8FFF196B37FF00000000000000000000000000000000B350 - 20FFA0401FFFAA4522FFAC4622FFAB4422FF5C572DFF288C53FF64BA8DFF95D2 - B2FF64BA8DFF288C53FF196B37FF000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000196B37FF196B37FF196B - 37FF196B37FF196B37FF00000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000012488DFF104B90FF0F488AFF11427DFF15335BFF00000000000000000000 - 000000000000000000000000000000000000000000000000000000000000114E - 96FF12589BFF125899FF115393FF0F4A87FF0E3E71FF132E4BFF000000000000 - 00000000000000000000000000000000000000000000000000000F4B97FF1258 - 9FFF0F4A8AFF0F4B87FF114B87FF154C85FF124175FF0F335CFF000000000000 - 00000000000000000000000000000000000000000000000000000C3E87FF7C97 - B8FF8AB7E4FF719CC8FF15406EFF194472FF22456BFF113B66FF000000000000 - 00000000000000000000000000000000000000000000000000001F5E9BFFD9E8 - F7FF97C5F1FF8EBBE5FF7FA9D1FF89B5DFFFCDDFEEFF2368A7FF0000000058A5 - D8FF85B1DBFF469DD0FF000000000000000000000000000000002A5B92FFA6CA - EEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2884B7FF77BEE7FFB4D2 - F0FFE5F3FFFFACD2EFFF488CC7FF0000000000000000000000006A3C25FF346D - A7FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF2E8ABFFF7ED3EBFFB2E3F9FF8BC0 - E7FFAED3F6FFC4E0FCFF669FD3FF000000000000000000000000BC481CFFF4E2 - D4FF4E7BA9FF4D7BA8FF4D7BA8FF428CBAFF7DD4EEFFC4F6FDFF6CDDF6FF6DCA - EDFF63A3D7FF5D9BD2FF000000000000000000000000C44C1FFFF6E4D6FFFFE4 - A4FFFFD472FFFFC969FFBFBB86FF79D3EEFFC7F7FDFF5FDCF5FF5BE2F7FF7AD6 - F2FF4099DFFF0000000000000000000000008A5444FFFCC8ABFFFFD198FFFEC7 - 6DFFFEBF68FFB0A780FF77CBE7FFC7F7FDFF5EDCF5FF5AE1F7FF7BD4F1FF4691 - D4FF686672FF0000000000000000287CCEFF78B3EAFFB39E94FFFFB760FFFFB6 - 63FFB3A37DFF76B8D3FFC2F6FDFF63DFF7FF5DE2F8FF79D3F0FF4795D8FF75B2 - EAFF2974C7FF0000000000000000297DD1FF82BAEEFF9F6658FFF5BB84FFA792 - 74FF7AB6D5FF90B7D1FF55C9E4FF5BDFF5FF78D0EDFF5196D2FF96645DFF83BC - EFFF2A77CAFF0000000000000000000000002579CDFF866161FFBF6035FF4389 - AAFFE0F2FFFF549AD8FF1A7ABEFF4998C5FF4988B7FF9C5442FF7A646DFF2E7E - CEFF6DA2D3FF0000000000000000000000000000000000000000B35020FF2D64 - 81FF94C7F9FF91C9F9FF4185C9FF2362A4FF89493DFFB24F24FF000000000000 - 000000000000000000000000000000000000000000000000000000000000113D - 55FF285F87FF4988BDFF428DBCFF000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000012488DFF104B90FF0F488AFF11427DFF15335BFF000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000114E96FF12589BFF125899FF115393FF0F4A87FF0E3E71FF132E4BFF0000 - 0000000000000000000000000000000000000000000000000000000000000F4B - 97FF12589FFF0F4A8AFF0F4B87FF114B87FF154C85FF124175FF0F335CFF0000 - 0000000000000000000000000000000000000000000000000000000000000C3E - 87FF7C97B8FF8AB7E4FF719CC8FF15406EFF194472FF22456BFF113B66FF0000 - 0000000000000000000000000000000000000000000000000000000000001F5E - 9BFFD9E8F7FF97C5F1FF8EBBE5FF7FA9D1FF89B5DFFFCDDFEEFF2368A7FF0000 - 0000000000000000000000000000000000000000000000000000000000002A5B - 92FFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2D629AFF0000 - 0000000000000000000000000000000000000000000000000000000000006A3C - 25FF346DA7FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF3474AEFF683E2DFF0000 - 000000000000000000000000000000000000000000000000000000000000BC48 - 1CFFF4E2D4FF4E7BA9FF4D7BA8FF4D7BA8FF4E7BA9FFF3D6C3FFBE461CFF0000 - 0000000000000000000000000000000000000000000000000000C44C1FFFF6E4 - D6FFFFE4A4FFFFD472FFFFC969FFFFC063FFFFB65FFF9590A0FF295DC1FF0542 - BBFF0B45B0FF000000000000000000000000000000008A5444FFFCC8ABFFFFD1 - 98FFFEC76DFFFEBF68FFFEB964FFFEB15EFF95828BFF3D74CEFF8DB5F7FFB8D6 - FEFF72A8F5FF2D6BCAFF0000000000000000287CCEFF78B3EAFFB39E94FFFFB7 - 60FFFFB663FFFEB261FFFEAC5DFFFEA559FF2450ABFF8DB5F6FF4D92FFFF1177 - FFFF2186FFFF408AEBFF0344B9FF00000000297DD1FF82BAEEFF9F6658FFF5BB - 84FFFFAC5BFFFEA85AFFFEA257FFFE9C53FF0542BCFFAECDFEFFFFFFFFFFFFFF - FFFFFFFFFFFF187FEFFF0442BCFF00000000000000002579CDFF866161FFBF60 - 35FFFEB961FFFEB962FFFEB962FFFEB962FF1F52AFFF639DF4FF187FFFFF0076 - F8FF0076EEFF0368E1FF0345B9FF00000000000000000000000000000000B350 - 20FFA0401FFFAA4522FFAC4622FFAB4422FF5F4C74FF2763C6FF2177E6FF0579 - EAFF0164DDFF044DBDFF00000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000000000000345B9FF0442 - BCFF0345B9FF0000000000000000 - } - end - object ilAccesslevel: TImageList - left = 176 - Bitmap = { - 4C69040000001000000010000000000000000000000000000000000000000000 - 0000A3A3A3FFA0A0A0FF9D9D9DFF9A9A9AFF979797FF949494FF000000000000 - 000000000000000000000000000000000000000000000000000000000000A2A2 - A2FFBCBCBCFFCACACAFFCCCCCCFFCACACAFFC2C2C2FFADADADFF8C8C8CFF0000 - 0000000000000000000000000000000000000000000000000000A1A1A1FFC4C4 - C4FFBEBEBEFFA1A1A1FF969696FF939393FF979797FFAEAEAEFFAEAEAEFF8484 - 84FF000000000000000000000000000000000000000000000000BABABAFFBFBF - BFFF989898FF00000000000000000000000000000000878787FFA8A8A8FF9E9E - 9EFF00000000000000000000000000000000000000009D9D9DFFC4C4C4FFA1A1 - A1FF000000000000000000000000000000000000000000000000898989FFA9A9 - A9FF797979FF00000000000000000000000000000000999999FFC6C6C6FF9494 - 94FF0000000000000000000000000000000000000000000000007D7D7DFFABAB - ABFF767676FF00000000000000000000000061C3E1FF88A0A8FF919191FF8E8E - 8EFF5AB9DCFF55B8DFFF51B5DEFF4DB1DDFF49ADDCFF46A8D7FF787878FF7676 - 76FF657E8DFF3199D8FF000000000000000060C2E1FFC9F3FCFFCBF3FDFFD4F6 - FEFFD7F6FFFFD8F4FFFFE0F8FFFFDFF8FFFFDAF5FFFFCDF1FCFFC2EDFAFFBDEB - FAFFBDEBFAFF2B93D6FF00000000000000005CBFE0FFC8F3FCFF75DFF9FF89E6 - FDFF95E7FFFF9AE5FFFFAAEEFFFFA8EDFFFF99E3FFFF74D5F9FF59CCF3FF4FC8 - F1FFBBE9FAFF248DD5FF000000000000000058BBDFFFC7F1FCFF6FDCF9FF56BB - EDFF61BDEFFF9BE7FFFF35A6E2FF4BA4E1FF90E2FFFF49ADE9FF38A4E3FF49C4 - F0FFB8E8F9FF1E88D4FF000000000000000053B7DEFFC6F0FCFF6AD9F8FF7CE2 - FDFF90E8FFFF99E9FFFF329FDFFF548BB2FF8AE2FFFF6AD0F9FF50C5F1FF46C1 - F0FFB6E7F9FF1883D3FF00000000000000004EB2DDFFC3EFFBFF65D6F8FF4CB6 - ECFF5ABDEFFF95EBFFFF3097DDFF4D82ABFF84E1FFFF41A9E9FF329FE1FF42BE - EFFFB4E5F9FF137ED2FF000000000000000049ADDCFFC1EEFBFF5FD3F7FF6CDB - FCFF7FE5FFFF8FEDFFFF97F2FFFF93EDFFFF7CDFFFFF5BCCF8FF46BEEFFF3CBA - EEFFB3E3F9FF0E79D1FF000000000000000043A8DBFFBFECFBFF59CFF5FF41B0 - ECFF4EBAEFFF5AC2EFFF60C6EFFF5CC4EFFF4CB6EFFF37A5E6FF2A9AE1FF38B8 - EEFFB1E3F8FF0975D0FF00000000000000003DA3DAFFBCEBFAFFBCEBFCFFBFEE - FEFFC6F4FFFFCEF8FFFFD3FAFFFFD0F8FFFFC7F2FFFFBAE9FCFFB3E4F9FFB0E2 - F8FFB0E2F8FF0571CFFF0000000000000000369DD9FF3199D8FF2C94D7FF2890 - D6FF238CD5FF1E88D4FF1A84D3FF1580D2FF117CD1FF0E79D1FF0A76D0FF0773 - CFFF0470CFFF016ECEFF00000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000565D68FF133F7AFF0D3E7DFF0C3C76FF123969FF4E5663FF000000000000 - 0000000000000000000000000000000000000000000000000000000000005F63 - 69FF284D7DFF2D6196FF0F4988FF2C6093FF0C3E73FF1B3D60FF595E63FF0000 - 0000000000000000000000000000000000000000000000000000000000003752 - 79FF255A93FF0C3E76FF245485FF0E3E73FF265584FF163E69FF143050FF0000 - 0000000000000000000000000000000000000000000000000000000000001136 - 67FF2A4B71FF4C759EFF3B638EFF11355BFF28527BFF1C3959FF103255FF0000 - 0000000000000000000000000000000000000000000000000000000000001848 - 78FF9BB7D1FFA3C9EDFF9FC5E8FF74A1CDFF81B0DDFF96B3CEFF1A4C7EFF0000 - 000000000000000000000000000000000000000000000000000000000000305D - 8FFFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2E629AFF0000 - 0000000000000000000000000000000000000000000000000000000000003D3D - 3DFF416F9EFF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF4176A6FF373737FF0000 - 0000000000000000000000000000000000000000000000000000494949FF4B4B - 4BFF989898FF5C5C5CFF557CA3FF557CA3FF4C4C4CFF989898FF4E4E4EFF4C4C - 4CFF0000000000000000000000000000000000000000777777FF4C4C4CFF4E4E - 4EFF979797FF595959FFABABABFFA5A5A5FF545454FF868686FF626262FF4A4A - 4AFF0000000000000000000000000000000000000000636363FFA4A4A4FF5050 - 50FF525252FF5B5B5BFFB8B8B8FFC1C1C1FF575757FF4D4D4DFF5A5A5AFF7E7E - 7EFF606060FF000000000000000000000000287CCEFF78B3EAFF7A7A7AFF8383 - 83FF7E7E7EFF5D5D5DFF494949FF4C4C4CFF555555FF646464FF5F5F5FFF6D6D - 6DFF7EB8EDFF2974C7FF0000000000000000297DD1FF82BAEEFF5F5F5FFF8F8F - 8FFF7A7A7AFF777777FF6D6D6DFF4E4E4EFF727272FF6F6F6FFF848484FF5555 - 55FF83BCEFFF2A77CAFF0000000000000000000000002579CDFF5E5E5EFF4F4F - 4FFF848484FF848484FF808080FF545454FF838383FF848484FF4A4A4AFF4545 - 45FF2E7ECEFF6DA2D3FF00000000000000000000000000000000000000003D3D - 3DFF4D4D4DFF494949FF474747FF474747FF454545FF474747FF383838FF0000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000027B2E5FF1BA7F3FF1CACF4FF1CA8F4FF1BA1F1FF27ACDEFF000000000000 - 00000000000000000000000000000000000000000000000000000000000028B5 - E5FF1BB6F5FF1CB6F5FF1CB6F5FF1CB2F5FF1CABF4FF1DAAF0FF28B0E0FF0000 - 0000000000000000000000000000000000000000000000000000000000001DBA - F5FF1CB6F5FF1CAAF4FF1CACF4FF1CACF4FF1CACF3FF1CA1F0FF1C93E4FF0000 - 0000000000000000000000000000000000000000000000000000000000001B9E - F3FF62ABCEFF8AB7E4FF3EC6EBFF1C9FEDFF1DA4EEFF1EA5EBFF1C9AE9FF0000 - 0000000000000000000000000000000000000000000000000000000000001E6D - ADFFBDD7EFFFA3C9EDFF9DC5E8FF44CEEFFF5BCDEFFFA8DCF1FF207CBDFF0000 - 0000000000000000000000000000000000000000000000000000000000002C61 - 8EFFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2D6299FF0000 - 0000000000000000000000000000000000000000000000000000000000004C72 - 49FF347499FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF357AA1FF4A6A46FF0000 - 000000000000000000000000000000000000000000000000000079935DFF2785 - 4EFFB3F5C8FF49898FFF4B7FA0FF4B7FA0FF49898FFFA9E8BAFF26844DFF738C - 59FF0000000000000000000000000000000000000000AFE0ACFF37945DFF9FFD - C6FF91EFB8FF78D69FFF6FCD96FF69C68FFF62BF88FF73CF98FF94F0B9FF3088 - 51FF788754FF000000000000000000000000849D6CFF45A26BFF82E0A9FF82E0 - A9FF6FCD96FF69C790FF64C28BFF5EBC85FF57B57EFF50AE77FF6BC891FF67C0 - 8AFF4F9A66FF769264FF0000000000000000287CCEFF78B3EAFF5AB881FF62C0 - 89FF62C089FF5FBD86FF5AB881FF55B37CFF4FAD76FF49A770FF419E67FF4DAB - 74FF7EB8EDFF2974C7FF0000000000000000297DD1FF82BAEEFF409E67FF6ECC - 95FF5BB881FF58B57EFF53B17AFF4FAC75FF54B17AFF51AD76FF67C18AFF3B92 - 5CFF83BCEFFF2A77CAFF0000000000000000000000002579CDFF429D67FF318F - 58FF63C18AFF63C18AFF63C18AFF63C18AFF63C18AFF63C18AFF2D8A53FF2F88 - 53FF2E7ECEFF6DA2D3FF0000000000000000000000000000000000000000668C - 57FF428B55FF338952FF2E8851FF2D8750FF2E854EFF39854EFF4F824EFF0000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000565D68FF133F7AFF0D3E7DFF0C3C76FF123969FF4E5663FF000000000000 - 0000000000000000000000000000000000000000000000000000000000005F63 - 69FF284D7DFF0F498AFF0F4988FF0E4581FF0C3E73FF1B3D60FF595E63FF0000 - 0000000000000000000000000000000000000000000000000000000000003752 - 79FF0F498FFF0C3E76FF0C3E73FF0E3E73FF113F70FF0F3661FF143050FF0000 - 0000000000000000000000000000000000000000000000000000000000001037 - 73FF7893B5FF8AB7E4FF6793C3FF11355BFF15395FFF1C3959FF103255FF0000 - 0000000000000000000000000000000000000000000000000000000000001F5C - 99FFBDD7EFFFA3C9EDFF9FC5E8FF74A1CDFF81B0DDFFB7D3EBFF2365A4FF0000 - 000000000000000000000000000000000000000000000000000000000000395F - 89FFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2F6299FF0000 - 000000000000000000000000000000000000000000000000000000000000966B - 3EFF537291FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF51799AFF8C643CFF0000 - 0000000000000000000000000000000000000000000000000000A57645FFB17D - 3FFFD8BEA0FF968271FF5572A4FF435EB5FFA2795FFFD9BEA0FFB48042FFA875 - 46FF0000000000000000000000000000000000000000C29A70FFB27D41FFB480 - 42FFDCBF9EFFBE8A4CFFC4B6BCFF5E67C8FFB3814DFFD3B088FFC29159FFAF7A - 3EFF9F6F41FF000000000000000000000000A5774AFFC3925BFFE2CAB0FFB682 - 44FFB78345FFB88855FF4A5BD0FF5060D2FFBA874CFFB37F41FFBF8A4EFFD0A9 - 7DFFBE8D57FF9C6F46FF0000000000000000287CCEFF78B3EAFFCEA679FFD2AE - 83FFD0A97DFFB78859FF4D4EA6FF77627CFFB6844BFFC4935CFFC18E55FFC79A - 67FF7EB8EDFF2974C7FF0000000000000000297DD1FF82BAEEFFC18F55FFD8B9 - 94FFCEA678FFCCA375FFBA9370FFB27F44FFCA9F6EFFC89C69FFD3AE85FFB884 - 49FF83BCEFFF2A77CAFF0000000000000000000000002579CDFFC08E54FFB581 - 43FFD3AF85FFD3AF85FFD1AB7FFFB98547FFD2AE83FFD3AF85FFB07B3FFFA976 - 3CFF2E7ECEFF6DA2D3FF00000000000000000000000000000000000000009966 - 34FFAF7A41FFAE793DFFAD783CFFAD783CFFAA7539FFAA753CFF936131FF0000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000 - } - end -end +object frmAccountControl: TfrmAccountControl + Left = 290 + Height = 378 + Top = 171 + Width = 369 + ActiveControl = vstAccounts + BorderIcons = [biSystemMenu] + BorderStyle = bsDialog + Caption = 'Account Management' + ClientHeight = 378 + ClientWidth = 369 + Font.Height = -11 + OnClose = FormClose + OnCreate = FormCreate + OnDestroy = FormDestroy + OnShow = FormShow + Position = poOwnerFormCenter + LCLVersion = '0.9.29' + object tbMain: TToolBar + Left = 0 + Height = 26 + Top = 0 + Width = 369 + Caption = 'tbMain' + Images = ilToolbar + TabOrder = 0 + object tbRefresh: TToolButton + Left = 1 + Hint = 'Refresh' + Top = 2 + Caption = 'Refresh' + ImageIndex = 0 + ParentShowHint = False + ShowHint = True + OnClick = tbRefreshClick + end + object tbAddUser: TToolButton + Left = 32 + Hint = 'Add User' + Top = 2 + Caption = 'Add User' + ImageIndex = 1 + ParentShowHint = False + ShowHint = True + OnClick = tbAddUserClick + end + object tbEditUser: TToolButton + Left = 55 + Hint = 'Edit User' + Top = 2 + Caption = 'Edit User' + ImageIndex = 2 + ParentShowHint = False + ShowHint = True + OnClick = tbEditUserClick + end + object tbDeleteUser: TToolButton + Left = 78 + Hint = 'Delete User' + Top = 2 + Caption = 'Delete User' + ImageIndex = 3 + ParentShowHint = False + ShowHint = True + OnClick = tbDeleteUserClick + end + object tbSeparator1: TToolButton + Left = 24 + Top = 2 + Width = 8 + Caption = 'tbSeparator1' + Style = tbsDivider + end + end + object vstAccounts: TVirtualStringTree + Left = 0 + Height = 352 + Top = 26 + Width = 369 + Align = alClient + DefaultText = 'Node' + Header.AutoSizeIndex = 1 + Header.Columns = < + item + Position = 0 + Width = 30 + end + item + Position = 1 + Text = 'Username' + Width = 200 + end + item + Position = 2 + Text = 'Accesslevel' + Width = 100 + end> + Header.DefaultHeight = 17 + Header.Options = [hoColumnResize, hoDrag, hoVisible] + Header.ParentFont = True + Header.Style = hsFlatButtons + Images = ilAccesslevel + TabOrder = 1 + TreeOptions.AutoOptions = [toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes] + TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning] + TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] + TreeOptions.SelectionOptions = [toFullRowSelect] + OnDblClick = vstAccountsDblClick + OnFreeNode = vstAccountsFreeNode + OnGetText = vstAccountsGetText + OnGetImageIndex = vstAccountsGetImageIndex + end + object ilToolbar: TImageList + left = 144 + Bitmap = { + 4C69040000001000000010000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000047994FFF419149FF000000000000 + 0000000000000000000000000000000000000000000000000000000000005BB4 + 65FF56AD5FFF50A65AFF4B9E53FF45964DFF60A868FF5BA262FF347E3AFF0000 + 000000000000000000000000000000000000000000005EB968FF79C383FF89CA + 92FF94D09CFF95D19EFF90CF99FF8CCB94FF87C98FFF80C487FF4E9554FF276D + 2CFF000000000000000000000000000000005CB667FF85C98EFF9BD4A4FF8FCE + 98FF92CF9AFF8DCC95FF88CA90FF83C68BFF7EC485FF79C17FFF478D4CFF2265 + 25FF0000000000000000000000000000000075BF7EFF98D2A1FF94CF9CFF86C7 + 8DFF5EA765FF398640FF347E3AFF2E7633FF49904FFF458B4AFF206324FF0000 + 000000000000000000000000000054AB5EFF80C389FF8DCC95FF83C48AFF3D8B + 44FF37833EFF000000000000000000000000236627FF1F6123FF000000000000 + 00000000000000000000000000004DA155FF47994FFF419149FF3B8842FF3580 + 3CFF000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000004DA155FF4799 + 4FFF419149FF3B8842FF35803CFF000000000000000000000000000000000000 + 000063C06EFF5FBB6AFF0000000000000000000000004B9E53FF45964DFF86C6 + 8EFF88C98FFF6FB376FF2E7633FF0000000000000000000000000000000062BE + 6DFF7BC785FF77C281FF54AB5EFF4EA357FF499B51FF63AC6BFF83C38BFF87C9 + 8FFF82C689FF509756FF0000000000000000000000000000000060BC6CFF79C4 + 83FF9ED7A7FF9BD4A4FF97D29FFF92CF9AFF8DCC95FF88CA90FF7AC282FF7EC4 + 85FF5DA463FF266B2AFF000000000000000000000000000000005BB465FF73BD + 7CFF96D19FFF94CF9CFF8FCD96FF8ACA91FF85C78BFF7ABE81FF65AD6CFF4B92 + 51FF246829FF0000000000000000000000000000000000000000000000004EA3 + 57FF66B06EFF61AA68FF3D8B44FF37833EFF327B37FF2C7432FF276D2CFF0000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000419149FF3B8842FF00000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000012488DFF104B90FF0F488AFF11427DFF15335BFF000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000114E96FF12589BFF125899FF115393FF0F4A87FF0E3E71FF132E4BFF0000 + 0000000000000000000000000000000000000000000000000000000000000F4B + 97FF12589FFF0F4A8AFF0F4B87FF114B87FF154C85FF124175FF0F335CFF0000 + 0000000000000000000000000000000000000000000000000000000000000C3E + 87FF7C97B8FF8AB7E4FF719CC8FF15406EFF194472FF22456BFF113B66FF0000 + 0000000000000000000000000000000000000000000000000000000000001F5E + 9BFFD9E8F7FF97C5F1FF8EBBE5FF7FA9D1FF89B5DFFFCDDFEEFF2368A7FF0000 + 0000000000000000000000000000000000000000000000000000000000002A5B + 92FFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2D629AFF0000 + 0000000000000000000000000000000000000000000000000000000000006A3C + 25FF346DA7FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF3474AEFF683E2DFF0000 + 000000000000000000000000000000000000000000000000000000000000BC48 + 1CFFF4E2D4FF4E7BA9FF4D7BA8FF4D7BA8FF4E7BA9FFF3D6C3FFBE461CFF0000 + 0000000000000000000000000000000000000000000000000000C44C1FFFF6E4 + D6FFFFE4A4FFFFD472FFFFC969FFFFC063FFFFB65FFFAEAB78FF609772FF4F8E + 66FF428357FF000000000000000000000000000000008A5444FFFCC8ABFFFFD1 + 98FFFEC76DFFFEBF68FFFEB964FFFEB15EFFA79B61FF61AB81FF95D4B4FFBAE6 + D0FF6ABB8FFF2D8F57FF196B37FF00000000287CCEFF78B3EAFFB39E94FFFFB7 + 60FFFFB663FFFEB261FFFEAC5DFFFEA559FF4A885DFF90D3B1FF92D6B1FFFFFF + FFFF65BC8CFF67BC8FFF196B37FF00000000297DD1FF82BAEEFF9F6658FFF5BB + 84FFFFAC5BFFFEA85AFFFEA257FFFE9C53FF317B4CFF9CD4B6FFFFFFFFFFFFFF + FFFFFFFFFFFF95D2B2FF196B37FF00000000000000002579CDFF866161FFBF60 + 35FFFEB961FFFEB962FFFEB962FFFEB962FF226E3AFF62BA8BFF60BA87FFFFFF + FFFF60B987FF67BC8FFF196B37FF00000000000000000000000000000000B350 + 20FFA0401FFFAA4522FFAC4622FFAB4422FF5C572DFF288C53FF64BA8DFF95D2 + B2FF64BA8DFF288C53FF196B37FF000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000196B37FF196B37FF196B + 37FF196B37FF196B37FF00000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000012488DFF104B90FF0F488AFF11427DFF15335BFF00000000000000000000 + 000000000000000000000000000000000000000000000000000000000000114E + 96FF12589BFF125899FF115393FF0F4A87FF0E3E71FF132E4BFF000000000000 + 00000000000000000000000000000000000000000000000000000F4B97FF1258 + 9FFF0F4A8AFF0F4B87FF114B87FF154C85FF124175FF0F335CFF000000000000 + 00000000000000000000000000000000000000000000000000000C3E87FF7C97 + B8FF8AB7E4FF719CC8FF15406EFF194472FF22456BFF113B66FF000000000000 + 00000000000000000000000000000000000000000000000000001F5E9BFFD9E8 + F7FF97C5F1FF8EBBE5FF7FA9D1FF89B5DFFFCDDFEEFF2368A7FF0000000058A5 + D8FF85B1DBFF469DD0FF000000000000000000000000000000002A5B92FFA6CA + EEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2884B7FF77BEE7FFB4D2 + F0FFE5F3FFFFACD2EFFF488CC7FF0000000000000000000000006A3C25FF346D + A7FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF2E8ABFFF7ED3EBFFB2E3F9FF8BC0 + E7FFAED3F6FFC4E0FCFF669FD3FF000000000000000000000000BC481CFFF4E2 + D4FF4E7BA9FF4D7BA8FF4D7BA8FF428CBAFF7DD4EEFFC4F6FDFF6CDDF6FF6DCA + EDFF63A3D7FF5D9BD2FF000000000000000000000000C44C1FFFF6E4D6FFFFE4 + A4FFFFD472FFFFC969FFBFBB86FF79D3EEFFC7F7FDFF5FDCF5FF5BE2F7FF7AD6 + F2FF4099DFFF0000000000000000000000008A5444FFFCC8ABFFFFD198FFFEC7 + 6DFFFEBF68FFB0A780FF77CBE7FFC7F7FDFF5EDCF5FF5AE1F7FF7BD4F1FF4691 + D4FF686672FF0000000000000000287CCEFF78B3EAFFB39E94FFFFB760FFFFB6 + 63FFB3A37DFF76B8D3FFC2F6FDFF63DFF7FF5DE2F8FF79D3F0FF4795D8FF75B2 + EAFF2974C7FF0000000000000000297DD1FF82BAEEFF9F6658FFF5BB84FFA792 + 74FF7AB6D5FF90B7D1FF55C9E4FF5BDFF5FF78D0EDFF5196D2FF96645DFF83BC + EFFF2A77CAFF0000000000000000000000002579CDFF866161FFBF6035FF4389 + AAFFE0F2FFFF549AD8FF1A7ABEFF4998C5FF4988B7FF9C5442FF7A646DFF2E7E + CEFF6DA2D3FF0000000000000000000000000000000000000000B35020FF2D64 + 81FF94C7F9FF91C9F9FF4185C9FF2362A4FF89493DFFB24F24FF000000000000 + 000000000000000000000000000000000000000000000000000000000000113D + 55FF285F87FF4988BDFF428DBCFF000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000012488DFF104B90FF0F488AFF11427DFF15335BFF000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000114E96FF12589BFF125899FF115393FF0F4A87FF0E3E71FF132E4BFF0000 + 0000000000000000000000000000000000000000000000000000000000000F4B + 97FF12589FFF0F4A8AFF0F4B87FF114B87FF154C85FF124175FF0F335CFF0000 + 0000000000000000000000000000000000000000000000000000000000000C3E + 87FF7C97B8FF8AB7E4FF719CC8FF15406EFF194472FF22456BFF113B66FF0000 + 0000000000000000000000000000000000000000000000000000000000001F5E + 9BFFD9E8F7FF97C5F1FF8EBBE5FF7FA9D1FF89B5DFFFCDDFEEFF2368A7FF0000 + 0000000000000000000000000000000000000000000000000000000000002A5B + 92FFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2D629AFF0000 + 0000000000000000000000000000000000000000000000000000000000006A3C + 25FF346DA7FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF3474AEFF683E2DFF0000 + 000000000000000000000000000000000000000000000000000000000000BC48 + 1CFFF4E2D4FF4E7BA9FF4D7BA8FF4D7BA8FF4E7BA9FFF3D6C3FFBE461CFF0000 + 0000000000000000000000000000000000000000000000000000C44C1FFFF6E4 + D6FFFFE4A4FFFFD472FFFFC969FFFFC063FFFFB65FFF9590A0FF295DC1FF0542 + BBFF0B45B0FF000000000000000000000000000000008A5444FFFCC8ABFFFFD1 + 98FFFEC76DFFFEBF68FFFEB964FFFEB15EFF95828BFF3D74CEFF8DB5F7FFB8D6 + FEFF72A8F5FF2D6BCAFF0000000000000000287CCEFF78B3EAFFB39E94FFFFB7 + 60FFFFB663FFFEB261FFFEAC5DFFFEA559FF2450ABFF8DB5F6FF4D92FFFF1177 + FFFF2186FFFF408AEBFF0344B9FF00000000297DD1FF82BAEEFF9F6658FFF5BB + 84FFFFAC5BFFFEA85AFFFEA257FFFE9C53FF0542BCFFAECDFEFFFFFFFFFFFFFF + FFFFFFFFFFFF187FEFFF0442BCFF00000000000000002579CDFF866161FFBF60 + 35FFFEB961FFFEB962FFFEB962FFFEB962FF1F52AFFF639DF4FF187FFFFF0076 + F8FF0076EEFF0368E1FF0345B9FF00000000000000000000000000000000B350 + 20FFA0401FFFAA4522FFAC4622FFAB4422FF5F4C74FF2763C6FF2177E6FF0579 + EAFF0164DDFF044DBDFF00000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000345B9FF0442 + BCFF0345B9FF0000000000000000 + } + end + object ilAccesslevel: TImageList + left = 176 + Bitmap = { + 4C69040000001000000010000000000000000000000000000000000000000000 + 0000A3A3A3FFA0A0A0FF9D9D9DFF9A9A9AFF979797FF949494FF000000000000 + 000000000000000000000000000000000000000000000000000000000000A2A2 + A2FFBCBCBCFFCACACAFFCCCCCCFFCACACAFFC2C2C2FFADADADFF8C8C8CFF0000 + 0000000000000000000000000000000000000000000000000000A1A1A1FFC4C4 + C4FFBEBEBEFFA1A1A1FF969696FF939393FF979797FFAEAEAEFFAEAEAEFF8484 + 84FF000000000000000000000000000000000000000000000000BABABAFFBFBF + BFFF989898FF00000000000000000000000000000000878787FFA8A8A8FF9E9E + 9EFF00000000000000000000000000000000000000009D9D9DFFC4C4C4FFA1A1 + A1FF000000000000000000000000000000000000000000000000898989FFA9A9 + A9FF797979FF00000000000000000000000000000000999999FFC6C6C6FF9494 + 94FF0000000000000000000000000000000000000000000000007D7D7DFFABAB + ABFF767676FF00000000000000000000000061C3E1FF88A0A8FF919191FF8E8E + 8EFF5AB9DCFF55B8DFFF51B5DEFF4DB1DDFF49ADDCFF46A8D7FF787878FF7676 + 76FF657E8DFF3199D8FF000000000000000060C2E1FFC9F3FCFFCBF3FDFFD4F6 + FEFFD7F6FFFFD8F4FFFFE0F8FFFFDFF8FFFFDAF5FFFFCDF1FCFFC2EDFAFFBDEB + FAFFBDEBFAFF2B93D6FF00000000000000005CBFE0FFC8F3FCFF75DFF9FF89E6 + FDFF95E7FFFF9AE5FFFFAAEEFFFFA8EDFFFF99E3FFFF74D5F9FF59CCF3FF4FC8 + F1FFBBE9FAFF248DD5FF000000000000000058BBDFFFC7F1FCFF6FDCF9FF56BB + EDFF61BDEFFF9BE7FFFF35A6E2FF4BA4E1FF90E2FFFF49ADE9FF38A4E3FF49C4 + F0FFB8E8F9FF1E88D4FF000000000000000053B7DEFFC6F0FCFF6AD9F8FF7CE2 + FDFF90E8FFFF99E9FFFF329FDFFF548BB2FF8AE2FFFF6AD0F9FF50C5F1FF46C1 + F0FFB6E7F9FF1883D3FF00000000000000004EB2DDFFC3EFFBFF65D6F8FF4CB6 + ECFF5ABDEFFF95EBFFFF3097DDFF4D82ABFF84E1FFFF41A9E9FF329FE1FF42BE + EFFFB4E5F9FF137ED2FF000000000000000049ADDCFFC1EEFBFF5FD3F7FF6CDB + FCFF7FE5FFFF8FEDFFFF97F2FFFF93EDFFFF7CDFFFFF5BCCF8FF46BEEFFF3CBA + EEFFB3E3F9FF0E79D1FF000000000000000043A8DBFFBFECFBFF59CFF5FF41B0 + ECFF4EBAEFFF5AC2EFFF60C6EFFF5CC4EFFF4CB6EFFF37A5E6FF2A9AE1FF38B8 + EEFFB1E3F8FF0975D0FF00000000000000003DA3DAFFBCEBFAFFBCEBFCFFBFEE + FEFFC6F4FFFFCEF8FFFFD3FAFFFFD0F8FFFFC7F2FFFFBAE9FCFFB3E4F9FFB0E2 + F8FFB0E2F8FF0571CFFF0000000000000000369DD9FF3199D8FF2C94D7FF2890 + D6FF238CD5FF1E88D4FF1A84D3FF1580D2FF117CD1FF0E79D1FF0A76D0FF0773 + CFFF0470CFFF016ECEFF00000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000565D68FF133F7AFF0D3E7DFF0C3C76FF123969FF4E5663FF000000000000 + 0000000000000000000000000000000000000000000000000000000000005F63 + 69FF284D7DFF2D6196FF0F4988FF2C6093FF0C3E73FF1B3D60FF595E63FF0000 + 0000000000000000000000000000000000000000000000000000000000003752 + 79FF255A93FF0C3E76FF245485FF0E3E73FF265584FF163E69FF143050FF0000 + 0000000000000000000000000000000000000000000000000000000000001136 + 67FF2A4B71FF4C759EFF3B638EFF11355BFF28527BFF1C3959FF103255FF0000 + 0000000000000000000000000000000000000000000000000000000000001848 + 78FF9BB7D1FFA3C9EDFF9FC5E8FF74A1CDFF81B0DDFF96B3CEFF1A4C7EFF0000 + 000000000000000000000000000000000000000000000000000000000000305D + 8FFFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2E629AFF0000 + 0000000000000000000000000000000000000000000000000000000000003D3D + 3DFF416F9EFF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF4176A6FF373737FF0000 + 0000000000000000000000000000000000000000000000000000494949FF4B4B + 4BFF989898FF5C5C5CFF557CA3FF557CA3FF4C4C4CFF989898FF4E4E4EFF4C4C + 4CFF0000000000000000000000000000000000000000777777FF4C4C4CFF4E4E + 4EFF979797FF595959FFABABABFFA5A5A5FF545454FF868686FF626262FF4A4A + 4AFF0000000000000000000000000000000000000000636363FFA4A4A4FF5050 + 50FF525252FF5B5B5BFFB8B8B8FFC1C1C1FF575757FF4D4D4DFF5A5A5AFF7E7E + 7EFF606060FF000000000000000000000000287CCEFF78B3EAFF7A7A7AFF8383 + 83FF7E7E7EFF5D5D5DFF494949FF4C4C4CFF555555FF646464FF5F5F5FFF6D6D + 6DFF7EB8EDFF2974C7FF0000000000000000297DD1FF82BAEEFF5F5F5FFF8F8F + 8FFF7A7A7AFF777777FF6D6D6DFF4E4E4EFF727272FF6F6F6FFF848484FF5555 + 55FF83BCEFFF2A77CAFF0000000000000000000000002579CDFF5E5E5EFF4F4F + 4FFF848484FF848484FF808080FF545454FF838383FF848484FF4A4A4AFF4545 + 45FF2E7ECEFF6DA2D3FF00000000000000000000000000000000000000003D3D + 3DFF4D4D4DFF494949FF474747FF474747FF454545FF474747FF383838FF0000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000027B2E5FF1BA7F3FF1CACF4FF1CA8F4FF1BA1F1FF27ACDEFF000000000000 + 00000000000000000000000000000000000000000000000000000000000028B5 + E5FF1BB6F5FF1CB6F5FF1CB6F5FF1CB2F5FF1CABF4FF1DAAF0FF28B0E0FF0000 + 0000000000000000000000000000000000000000000000000000000000001DBA + F5FF1CB6F5FF1CAAF4FF1CACF4FF1CACF4FF1CACF3FF1CA1F0FF1C93E4FF0000 + 0000000000000000000000000000000000000000000000000000000000001B9E + F3FF62ABCEFF8AB7E4FF3EC6EBFF1C9FEDFF1DA4EEFF1EA5EBFF1C9AE9FF0000 + 0000000000000000000000000000000000000000000000000000000000001E6D + ADFFBDD7EFFFA3C9EDFF9DC5E8FF44CEEFFF5BCDEFFFA8DCF1FF207CBDFF0000 + 0000000000000000000000000000000000000000000000000000000000002C61 + 8EFFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2D6299FF0000 + 0000000000000000000000000000000000000000000000000000000000004C72 + 49FF347499FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF357AA1FF4A6A46FF0000 + 000000000000000000000000000000000000000000000000000079935DFF2785 + 4EFFB3F5C8FF49898FFF4B7FA0FF4B7FA0FF49898FFFA9E8BAFF26844DFF738C + 59FF0000000000000000000000000000000000000000AFE0ACFF37945DFF9FFD + C6FF91EFB8FF78D69FFF6FCD96FF69C68FFF62BF88FF73CF98FF94F0B9FF3088 + 51FF788754FF000000000000000000000000849D6CFF45A26BFF82E0A9FF82E0 + A9FF6FCD96FF69C790FF64C28BFF5EBC85FF57B57EFF50AE77FF6BC891FF67C0 + 8AFF4F9A66FF769264FF0000000000000000287CCEFF78B3EAFF5AB881FF62C0 + 89FF62C089FF5FBD86FF5AB881FF55B37CFF4FAD76FF49A770FF419E67FF4DAB + 74FF7EB8EDFF2974C7FF0000000000000000297DD1FF82BAEEFF409E67FF6ECC + 95FF5BB881FF58B57EFF53B17AFF4FAC75FF54B17AFF51AD76FF67C18AFF3B92 + 5CFF83BCEFFF2A77CAFF0000000000000000000000002579CDFF429D67FF318F + 58FF63C18AFF63C18AFF63C18AFF63C18AFF63C18AFF63C18AFF2D8A53FF2F88 + 53FF2E7ECEFF6DA2D3FF0000000000000000000000000000000000000000668C + 57FF428B55FF338952FF2E8851FF2D8750FF2E854EFF39854EFF4F824EFF0000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000565D68FF133F7AFF0D3E7DFF0C3C76FF123969FF4E5663FF000000000000 + 0000000000000000000000000000000000000000000000000000000000005F63 + 69FF284D7DFF0F498AFF0F4988FF0E4581FF0C3E73FF1B3D60FF595E63FF0000 + 0000000000000000000000000000000000000000000000000000000000003752 + 79FF0F498FFF0C3E76FF0C3E73FF0E3E73FF113F70FF0F3661FF143050FF0000 + 0000000000000000000000000000000000000000000000000000000000001037 + 73FF7893B5FF8AB7E4FF6793C3FF11355BFF15395FFF1C3959FF103255FF0000 + 0000000000000000000000000000000000000000000000000000000000001F5C + 99FFBDD7EFFFA3C9EDFF9FC5E8FF74A1CDFF81B0DDFFB7D3EBFF2365A4FF0000 + 000000000000000000000000000000000000000000000000000000000000395F + 89FFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2F6299FF0000 + 000000000000000000000000000000000000000000000000000000000000966B + 3EFF537291FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF51799AFF8C643CFF0000 + 0000000000000000000000000000000000000000000000000000A57645FFB17D + 3FFFD8BEA0FF968271FF5572A4FF435EB5FFA2795FFFD9BEA0FFB48042FFA875 + 46FF0000000000000000000000000000000000000000C29A70FFB27D41FFB480 + 42FFDCBF9EFFBE8A4CFFC4B6BCFF5E67C8FFB3814DFFD3B088FFC29159FFAF7A + 3EFF9F6F41FF000000000000000000000000A5774AFFC3925BFFE2CAB0FFB682 + 44FFB78345FFB88855FF4A5BD0FF5060D2FFBA874CFFB37F41FFBF8A4EFFD0A9 + 7DFFBE8D57FF9C6F46FF0000000000000000287CCEFF78B3EAFFCEA679FFD2AE + 83FFD0A97DFFB78859FF4D4EA6FF77627CFFB6844BFFC4935CFFC18E55FFC79A + 67FF7EB8EDFF2974C7FF0000000000000000297DD1FF82BAEEFFC18F55FFD8B9 + 94FFCEA678FFCCA375FFBA9370FFB27F44FFCA9F6EFFC89C69FFD3AE85FFB884 + 49FF83BCEFFF2A77CAFF0000000000000000000000002579CDFFC08E54FFB581 + 43FFD3AF85FFD3AF85FFD1AB7FFFB98547FFD2AE83FFD3AF85FFB07B3FFFA976 + 3CFF2E7ECEFF6DA2D3FF00000000000000000000000000000000000000009966 + 34FFAF7A41FFAE793DFFAD783CFFAD783CFFAA7539FFAA753CFF936131FF0000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000 + } + end +end diff --git a/Client/UfrmAccountControl.pas b/Client/UfrmAccountControl.pas index 5923afe..b9c5135 100644 --- a/Client/UfrmAccountControl.pas +++ b/Client/UfrmAccountControl.pas @@ -1,411 +1,411 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2008 Andreas Schneider - *) -unit UfrmAccountControl; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls, - VirtualTrees, Math, UEnhancedMemoryStream, UEnums; - -type - - { TfrmAccountControl } - - TfrmAccountControl = class(TForm) - ilToolbar: TImageList; - ilAccesslevel: TImageList; - tbMain: TToolBar; - tbRefresh: TToolButton; - tbAddUser: TToolButton; - tbEditUser: TToolButton; - tbDeleteUser: TToolButton; - tbSeparator1: TToolButton; - vstAccounts: TVirtualStringTree; - procedure tbEditUserClick(Sender: TObject); - procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); - procedure FormCreate(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure FormShow(Sender: TObject); - procedure tbAddUserClick(Sender: TObject); - procedure tbDeleteUserClick(Sender: TObject); - procedure tbRefreshClick(Sender: TObject); - procedure vstAccountsDblClick(Sender: TObject); - procedure vstAccountsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); - procedure vstAccountsGetImageIndex(Sender: TBaseVirtualTree; - Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; - var Ghosted: Boolean; var ImageIndex: Integer); - procedure vstAccountsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; - Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); - protected - procedure OnModifyUserResponse(ABuffer: TEnhancedMemoryStream); - procedure OnDeleteUserResponse(ABuffer: TEnhancedMemoryStream); - procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream); - function FindNode(AUsername: string): PVirtualNode; - end; - -var - frmAccountControl: TfrmAccountControl; - -implementation - -uses - UdmNetwork, UPacket, UPacketHandlers, UAdminHandling, UfrmEditAccount; - -type - PAccountInfo = ^TAccountInfo; - TAccountInfo = record - Username: string; - AccessLevel: TAccessLevel; - Regions: TStringList; - end; - - { TModifyUserPacket } - - TModifyUserPacket = class(TPacket) - constructor Create(AUsername, APassword: string; AAccessLevel: TAccessLevel; - ARegions: TStrings); - end; - - { TDeleteUserPacket } - - TDeleteUserPacket = class(TPacket) - constructor Create(AUsername: string); - end; - - { TRequestUserListPacket } - - TRequestUserListPacket = class(TPacket) - constructor Create; - end; - -{ TModifyUserPacket } - -constructor TModifyUserPacket.Create(AUsername, APassword: string; - AAccessLevel: TAccessLevel; ARegions: TStrings); -var - regionCount: Byte; - i: Integer; -begin - inherited Create($03, 0); - FStream.WriteByte($05); - FStream.WriteStringNull(AUsername); - FStream.WriteStringNull(APassword); - FStream.WriteByte(Byte(AAccessLevel)); - - regionCount := Min(ARegions.Count, 256); - FStream.WriteByte(regionCount); - - for i := 0 to regionCount - 1 do - FStream.WriteStringNull(ARegions.Strings[i]); -end; - -{ TDeleteUserPacket } - -constructor TDeleteUserPacket.Create(AUsername: string); -begin - inherited Create($03, 0); - FStream.WriteByte($06); - FStream.WriteStringNull(AUsername); -end; - -{ TRequestUserListPacket } - -constructor TRequestUserListPacket.Create; -begin - inherited Create($03, 0); - FStream.WriteByte($07); -end; - -{ TfrmAccountControl } - -procedure TfrmAccountControl.FormCreate(Sender: TObject); -begin - vstAccounts.NodeDataSize := SizeOf(TAccountInfo); - - AssignAdminPacketHandler($05, TPacketHandler.Create(0, @OnModifyUserResponse)); - AssignAdminPacketHandler($06, TPacketHandler.Create(0, @OnDeleteUserResponse)); - AssignAdminPacketHandler($07, TPacketHandler.Create(0, @OnListUsersPacket)); -end; - -procedure TfrmAccountControl.FormClose(Sender: TObject; - var CloseAction: TCloseAction); -begin - CloseAction := caHide; -end; - -procedure TfrmAccountControl.tbEditUserClick(Sender: TObject); -var - selected: PVirtualNode; - accountInfo: PAccountInfo; - regions: TStrings; -begin - selected := vstAccounts.GetFirstSelected; - if selected <> nil then - begin - accountInfo := vstAccounts.GetNodeData(selected); - with frmEditAccount do - begin - edUsername.Text := accountInfo^.Username; - edUsername.Color := clBtnFace; - edUsername.ReadOnly := True; - edPassword.Text := ''; - lblPasswordHint.Visible := True; - SetAccessLevel(accountInfo^.AccessLevel); - SetRegions(accountInfo^.Regions); - if ShowModal = mrOK then - begin - regions := GetRegions; - dmNetwork.Send(TModifyUserPacket.Create(edUsername.Text, - edPassword.Text, GetAccessLevel, regions)); - regions.Free; - end; - end; - end; -end; - -procedure TfrmAccountControl.FormDestroy(Sender: TObject); -begin - if AdminPacketHandlers[$05] <> nil then FreeAndNil(AdminPacketHandlers[$05]); - if AdminPacketHandlers[$06] <> nil then FreeAndNil(AdminPacketHandlers[$06]); - if AdminPacketHandlers[$07] <> nil then FreeAndNil(AdminPacketHandlers[$07]); -end; - -procedure TfrmAccountControl.FormShow(Sender: TObject); -begin - tbRefreshClick(Sender); -end; - -procedure TfrmAccountControl.tbAddUserClick(Sender: TObject); -var - regions: TStrings; -begin - with frmEditAccount do - begin - edUsername.Text := ''; - edUsername.Color := clWindow; - edUsername.ReadOnly := False; - edPassword.Text := ''; - lblPasswordHint.Visible := False; - cbAccessLevel.ItemIndex := 2; - SetRegions(nil); - if ShowModal = mrOK then - begin - regions := GetRegions; - dmNetwork.Send(TModifyUserPacket.Create(edUsername.Text, edPassword.Text, - GetAccessLevel, regions)); - regions.Free; - end; - end; -end; - -procedure TfrmAccountControl.tbDeleteUserClick(Sender: TObject); -var - selected: PVirtualNode; - accountInfo: PAccountInfo; -begin - selected := vstAccounts.GetFirstSelected; - if selected <> nil then - begin - accountInfo := vstAccounts.GetNodeData(selected); - if MessageDlg('Confirmation', Format('Do you really want to delete "%s"?', - [accountInfo^.Username]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then - dmNetwork.Send(TDeleteUserPacket.Create(accountInfo^.Username)); - end; -end; - -procedure TfrmAccountControl.tbRefreshClick(Sender: TObject); -begin - dmNetwork.Send(TRequestUserListPacket.Create); -end; - -procedure TfrmAccountControl.vstAccountsDblClick(Sender: TObject); -begin - tbEditUserClick(Sender); -end; - -procedure TfrmAccountControl.vstAccountsFreeNode(Sender: TBaseVirtualTree; - Node: PVirtualNode); -var - accountInfo: PAccountInfo; -begin - accountInfo := vstAccounts.GetNodeData(Node); - accountInfo^.Username := ''; - if accountInfo^.Regions <> nil then FreeAndNil(accountInfo^.Regions); -end; - -procedure TfrmAccountControl.vstAccountsGetImageIndex(Sender: TBaseVirtualTree; - Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; - var Ghosted: Boolean; var ImageIndex: Integer); -var - accountInfo: PAccountInfo; -begin - if Column = 0 then - begin - accountInfo := Sender.GetNodeData(Node); - case accountInfo^.AccessLevel of - alNone: ImageIndex := 0; - alView: ImageIndex := 1; - alNormal: ImageIndex := 2; - alAdministrator: ImageIndex := 3; - end; - end; -end; - -procedure TfrmAccountControl.vstAccountsGetText(Sender: TBaseVirtualTree; - Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; - var CellText: String); -var - accountInfo: PAccountInfo; -begin - accountInfo := Sender.GetNodeData(Node); - case Column of - 1: CellText := accountInfo^.Username; - 2: CellText := GetAccessLevelString(accountInfo^.AccessLevel); - else - CellText := ''; - end; -end; - -procedure TfrmAccountControl.OnModifyUserResponse(ABuffer: TEnhancedMemoryStream); -var - node: PVirtualNode; - modifyStatus: TModifyUserStatus; - username: string; - accountInfo: PAccountInfo; - i, regions: Integer; -begin - modifyStatus := TModifyUserStatus(ABuffer.ReadByte); - username := ABuffer.ReadStringNull; - case modifyStatus of - muAdded: - begin - node := vstAccounts.AddChild(nil); - accountInfo := vstAccounts.GetNodeData(node); - accountInfo^.Username := username; - accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte); - accountInfo^.Regions := TStringList.Create; - regions := ABuffer.ReadByte; - for i := 0 to regions - 1 do - accountInfo^.Regions.Add(ABuffer.ReadStringNull); - - Messagedlg('Success', Format('The user "%s" has been added.', [username]), - mtInformation, [mbOK], 0); - end; - muModified: - begin - node := FindNode(username); - if node <> nil then - begin - accountInfo := vstAccounts.GetNodeData(node); - accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte); - accountInfo^.Regions.Clear; - regions := ABuffer.ReadByte; - for i := 0 to regions - 1 do - accountInfo^.Regions.Add(ABuffer.ReadStringNull); - - Messagedlg('Success', Format('The user "%s" has been modified.', [username]), - mtInformation, [mbOK], 0); - end; - end; - muInvalidUsername: - MessageDlg('Error', Format('The username "%s" is not valid.', [username]), - mtError, [mbOK], 0); - end; -end; - -procedure TfrmAccountControl.OnDeleteUserResponse(ABuffer: TEnhancedMemoryStream); -var - node: PVirtualNode; - deleteStatus: TDeleteUserStatus; - username: string; -begin - deleteStatus := TDeleteUserStatus(ABuffer.ReadByte); - username := ABuffer.ReadStringNull; - case deleteStatus of - duDeleted: - begin - node := FindNode(username); - if node <> nil then - begin - vstAccounts.DeleteNode(node); - Messagedlg('Success', Format('The user "%s" has been deleted.', [username]), - mtInformation, [mbOK], 0); - end; - end; - duNotFound: - MessageDlg('Error', Format('The user "%s" could not be deleted. Maybe ' + - 'your list is out of date or you tried to delete yourself.', [username]), - mtError, [mbOK], 0); - end; -end; - -procedure TfrmAccountControl.OnListUsersPacket(ABuffer: TEnhancedMemoryStream); -var - node: PVirtualNode; - accountInfo: PAccountInfo; - i, j, count, regions: Integer; -begin - vstAccounts.BeginUpdate; - vstAccounts.Clear; - count := ABuffer.ReadWord; - for i := 1 to count do - begin - node := vstAccounts.AddChild(nil); - accountInfo := vstAccounts.GetNodeData(node); - accountInfo^.Username := ABuffer.ReadStringNull; - accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte); - accountInfo^.Regions := TStringList.Create; - regions := ABuffer.ReadByte; - for j := 0 to regions - 1 do - accountInfo^.Regions.Add(ABuffer.ReadStringNull); - end; - vstAccounts.EndUpdate; -end; - -function TfrmAccountControl.FindNode(AUsername: string): PVirtualNode; -var - node: PVirtualNode; - accountInfo: PAccountInfo; -begin - Result := nil; - node := vstAccounts.GetFirst; - while (node <> nil) and (Result = nil) do - begin - accountInfo := vstAccounts.GetNodeData(node); - if accountInfo^.Username = AUsername then - Result := node; - node := vstAccounts.GetNext(node); - end; -end; - -initialization - {$I UfrmAccountControl.lrs} - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2008 Andreas Schneider + *) +unit UfrmAccountControl; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls, + VirtualTrees, Math, UEnhancedMemoryStream, UEnums; + +type + + { TfrmAccountControl } + + TfrmAccountControl = class(TForm) + ilToolbar: TImageList; + ilAccesslevel: TImageList; + tbMain: TToolBar; + tbRefresh: TToolButton; + tbAddUser: TToolButton; + tbEditUser: TToolButton; + tbDeleteUser: TToolButton; + tbSeparator1: TToolButton; + vstAccounts: TVirtualStringTree; + procedure tbEditUserClick(Sender: TObject); + procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure tbAddUserClick(Sender: TObject); + procedure tbDeleteUserClick(Sender: TObject); + procedure tbRefreshClick(Sender: TObject); + procedure vstAccountsDblClick(Sender: TObject); + procedure vstAccountsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); + procedure vstAccountsGetImageIndex(Sender: TBaseVirtualTree; + Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; + var Ghosted: Boolean; var ImageIndex: Integer); + procedure vstAccountsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); + protected + procedure OnModifyUserResponse(ABuffer: TEnhancedMemoryStream); + procedure OnDeleteUserResponse(ABuffer: TEnhancedMemoryStream); + procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream); + function FindNode(AUsername: string): PVirtualNode; + end; + +var + frmAccountControl: TfrmAccountControl; + +implementation + +uses + UdmNetwork, UPacket, UPacketHandlers, UAdminHandling, UfrmEditAccount; + +type + PAccountInfo = ^TAccountInfo; + TAccountInfo = record + Username: string; + AccessLevel: TAccessLevel; + Regions: TStringList; + end; + + { TModifyUserPacket } + + TModifyUserPacket = class(TPacket) + constructor Create(AUsername, APassword: string; AAccessLevel: TAccessLevel; + ARegions: TStrings); + end; + + { TDeleteUserPacket } + + TDeleteUserPacket = class(TPacket) + constructor Create(AUsername: string); + end; + + { TRequestUserListPacket } + + TRequestUserListPacket = class(TPacket) + constructor Create; + end; + +{ TModifyUserPacket } + +constructor TModifyUserPacket.Create(AUsername, APassword: string; + AAccessLevel: TAccessLevel; ARegions: TStrings); +var + regionCount: Byte; + i: Integer; +begin + inherited Create($03, 0); + FStream.WriteByte($05); + FStream.WriteStringNull(AUsername); + FStream.WriteStringNull(APassword); + FStream.WriteByte(Byte(AAccessLevel)); + + regionCount := Min(ARegions.Count, 256); + FStream.WriteByte(regionCount); + + for i := 0 to regionCount - 1 do + FStream.WriteStringNull(ARegions.Strings[i]); +end; + +{ TDeleteUserPacket } + +constructor TDeleteUserPacket.Create(AUsername: string); +begin + inherited Create($03, 0); + FStream.WriteByte($06); + FStream.WriteStringNull(AUsername); +end; + +{ TRequestUserListPacket } + +constructor TRequestUserListPacket.Create; +begin + inherited Create($03, 0); + FStream.WriteByte($07); +end; + +{ TfrmAccountControl } + +procedure TfrmAccountControl.FormCreate(Sender: TObject); +begin + vstAccounts.NodeDataSize := SizeOf(TAccountInfo); + + AssignAdminPacketHandler($05, TPacketHandler.Create(0, @OnModifyUserResponse)); + AssignAdminPacketHandler($06, TPacketHandler.Create(0, @OnDeleteUserResponse)); + AssignAdminPacketHandler($07, TPacketHandler.Create(0, @OnListUsersPacket)); +end; + +procedure TfrmAccountControl.FormClose(Sender: TObject; + var CloseAction: TCloseAction); +begin + CloseAction := caHide; +end; + +procedure TfrmAccountControl.tbEditUserClick(Sender: TObject); +var + selected: PVirtualNode; + accountInfo: PAccountInfo; + regions: TStrings; +begin + selected := vstAccounts.GetFirstSelected; + if selected <> nil then + begin + accountInfo := vstAccounts.GetNodeData(selected); + with frmEditAccount do + begin + edUsername.Text := accountInfo^.Username; + edUsername.Color := clBtnFace; + edUsername.ReadOnly := True; + edPassword.Text := ''; + lblPasswordHint.Visible := True; + SetAccessLevel(accountInfo^.AccessLevel); + SetRegions(accountInfo^.Regions); + if ShowModal = mrOK then + begin + regions := GetRegions; + dmNetwork.Send(TModifyUserPacket.Create(edUsername.Text, + edPassword.Text, GetAccessLevel, regions)); + regions.Free; + end; + end; + end; +end; + +procedure TfrmAccountControl.FormDestroy(Sender: TObject); +begin + if AdminPacketHandlers[$05] <> nil then FreeAndNil(AdminPacketHandlers[$05]); + if AdminPacketHandlers[$06] <> nil then FreeAndNil(AdminPacketHandlers[$06]); + if AdminPacketHandlers[$07] <> nil then FreeAndNil(AdminPacketHandlers[$07]); +end; + +procedure TfrmAccountControl.FormShow(Sender: TObject); +begin + tbRefreshClick(Sender); +end; + +procedure TfrmAccountControl.tbAddUserClick(Sender: TObject); +var + regions: TStrings; +begin + with frmEditAccount do + begin + edUsername.Text := ''; + edUsername.Color := clWindow; + edUsername.ReadOnly := False; + edPassword.Text := ''; + lblPasswordHint.Visible := False; + cbAccessLevel.ItemIndex := 2; + SetRegions(nil); + if ShowModal = mrOK then + begin + regions := GetRegions; + dmNetwork.Send(TModifyUserPacket.Create(edUsername.Text, edPassword.Text, + GetAccessLevel, regions)); + regions.Free; + end; + end; +end; + +procedure TfrmAccountControl.tbDeleteUserClick(Sender: TObject); +var + selected: PVirtualNode; + accountInfo: PAccountInfo; +begin + selected := vstAccounts.GetFirstSelected; + if selected <> nil then + begin + accountInfo := vstAccounts.GetNodeData(selected); + if MessageDlg('Confirmation', Format('Do you really want to delete "%s"?', + [accountInfo^.Username]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then + dmNetwork.Send(TDeleteUserPacket.Create(accountInfo^.Username)); + end; +end; + +procedure TfrmAccountControl.tbRefreshClick(Sender: TObject); +begin + dmNetwork.Send(TRequestUserListPacket.Create); +end; + +procedure TfrmAccountControl.vstAccountsDblClick(Sender: TObject); +begin + tbEditUserClick(Sender); +end; + +procedure TfrmAccountControl.vstAccountsFreeNode(Sender: TBaseVirtualTree; + Node: PVirtualNode); +var + accountInfo: PAccountInfo; +begin + accountInfo := vstAccounts.GetNodeData(Node); + accountInfo^.Username := ''; + if accountInfo^.Regions <> nil then FreeAndNil(accountInfo^.Regions); +end; + +procedure TfrmAccountControl.vstAccountsGetImageIndex(Sender: TBaseVirtualTree; + Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; + var Ghosted: Boolean; var ImageIndex: Integer); +var + accountInfo: PAccountInfo; +begin + if Column = 0 then + begin + accountInfo := Sender.GetNodeData(Node); + case accountInfo^.AccessLevel of + alNone: ImageIndex := 0; + alView: ImageIndex := 1; + alNormal: ImageIndex := 2; + alAdministrator: ImageIndex := 3; + end; + end; +end; + +procedure TfrmAccountControl.vstAccountsGetText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: String); +var + accountInfo: PAccountInfo; +begin + accountInfo := Sender.GetNodeData(Node); + case Column of + 1: CellText := accountInfo^.Username; + 2: CellText := GetAccessLevelString(accountInfo^.AccessLevel); + else + CellText := ''; + end; +end; + +procedure TfrmAccountControl.OnModifyUserResponse(ABuffer: TEnhancedMemoryStream); +var + node: PVirtualNode; + modifyStatus: TModifyUserStatus; + username: string; + accountInfo: PAccountInfo; + i, regions: Integer; +begin + modifyStatus := TModifyUserStatus(ABuffer.ReadByte); + username := ABuffer.ReadStringNull; + case modifyStatus of + muAdded: + begin + node := vstAccounts.AddChild(nil); + accountInfo := vstAccounts.GetNodeData(node); + accountInfo^.Username := username; + accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte); + accountInfo^.Regions := TStringList.Create; + regions := ABuffer.ReadByte; + for i := 0 to regions - 1 do + accountInfo^.Regions.Add(ABuffer.ReadStringNull); + + Messagedlg('Success', Format('The user "%s" has been added.', [username]), + mtInformation, [mbOK], 0); + end; + muModified: + begin + node := FindNode(username); + if node <> nil then + begin + accountInfo := vstAccounts.GetNodeData(node); + accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte); + accountInfo^.Regions.Clear; + regions := ABuffer.ReadByte; + for i := 0 to regions - 1 do + accountInfo^.Regions.Add(ABuffer.ReadStringNull); + + Messagedlg('Success', Format('The user "%s" has been modified.', [username]), + mtInformation, [mbOK], 0); + end; + end; + muInvalidUsername: + MessageDlg('Error', Format('The username "%s" is not valid.', [username]), + mtError, [mbOK], 0); + end; +end; + +procedure TfrmAccountControl.OnDeleteUserResponse(ABuffer: TEnhancedMemoryStream); +var + node: PVirtualNode; + deleteStatus: TDeleteUserStatus; + username: string; +begin + deleteStatus := TDeleteUserStatus(ABuffer.ReadByte); + username := ABuffer.ReadStringNull; + case deleteStatus of + duDeleted: + begin + node := FindNode(username); + if node <> nil then + begin + vstAccounts.DeleteNode(node); + Messagedlg('Success', Format('The user "%s" has been deleted.', [username]), + mtInformation, [mbOK], 0); + end; + end; + duNotFound: + MessageDlg('Error', Format('The user "%s" could not be deleted. Maybe ' + + 'your list is out of date or you tried to delete yourself.', [username]), + mtError, [mbOK], 0); + end; +end; + +procedure TfrmAccountControl.OnListUsersPacket(ABuffer: TEnhancedMemoryStream); +var + node: PVirtualNode; + accountInfo: PAccountInfo; + i, j, count, regions: Integer; +begin + vstAccounts.BeginUpdate; + vstAccounts.Clear; + count := ABuffer.ReadWord; + for i := 1 to count do + begin + node := vstAccounts.AddChild(nil); + accountInfo := vstAccounts.GetNodeData(node); + accountInfo^.Username := ABuffer.ReadStringNull; + accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte); + accountInfo^.Regions := TStringList.Create; + regions := ABuffer.ReadByte; + for j := 0 to regions - 1 do + accountInfo^.Regions.Add(ABuffer.ReadStringNull); + end; + vstAccounts.EndUpdate; +end; + +function TfrmAccountControl.FindNode(AUsername: string): PVirtualNode; +var + node: PVirtualNode; + accountInfo: PAccountInfo; +begin + Result := nil; + node := vstAccounts.GetFirst; + while (node <> nil) and (Result = nil) do + begin + accountInfo := vstAccounts.GetNodeData(node); + if accountInfo^.Username = AUsername then + Result := node; + node := vstAccounts.GetNext(node); + end; +end; + +initialization + {$I UfrmAccountControl.lrs} + +end. + diff --git a/Client/UfrmEditAccount.lfm b/Client/UfrmEditAccount.lfm index 5fe1e4b..e6e3549 100644 --- a/Client/UfrmEditAccount.lfm +++ b/Client/UfrmEditAccount.lfm @@ -1,167 +1,167 @@ -object frmEditAccount: TfrmEditAccount - Left = 290 - Height = 214 - Top = 171 - Width = 261 - ActiveControl = PageControl1 - BorderIcons = [biSystemMenu] - BorderStyle = bsDialog - Caption = 'Edit Account' - ClientHeight = 214 - ClientWidth = 261 - Font.Height = -11 - OnCreate = FormCreate - OnDestroy = FormDestroy - OnShow = FormShow - ParentFont = False - Position = poOwnerFormCenter - LCLVersion = '0.9.27' - object PageControl1: TPageControl - Height = 173 - Width = 261 - ActivePage = tsGeneral - Align = alClient - TabIndex = 0 - TabOrder = 0 - object tsGeneral: TTabSheet - Caption = 'General' - ClientHeight = 148 - ClientWidth = 259 - object lblPasswordHint: TLabel - Left = 86 - Height = 28 - Top = 64 - Width = 160 - AutoSize = False - Caption = 'Leave empty to leave the password unchanged.' - Enabled = False - ParentColor = False - WordWrap = True - end - object lblUsername: TLabel - Left = 6 - Height = 14 - Top = 12 - Width = 58 - Caption = 'Username:' - ParentColor = False - end - object lblPassword: TLabel - Left = 6 - Height = 14 - Top = 44 - Width = 54 - Caption = 'Password:' - ParentColor = False - end - object lblAccessLevel: TLabel - Left = 6 - Height = 14 - Top = 108 - Width = 63 - Caption = 'Accesslevel:' - ParentColor = False - end - object edUsername: TEdit - Left = 86 - Height = 23 - Top = 8 - Width = 160 - Color = clBtnFace - ReadOnly = True - TabOrder = 0 - end - object edPassword: TEdit - Left = 86 - Height = 23 - Top = 40 - Width = 160 - EchoMode = emPassword - PasswordChar = '*' - TabOrder = 1 - end - object cbAccessLevel: TComboBox - Left = 86 - Height = 25 - Top = 104 - Width = 160 - Items.Strings = ( - 'None' - 'Viewer' - 'Normal' - 'Administrator' - ) - Style = csDropDownList - TabOrder = 2 - end - end - object tsRegions: TTabSheet - Caption = 'Regions' - ClientHeight = 148 - ClientWidth = 259 - object Label1: TLabel - Left = 8 - Height = 14 - Top = 8 - Width = 243 - Align = alTop - BorderSpacing.Left = 8 - BorderSpacing.Top = 8 - BorderSpacing.Right = 8 - BorderSpacing.Bottom = 4 - Caption = 'Allowed Regions:' - ParentColor = False - end - object cbRegions: TCheckListBox - Left = 8 - Height = 114 - Top = 26 - Width = 243 - Align = alClient - BorderSpacing.Left = 8 - BorderSpacing.Top = 4 - BorderSpacing.Right = 8 - BorderSpacing.Bottom = 8 - ItemHeight = 13 - TabOrder = 0 - TopIndex = -1 - end - end - end - object Panel1: TPanel - Left = 8 - Height = 25 - Top = 181 - Width = 245 - Align = alBottom - BorderSpacing.Around = 8 - BevelOuter = bvNone - ClientHeight = 25 - ClientWidth = 245 - TabOrder = 1 - object btnCancel: TButton - Left = 170 - Height = 25 - Width = 75 - Align = alRight - BorderSpacing.Left = 4 - BorderSpacing.InnerBorder = 4 - Cancel = True - Caption = 'Cancel' - ModalResult = 2 - TabOrder = 0 - end - object btnOK: TButton - Left = 91 - Height = 25 - Width = 75 - Align = alRight - BorderSpacing.Right = 4 - BorderSpacing.InnerBorder = 4 - Caption = 'OK' - Default = True - ModalResult = 1 - TabOrder = 1 - end - end -end +object frmEditAccount: TfrmEditAccount + Left = 290 + Height = 214 + Top = 171 + Width = 261 + ActiveControl = PageControl1 + BorderIcons = [biSystemMenu] + BorderStyle = bsDialog + Caption = 'Edit Account' + ClientHeight = 214 + ClientWidth = 261 + Font.Height = -11 + OnCreate = FormCreate + OnDestroy = FormDestroy + OnShow = FormShow + ParentFont = False + Position = poOwnerFormCenter + LCLVersion = '0.9.27' + object PageControl1: TPageControl + Height = 173 + Width = 261 + ActivePage = tsGeneral + Align = alClient + TabIndex = 0 + TabOrder = 0 + object tsGeneral: TTabSheet + Caption = 'General' + ClientHeight = 148 + ClientWidth = 259 + object lblPasswordHint: TLabel + Left = 86 + Height = 28 + Top = 64 + Width = 160 + AutoSize = False + Caption = 'Leave empty to leave the password unchanged.' + Enabled = False + ParentColor = False + WordWrap = True + end + object lblUsername: TLabel + Left = 6 + Height = 14 + Top = 12 + Width = 58 + Caption = 'Username:' + ParentColor = False + end + object lblPassword: TLabel + Left = 6 + Height = 14 + Top = 44 + Width = 54 + Caption = 'Password:' + ParentColor = False + end + object lblAccessLevel: TLabel + Left = 6 + Height = 14 + Top = 108 + Width = 63 + Caption = 'Accesslevel:' + ParentColor = False + end + object edUsername: TEdit + Left = 86 + Height = 23 + Top = 8 + Width = 160 + Color = clBtnFace + ReadOnly = True + TabOrder = 0 + end + object edPassword: TEdit + Left = 86 + Height = 23 + Top = 40 + Width = 160 + EchoMode = emPassword + PasswordChar = '*' + TabOrder = 1 + end + object cbAccessLevel: TComboBox + Left = 86 + Height = 25 + Top = 104 + Width = 160 + Items.Strings = ( + 'None' + 'Viewer' + 'Normal' + 'Administrator' + ) + Style = csDropDownList + TabOrder = 2 + end + end + object tsRegions: TTabSheet + Caption = 'Regions' + ClientHeight = 148 + ClientWidth = 259 + object Label1: TLabel + Left = 8 + Height = 14 + Top = 8 + Width = 243 + Align = alTop + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 4 + Caption = 'Allowed Regions:' + ParentColor = False + end + object cbRegions: TCheckListBox + Left = 8 + Height = 114 + Top = 26 + Width = 243 + Align = alClient + BorderSpacing.Left = 8 + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ItemHeight = 13 + TabOrder = 0 + TopIndex = -1 + end + end + end + object Panel1: TPanel + Left = 8 + Height = 25 + Top = 181 + Width = 245 + Align = alBottom + BorderSpacing.Around = 8 + BevelOuter = bvNone + ClientHeight = 25 + ClientWidth = 245 + TabOrder = 1 + object btnCancel: TButton + Left = 170 + Height = 25 + Width = 75 + Align = alRight + BorderSpacing.Left = 4 + BorderSpacing.InnerBorder = 4 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 0 + end + object btnOK: TButton + Left = 91 + Height = 25 + Width = 75 + Align = alRight + BorderSpacing.Right = 4 + BorderSpacing.InnerBorder = 4 + Caption = 'OK' + Default = True + ModalResult = 1 + TabOrder = 1 + end + end +end diff --git a/Client/UfrmInitialize.lfm b/Client/UfrmInitialize.lfm index b2614e8..10afafb 100644 --- a/Client/UfrmInitialize.lfm +++ b/Client/UfrmInitialize.lfm @@ -1,40 +1,40 @@ -object frmInitialize: TfrmInitialize - Left = 290 - Height = 65 - Top = 171 - Width = 241 - BorderIcons = [] - BorderStyle = bsDialog - Caption = 'Please wait ...' - ClientHeight = 65 - ClientWidth = 241 - Font.Height = -11 - OnClose = FormClose - OnCreate = FormCreate - Position = poScreenCenter - LCLVersion = '0.9.25' - object pnlMain: TPanel - Left = 8 - Height = 50 - Top = 8 - Width = 226 - BevelInner = bvRaised - BevelOuter = bvLowered - ClientHeight = 50 - ClientWidth = 226 - ParentFont = True - TabOrder = 0 - object lblStatus: TLabel - Left = 8 - Height = 32 - Top = 8 - Width = 208 - Alignment = taCenter - AutoSize = False - Layout = tlCenter - ParentColor = False - ParentFont = True - WordWrap = True - end - end -end +object frmInitialize: TfrmInitialize + Left = 290 + Height = 65 + Top = 171 + Width = 241 + BorderIcons = [] + BorderStyle = bsDialog + Caption = 'Please wait ...' + ClientHeight = 65 + ClientWidth = 241 + Font.Height = -11 + OnClose = FormClose + OnCreate = FormCreate + Position = poScreenCenter + LCLVersion = '0.9.25' + object pnlMain: TPanel + Left = 8 + Height = 50 + Top = 8 + Width = 226 + BevelInner = bvRaised + BevelOuter = bvLowered + ClientHeight = 50 + ClientWidth = 226 + ParentFont = True + TabOrder = 0 + object lblStatus: TLabel + Left = 8 + Height = 32 + Top = 8 + Width = 208 + Alignment = taCenter + AutoSize = False + Layout = tlCenter + ParentColor = False + ParentFont = True + WordWrap = True + end + end +end diff --git a/Client/UfrmInitialize.pas b/Client/UfrmInitialize.pas index 4324f75..0fefdd1 100644 --- a/Client/UfrmInitialize.pas +++ b/Client/UfrmInitialize.pas @@ -1,96 +1,96 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2007 Andreas Schneider - *) -unit UfrmInitialize; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls, - StdCtrls, LCLIntf, LCLType, WSForms; - -type - - { TfrmInitialize } - - TfrmInitialize = class(TForm) - lblStatus: TLabel; - pnlMain: TPanel; - procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); - procedure FormCreate(Sender: TObject); - protected - FActiveWindow: HWND; - FModal: Boolean; - public - procedure SetModal; - procedure UnsetModal; - end; - -var - frmInitialize: TfrmInitialize; - -implementation - -{ TfrmInitialize } - -procedure TfrmInitialize.FormClose(Sender: TObject; - var CloseAction: TCloseAction); -begin - CloseAction := caNone; -end; - -procedure TfrmInitialize.FormCreate(Sender: TObject); -begin - FModal := False; -end; - -procedure TfrmInitialize.SetModal; -begin - if FModal then Exit; - FActiveWindow := GetActiveWindow; - TWSCustomFormClass(WidgetSetClass).ShowModal(Self); - {FormStyle := fsStayOnTop; - Screen.MoveFormToFocusFront(Self); - Screen.MoveFormToZFront(Self);} - FModal := True; -end; - -procedure TfrmInitialize.UnsetModal; -begin - if not FModal then Exit; - TWSCustomFormClass(WidgetSetClass).CloseModal(Self); - if FActiveWindow <> 0 then SetActiveWindow(FActiveWindow); - FActiveWindow := 0; - //FormStyle := fsNormal; - FModal := False; -end; - -initialization - {$I UfrmInitialize.lrs} - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2007 Andreas Schneider + *) +unit UfrmInitialize; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls, + StdCtrls, LCLIntf, LCLType, WSForms; + +type + + { TfrmInitialize } + + TfrmInitialize = class(TForm) + lblStatus: TLabel; + pnlMain: TPanel; + procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); + procedure FormCreate(Sender: TObject); + protected + FActiveWindow: HWND; + FModal: Boolean; + public + procedure SetModal; + procedure UnsetModal; + end; + +var + frmInitialize: TfrmInitialize; + +implementation + +{ TfrmInitialize } + +procedure TfrmInitialize.FormClose(Sender: TObject; + var CloseAction: TCloseAction); +begin + CloseAction := caNone; +end; + +procedure TfrmInitialize.FormCreate(Sender: TObject); +begin + FModal := False; +end; + +procedure TfrmInitialize.SetModal; +begin + if FModal then Exit; + FActiveWindow := GetActiveWindow; + TWSCustomFormClass(WidgetSetClass).ShowModal(Self); + {FormStyle := fsStayOnTop; + Screen.MoveFormToFocusFront(Self); + Screen.MoveFormToZFront(Self);} + FModal := True; +end; + +procedure TfrmInitialize.UnsetModal; +begin + if not FModal then Exit; + TWSCustomFormClass(WidgetSetClass).CloseModal(Self); + if FActiveWindow <> 0 then SetActiveWindow(FActiveWindow); + FActiveWindow := 0; + //FormStyle := fsNormal; + FModal := False; +end; + +initialization + {$I UfrmInitialize.lrs} + +end. + diff --git a/Client/UfrmLargeScaleCommand.lfm b/Client/UfrmLargeScaleCommand.lfm index 0864105..58d64aa 100644 --- a/Client/UfrmLargeScaleCommand.lfm +++ b/Client/UfrmLargeScaleCommand.lfm @@ -1,1573 +1,1573 @@ -object frmLargeScaleCommand: TfrmLargeScaleCommand - Left = 290 - Height = 390 - Top = 171 - Width = 620 - ActiveControl = vstActions - Caption = 'Large Scale Commands' - ClientHeight = 390 - ClientWidth = 620 - Constraints.MinHeight = 390 - Constraints.MinWidth = 620 - Font.Height = -11 - OnCreate = FormCreate - OnDestroy = FormDestroy - OnShow = FormShow - Position = poOwnerFormCenter - ShowInTaskBar = stAlways - LCLVersion = '0.9.29' - object nbActions: TNotebook - AnchorSideLeft.Control = vstActions - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = Owner - AnchorSideRight.Control = Owner - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = btnClose - Left = 152 - Height = 349 - Top = 0 - Width = 468 - Anchors = [akTop, akLeft, akRight, akBottom] - PageIndex = 1 - ShowTabs = False - TabOrder = 0 - object pgArea: TPage - Caption = 'pgArea' - ClientWidth = 462 - ClientHeight = 316 - object sbArea: TScrollBox - Left = 0 - Height = 316 - Top = 0 - Width = 462 - Align = alClient - ClientHeight = 314 - ClientWidth = 460 - TabOrder = 0 - object pbArea: TPaintBox - Left = 0 - Height = 105 - Top = 0 - Width = 105 - OnMouseDown = pbAreaMouseDown - OnMouseMove = pbAreaMouseMove - OnPaint = pbAreaPaint - end - end - end - object pgCopyMove: TPage - Caption = 'Copy/Move' - ClientWidth = 462 - ClientHeight = 343 - object rgCMAction: TRadioGroup - AnchorSideLeft.Control = pgCopyMove - AnchorSideTop.Control = pgCopyMove - Left = 8 - Height = 40 - Top = 8 - Width = 184 - AutoFill = True - BorderSpacing.Around = 8 - Caption = 'Action' - ChildSizing.LeftRightSpacing = 6 - ChildSizing.TopBottomSpacing = 6 - ChildSizing.EnlargeHorizontal = crsHomogenousChildResize - ChildSizing.EnlargeVertical = crsHomogenousChildResize - ChildSizing.ShrinkHorizontal = crsScaleChilds - ChildSizing.ShrinkVertical = crsScaleChilds - ChildSizing.Layout = cclLeftToRightThenTopToBottom - ChildSizing.ControlsPerLine = 2 - ClientHeight = 26 - ClientWidth = 182 - Columns = 2 - ItemIndex = 0 - Items.Strings = ( - 'Copy' - 'Move' - ) - TabOrder = 0 - end - object gbCMOffset: TGroupBox - AnchorSideLeft.Control = rgCMAction - AnchorSideTop.Control = rgCMAction - AnchorSideTop.Side = asrBottom - Left = 8 - Height = 81 - Top = 56 - Width = 121 - Caption = 'Offset' - ClientHeight = 67 - ClientWidth = 119 - TabOrder = 1 - object Label9: TLabel - AnchorSideLeft.Control = gbCMOffset - AnchorSideTop.Control = seCMOffsetX - AnchorSideTop.Side = asrCenter - Left = 8 - Height = 14 - Top = 10 - Width = 11 - BorderSpacing.Around = 8 - Caption = 'X:' - ParentColor = False - end - object Label10: TLabel - AnchorSideLeft.Control = Label9 - AnchorSideTop.Control = seCMOffsetY - AnchorSideTop.Side = asrCenter - Left = 8 - Height = 14 - Top = 37 - Width = 10 - Caption = 'Y:' - ParentColor = False - end - object seCMOffsetX: TSpinEdit - AnchorSideLeft.Control = Label9 - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = gbCMOffset - AnchorSideRight.Control = btnGrabOffset - Left = 27 - Height = 19 - Top = 8 - Width = 62 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Top = 4 - BorderSpacing.Bottom = 4 - BorderSpacing.Around = 4 - TabOrder = 0 - end - object seCMOffsetY: TSpinEdit - AnchorSideLeft.Control = seCMOffsetX - AnchorSideTop.Control = seCMOffsetX - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = seCMOffsetX - AnchorSideRight.Side = asrBottom - Left = 27 - Height = 19 - Top = 35 - Width = 62 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Bottom = 8 - TabOrder = 1 - end - object btnGrabOffset: TSpeedButton - AnchorSideTop.Control = gbCMOffset - AnchorSideTop.Side = asrCenter - AnchorSideRight.Control = gbCMOffset - AnchorSideRight.Side = asrBottom - Left = 93 - Height = 22 - Hint = 'Grab coordinates and calculate the offset in relation to the selected area.' - Top = 22 - Width = 22 - Anchors = [akTop, akRight] - BorderSpacing.Around = 4 - Color = clBtnFace - Enabled = False - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F7F7F067C7C - 7CE6787878CC75757581FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383835DAAAA - AAFFDBDBDBFF797979F275757506FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF0097979709FFFFFF00FFFFFF00FFFFFF00888888E7DBDB - DBFFB7B7B7FF7D7D7D80FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF009C9C9CC99898981EFFFFFF0090909050ADADADFFF2F2 - F2FF848484FD8181810FFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00A0A0A0FF9C9C9CE798989836949494DFD9D9D9FFC1C1 - C1FF898989A0FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00A4A4A4FFD7D7D7FF9D9D9DF8D0D0D0FFEEEEEEFF9191 - 91FE8D8D8D18FFFFFF00FFFFFF00818181097E7E7E09FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00A9A9A9FFF2F2F2FFE5E5E5FFE2E2E2FFE3E3E3FF9595 - 95F4919191CC8D8D8DF9898989FF86868693FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00ADADADFFEEEEEEFFE1E1E1FFDFDFDFFFE0E0E0FFE7E7 - E7FFE4E4E4FFBBBBBBFF8E8E8E93FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00B1B1B1FFF0F0F0FFE4E4E4FFE2E2E2FFE2E2E2FFE7E7 - E7FFC1C1C1FF96969690FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00B5B5B5FFF2F2F2FFE8E8E8FFE7E7E7FFEAEAEAFFC6C6 - C6FF9E9E9E8DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00B9B9B9FFF4F4F4FFECECECFFEDEDEDFFCBCBCBFFA7A7 - A78AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00BDBDBDFFF7F7F7FFEFEFEFFFD0D0D0FFAFAFAF8AFFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00C1C1C1FFF7F7F7FFD5D5D5FFB6B6B687FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00C4C4C4FFD9D9D9FFBEBEBE84FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00C8C8C8FFC5C5C581FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00CBCBCB7EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - NumGlyphs = 0 - OnClick = btnGrabOffsetClick - ShowHint = True - ParentShowHint = False - end - end - object cbCMEraseTarget: TCheckBox - AnchorSideLeft.Control = gbCMOffset - AnchorSideTop.Control = gbCMOffset - AnchorSideTop.Side = asrBottom - Left = 8 - Height = 22 - Top = 145 - Width = 170 - BorderSpacing.Top = 8 - Caption = 'Erase target area (at offset)' - TabOrder = 2 - end - end - object pgModifyAltitude: TPage - Caption = 'Modify altitude' - ClientWidth = 462 - ClientHeight = 316 - object Label2: TLabel - AnchorSideLeft.Control = rbSetTerrainAltitude - AnchorSideTop.Control = rbSetTerrainAltitude - AnchorSideTop.Side = asrBottom - Left = 30 - Height = 46 - Top = 30 - Width = 142 - BorderSpacing.Left = 22 - Caption = 'The statics will be elevated according to the terrain change.' - Enabled = False - ParentColor = False - WordWrap = True - end - object Label3: TLabel - AnchorSideTop.Control = rbSetTerrainAltitude - Left = 228 - Height = 30 - Top = 8 - Width = 125 - Caption = 'Set the altitude to a value from this range:' - ParentColor = False - WordWrap = True - end - object Label4: TLabel - AnchorSideLeft.Control = seTerrainAltitude1 - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = seTerrainAltitude1 - AnchorSideTop.Side = asrCenter - Left = 286 - Height = 14 - Top = 48 - Width = 12 - BorderSpacing.Left = 8 - Caption = 'to' - ParentColor = False - end - object rbSetTerrainAltitude: TRadioButton - AnchorSideLeft.Control = pgModifyAltitude - AnchorSideTop.Control = pgModifyAltitude - Left = 8 - Height = 22 - Top = 8 - Width = 123 - BorderSpacing.Left = 8 - BorderSpacing.Top = 8 - Caption = 'Set terrain altitude' - Checked = True - State = cbChecked - TabOrder = 0 - end - object rbRelativeAltitudeChange: TRadioButton - AnchorSideLeft.Control = rbSetTerrainAltitude - AnchorSideTop.Control = Label2 - AnchorSideTop.Side = asrBottom - Left = 8 - Height = 22 - Top = 84 - Width = 153 - BorderSpacing.Top = 8 - Caption = 'Relative altitude change' - TabOrder = 1 - TabStop = False - end - object seTerrainAltitude1: TSpinEdit - AnchorSideLeft.Control = Label3 - AnchorSideTop.Control = Label3 - AnchorSideTop.Side = asrBottom - Left = 228 - Height = 19 - Top = 46 - Width = 50 - BorderSpacing.Top = 8 - MaxValue = 127 - MinValue = -128 - TabOrder = 2 - end - object seTerrainAltitude2: TSpinEdit - AnchorSideLeft.Control = Label4 - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = seTerrainAltitude1 - Left = 306 - Height = 19 - Top = 46 - Width = 50 - BorderSpacing.Left = 8 - MaxValue = 127 - MinValue = -128 - TabOrder = 3 - end - object seRelativeAltitude: TSpinEdit - AnchorSideLeft.Control = Label2 - AnchorSideTop.Control = rbRelativeAltitudeChange - AnchorSideTop.Side = asrBottom - Left = 30 - Height = 19 - Top = 106 - Width = 50 - MaxValue = 127 - MinValue = -128 - TabOrder = 4 - end - end - object pgDrawTerrain: TPage - Caption = 'Draw Terrain' - ClientWidth = 462 - ClientHeight = 316 - object gbDrawTerrainTiles: TGroupBox - AnchorSideLeft.Control = pgDrawTerrain - AnchorSideTop.Control = pgDrawTerrain - AnchorSideBottom.Control = pgDrawTerrain - AnchorSideBottom.Side = asrBottom - Left = 8 - Height = 300 - Top = 8 - Width = 225 - Anchors = [akTop, akLeft, akBottom] - BorderSpacing.Around = 8 - Caption = 'Tiles' - ClientHeight = 286 - ClientWidth = 223 - TabOrder = 0 - object lblDrawTerrainTilesDesc: TLabel - AnchorSideLeft.Control = gbDrawTerrainTiles - AnchorSideTop.Control = gbDrawTerrainTiles - AnchorSideRight.Control = gbDrawTerrainTiles - Left = 4 - Height = 62 - Top = 0 - Width = 215 - BorderSpacing.Left = 4 - BorderSpacing.Right = 4 - BorderSpacing.Bottom = 4 - Caption = 'Drag terrain tiles from the main window and drop them on the list. For each cell in the target area, one of these (random) will be used.' - ParentColor = False - WordWrap = True - end - object vdtTerrainTiles: TVirtualDrawTree - Tag = 1 - AnchorSideLeft.Control = gbDrawTerrainTiles - AnchorSideTop.Control = lblDrawTerrainTilesDesc - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = gbDrawTerrainTiles - AnchorSideBottom.Control = btnDeleteTerrain - Cursor = 63 - Left = 4 - Height = 200 - Top = 66 - Width = 215 - Anchors = [akTop, akLeft, akBottom] - BorderSpacing.Left = 4 - BorderSpacing.Right = 4 - BorderSpacing.Bottom = 4 - DefaultNodeHeight = 44 - DragMode = dmAutomatic - DragType = dtVCL - Header.AutoSizeIndex = 0 - Header.Columns = < - item - Position = 0 - Text = 'ID' - end - item - Position = 1 - Text = 'Tile' - Width = 44 - end - item - Position = 2 - Text = 'Name' - Width = 100 - end> - Header.DefaultHeight = 17 - Header.Options = [hoColumnResize, hoDrag, hoVisible] - Header.ParentFont = True - Header.Style = hsFlatButtons - TabOrder = 0 - TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toFullRowDrag] - TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] - TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect] - OnDragOver = vdtTerrainTilesDragOver - OnDragDrop = vdtTerrainTilesDragDrop - OnDrawNode = vdtTerrainTilesDrawNode - end - object btnClearTerrain: TSpeedButton - AnchorSideLeft.Control = btnDeleteTerrain - AnchorSideLeft.Side = asrBottom - AnchorSideBottom.Control = btnDeleteTerrain - AnchorSideBottom.Side = asrBottom - Left = 30 - Height = 22 - Hint = 'Clear' - Top = 270 - Width = 22 - Anchors = [akLeft, akBottom] - Color = clBtnFace - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000 - EFFF0000EDFF0000EDFF00000000000000000000000000000000000000000000 - 0000000000000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443 - F7FF3242F7FF141BF1FF0000EDFF000000000000000000000000000000000000 - 00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909 - F5FF161BF5FF3343F7FF141BF1FF0000EDFF0000000000000000000000000000 - F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333 - F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF00000000000000000000 - FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA - FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF00000000000000000000 - FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1 - FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00000000000000000000 - FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC - FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF00000000000000000000 - FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC - FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF00000000000000000000 - FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2 - FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FF00000000000000000000 - FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC - FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000000000000000 - FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B - FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000 - 00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D - FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000 - 0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663 - FEFF5461FEFF2227FCFF0000FBFF000000000000000000000000000000000000 - 000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000 - FDFF0000FDFF0000FDFF00000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000 - } - NumGlyphs = 0 - OnClick = btnClearTerrainClick - ShowHint = True - ParentShowHint = False - end - object btnDeleteTerrain: TSpeedButton - AnchorSideLeft.Control = gbDrawTerrainTiles - AnchorSideBottom.Control = gbDrawTerrainTiles - AnchorSideBottom.Side = asrBottom - Left = 4 - Height = 22 - Hint = 'Delete' - Top = 270 - Width = 22 - Anchors = [akLeft, akBottom] - BorderSpacing.Around = 4 - Color = clBtnFace - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000003853BEFF3551BDFF304BBCFF2E4E - B8FF000000000000000000000000000000000000000000000000000000000000 - 000000000000000000004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178 - E4FF334DC1FF2B4AB7FF00000000000000000000000000000000000000000000 - 0000000000004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84 - EEFF9EA0F4FF515DD7FF2B4AB7FF000000000000000000000000000000000000 - 00005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56 - E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FF0000000000000000000000000000 - 00004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59 - E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF0000000000000000000000005C62 - D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59 - E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF00000000000000005F63 - DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF00000000000000006469 - DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF0000000000000000676A - DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F - ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF00000000000000000000 - 00007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84 - F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF0000000000000000000000000000 - 00006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92 - F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF0000000000000000000000000000 - 0000000000006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9 - FBFFBAC7FCFF707BE9FF4C5BCCFF000000000000000000000000000000000000 - 000000000000000000006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4 - F4FF6670E2FF535ED1FF00000000000000000000000000000000000000000000 - 000000000000000000000000000000000000686ADDFF6364DCFF6164DAFF5D63 - D9FF000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000 - } - NumGlyphs = 0 - OnClick = btnDeleteTerrainClick - ShowHint = True - ParentShowHint = False - end - end - end - object pgDeleteStatics: TPage - Caption = 'Delete statics' - ClientWidth = 462 - ClientHeight = 316 - object gbDeleteStaticsTiles: TGroupBox - AnchorSideLeft.Control = pgDeleteStatics - AnchorSideTop.Control = pgDeleteStatics - AnchorSideBottom.Control = pgDeleteStatics - AnchorSideBottom.Side = asrBottom - Left = 8 - Height = 300 - Top = 8 - Width = 225 - Anchors = [akTop, akLeft, akBottom] - BorderSpacing.Around = 8 - Caption = 'Tiles' - ClientHeight = 286 - ClientWidth = 223 - TabOrder = 0 - object lblDeleteStaticsTilesDesc: TLabel - AnchorSideLeft.Control = gbDeleteStaticsTiles - AnchorSideTop.Control = gbDeleteStaticsTiles - AnchorSideRight.Control = gbDeleteStaticsTiles - AnchorSideRight.Side = asrBottom - Left = 4 - Height = 78 - Top = 0 - Width = 213 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Left = 4 - BorderSpacing.Right = 4 - BorderSpacing.Bottom = 4 - Caption = 'Drag statics tiles from the main window and drop them on the list. Only statics matching these tiles will be deleted. If the list is empty, every static will be deleted.' - ParentColor = False - WordWrap = True - end - object vdtDeleteStaticsTiles: TVirtualDrawTree - Tag = 1 - AnchorSideLeft.Control = gbDeleteStaticsTiles - AnchorSideTop.Control = lblDeleteStaticsTilesDesc - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = gbDeleteStaticsTiles - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = btnDeleteDStaticsTiles - Cursor = 63 - Left = 4 - Height = 184 - Top = 82 - Width = 213 - Anchors = [akTop, akLeft, akRight, akBottom] - BorderSpacing.Left = 4 - BorderSpacing.Right = 4 - BorderSpacing.Bottom = 4 - DefaultNodeHeight = 44 - DragMode = dmAutomatic - DragType = dtVCL - Header.AutoSizeIndex = 0 - Header.Columns = < - item - Position = 0 - Text = 'ID' - end - item - Position = 1 - Text = 'Tile' - Width = 44 - end - item - Position = 2 - Text = 'Name' - Width = 100 - end> - Header.DefaultHeight = 17 - Header.Options = [hoColumnResize, hoDrag, hoVisible] - Header.ParentFont = True - Header.Style = hsFlatButtons - TabOrder = 0 - TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toFullRowDrag] - TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] - TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect] - OnDragOver = vdtTerrainTilesDragOver - OnDragDrop = vdtTerrainTilesDragDrop - OnDrawNode = vdtTerrainTilesDrawNode - end - object btnClearDStaticsTiles: TSpeedButton - AnchorSideLeft.Control = btnDeleteDStaticsTiles - AnchorSideLeft.Side = asrBottom - AnchorSideBottom.Control = btnDeleteDStaticsTiles - AnchorSideBottom.Side = asrBottom - Left = 30 - Height = 22 - Hint = 'Clear' - Top = 270 - Width = 22 - Anchors = [akLeft, akBottom] - Color = clBtnFace - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000 - EFFF0000EDFF0000EDFF00000000000000000000000000000000000000000000 - 0000000000000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443 - F7FF3242F7FF141BF1FF0000EDFF000000000000000000000000000000000000 - 00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909 - F5FF161BF5FF3343F7FF141BF1FF0000EDFF0000000000000000000000000000 - F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333 - F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF00000000000000000000 - FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA - FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF00000000000000000000 - FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1 - FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00000000000000000000 - FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC - FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF00000000000000000000 - FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC - FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF00000000000000000000 - FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2 - FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FF00000000000000000000 - FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC - FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000000000000000 - FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B - FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000 - 00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D - FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000 - 0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663 - FEFF5461FEFF2227FCFF0000FBFF000000000000000000000000000000000000 - 000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000 - FDFF0000FDFF0000FDFF00000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000 - } - NumGlyphs = 0 - OnClick = btnClearDStaticsTilesClick - ShowHint = True - ParentShowHint = False - end - object btnDeleteDStaticsTiles: TSpeedButton - AnchorSideLeft.Control = gbDeleteStaticsTiles - AnchorSideBottom.Control = gbDeleteStaticsTiles - AnchorSideBottom.Side = asrBottom - Left = 4 - Height = 22 - Hint = 'Delete' - Top = 270 - Width = 22 - Anchors = [akLeft, akBottom] - BorderSpacing.Around = 4 - Color = clBtnFace - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000003853BEFF3551BDFF304BBCFF2E4E - B8FF000000000000000000000000000000000000000000000000000000000000 - 000000000000000000004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178 - E4FF334DC1FF2B4AB7FF00000000000000000000000000000000000000000000 - 0000000000004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84 - EEFF9EA0F4FF515DD7FF2B4AB7FF000000000000000000000000000000000000 - 00005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56 - E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FF0000000000000000000000000000 - 00004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59 - E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF0000000000000000000000005C62 - D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59 - E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF00000000000000005F63 - DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF00000000000000006469 - DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF0000000000000000676A - DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F - ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF00000000000000000000 - 00007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84 - F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF0000000000000000000000000000 - 00006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92 - F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF0000000000000000000000000000 - 0000000000006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9 - FBFFBAC7FCFF707BE9FF4C5BCCFF000000000000000000000000000000000000 - 000000000000000000006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4 - F4FF6670E2FF535ED1FF00000000000000000000000000000000000000000000 - 000000000000000000000000000000000000686ADDFF6364DCFF6164DAFF5D63 - D9FF000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000 - } - NumGlyphs = 0 - OnClick = btnDeleteDStaticsTilesClick - ShowHint = True - ParentShowHint = False - end - end - object GroupBox1: TGroupBox - AnchorSideLeft.Control = gbDeleteStaticsTiles - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = gbDeleteStaticsTiles - Left = 241 - Height = 79 - Top = 8 - Width = 176 - AutoSize = True - Caption = 'Z Boundaries' - ClientHeight = 65 - ClientWidth = 174 - TabOrder = 1 - object Label7: TLabel - AnchorSideLeft.Control = GroupBox1 - AnchorSideTop.Control = GroupBox1 - AnchorSideRight.Control = GroupBox1 - AnchorSideRight.Side = asrBottom - Left = 4 - Height = 30 - Top = 0 - Width = 164 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Left = 4 - BorderSpacing.Right = 4 - BorderSpacing.Bottom = 4 - Caption = 'Only statics within this Z range will be deleted.' - ParentColor = False - WordWrap = True - end - object Label8: TLabel - AnchorSideLeft.Control = seDeleteStaticsZ1 - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = seDeleteStaticsZ1 - AnchorSideTop.Side = asrCenter - Left = 62 - Height = 14 - Top = 40 - Width = 12 - Caption = 'to' - ParentColor = False - end - object seDeleteStaticsZ1: TSpinEdit - AnchorSideTop.Control = Label7 - AnchorSideTop.Side = asrBottom - Left = 4 - Height = 19 - Top = 38 - Width = 50 - BorderSpacing.Around = 8 - MaxValue = 127 - MinValue = -128 - TabOrder = 0 - Value = -128 - end - object seDeleteStaticsZ2: TSpinEdit - AnchorSideLeft.Control = Label8 - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = seDeleteStaticsZ1 - Left = 82 - Height = 19 - Top = 38 - Width = 50 - BorderSpacing.Left = 8 - MaxValue = 127 - MinValue = -128 - TabOrder = 1 - Value = 127 - end - end - end - object pgInsertStatics: TPage - Caption = 'Insert statics' - ClientWidth = 462 - ClientHeight = 316 - object gbInserStaticsTiles: TGroupBox - AnchorSideLeft.Control = pgInsertStatics - AnchorSideTop.Control = pgInsertStatics - AnchorSideBottom.Control = pgInsertStatics - AnchorSideBottom.Side = asrBottom - Left = 8 - Height = 300 - Top = 8 - Width = 225 - Anchors = [akTop, akLeft, akBottom] - BorderSpacing.Around = 8 - Caption = 'Tiles' - ClientHeight = 286 - ClientWidth = 223 - TabOrder = 0 - object lblInsertStaticsTiles: TLabel - AnchorSideLeft.Control = gbInserStaticsTiles - AnchorSideTop.Control = gbInserStaticsTiles - AnchorSideRight.Control = gbInserStaticsTiles - AnchorSideRight.Side = asrBottom - Left = 4 - Height = 62 - Top = 0 - Width = 213 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Left = 4 - BorderSpacing.Right = 4 - BorderSpacing.Bottom = 4 - Caption = 'Drag statics tiles from the main window and drop them on the list. For each cell in the target area, one of these (random) will be used.' - ParentColor = False - WordWrap = True - end - object vdtInsertStaticsTiles: TVirtualDrawTree - Tag = 1 - AnchorSideLeft.Control = gbInserStaticsTiles - AnchorSideTop.Control = lblInsertStaticsTiles - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = gbInserStaticsTiles - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = btnDeleteIStaticsTiles - Left = 4 - Height = 200 - Top = 66 - Width = 213 - Anchors = [akTop, akLeft, akRight, akBottom] - BorderSpacing.Left = 4 - BorderSpacing.Right = 4 - BorderSpacing.Bottom = 4 - DefaultNodeHeight = 44 - DragMode = dmAutomatic - DragType = dtVCL - Header.AutoSizeIndex = 0 - Header.Columns = < - item - Position = 0 - Text = 'ID' - end - item - Position = 1 - Text = 'Tile' - Width = 44 - end - item - Position = 2 - Text = 'Name' - Width = 100 - end> - Header.DefaultHeight = 17 - Header.Options = [hoColumnResize, hoDrag, hoVisible] - Header.ParentFont = True - Header.Style = hsFlatButtons - TabOrder = 0 - TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toFullRowDrag] - TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] - TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect] - OnDragOver = vdtTerrainTilesDragOver - OnDragDrop = vdtTerrainTilesDragDrop - OnDrawNode = vdtTerrainTilesDrawNode - end - object btnClearIStaticsTiles: TSpeedButton - AnchorSideLeft.Control = btnDeleteIStaticsTiles - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = btnDeleteIStaticsTiles - Left = 30 - Height = 22 - Hint = 'Clear' - Top = 270 - Width = 22 - Color = clBtnFace - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000 - EFFF0000EDFF0000EDFF00000000000000000000000000000000000000000000 - 0000000000000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443 - F7FF3242F7FF141BF1FF0000EDFF000000000000000000000000000000000000 - 00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909 - F5FF161BF5FF3343F7FF141BF1FF0000EDFF0000000000000000000000000000 - F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333 - F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF00000000000000000000 - FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA - FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF00000000000000000000 - FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1 - FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00000000000000000000 - FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC - FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF00000000000000000000 - FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC - FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF00000000000000000000 - FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2 - FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FF00000000000000000000 - FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC - FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000000000000000 - FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B - FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000 - 00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D - FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000 - 0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663 - FEFF5461FEFF2227FCFF0000FBFF000000000000000000000000000000000000 - 000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000 - FDFF0000FDFF0000FDFF00000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000 - } - NumGlyphs = 0 - OnClick = btnClearIStaticsTilesClick - ShowHint = True - ParentShowHint = False - end - object btnDeleteIStaticsTiles: TSpeedButton - AnchorSideLeft.Control = gbInserStaticsTiles - AnchorSideBottom.Control = gbInserStaticsTiles - AnchorSideBottom.Side = asrBottom - Left = 4 - Height = 22 - Hint = 'Delete' - Top = 270 - Width = 22 - Anchors = [akLeft, akBottom] - BorderSpacing.Around = 4 - Color = clBtnFace - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000003853BEFF3551BDFF304BBCFF2E4E - B8FF000000000000000000000000000000000000000000000000000000000000 - 000000000000000000004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178 - E4FF334DC1FF2B4AB7FF00000000000000000000000000000000000000000000 - 0000000000004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84 - EEFF9EA0F4FF515DD7FF2B4AB7FF000000000000000000000000000000000000 - 00005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56 - E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FF0000000000000000000000000000 - 00004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59 - E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF0000000000000000000000005C62 - D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59 - E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF00000000000000005F63 - DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF00000000000000006469 - DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF0000000000000000676A - DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F - ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF00000000000000000000 - 00007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84 - F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF0000000000000000000000000000 - 00006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92 - F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF0000000000000000000000000000 - 0000000000006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9 - FBFFBAC7FCFF707BE9FF4C5BCCFF000000000000000000000000000000000000 - 000000000000000000006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4 - F4FF6670E2FF535ED1FF00000000000000000000000000000000000000000000 - 000000000000000000000000000000000000686ADDFF6364DCFF6164DAFF5D63 - D9FF000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000 - } - NumGlyphs = 0 - OnClick = btnDeleteIStaticsTilesClick - ShowHint = True - ParentShowHint = False - end - end - object gbStaticsProbability: TGroupBox - AnchorSideLeft.Control = gbInserStaticsTiles - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = gbInserStaticsTiles - Left = 241 - Height = 75 - Top = 8 - Width = 185 - AutoSize = True - Caption = 'Probability' - ClientHeight = 61 - ClientWidth = 183 - TabOrder = 1 - object Label5: TLabel - AnchorSideLeft.Control = gbStaticsProbability - AnchorSideTop.Control = gbStaticsProbability - AnchorSideRight.Control = gbStaticsProbability - AnchorSideRight.Side = asrBottom - Left = 4 - Height = 30 - Top = 0 - Width = 173 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Left = 4 - BorderSpacing.Right = 4 - BorderSpacing.Bottom = 4 - Caption = 'A tile will only be placed with this probability:' - ParentColor = False - WordWrap = True - end - object Label6: TLabel - AnchorSideLeft.Control = seStaticsProbability - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = seStaticsProbability - AnchorSideTop.Side = asrCenter - Left = 58 - Height = 14 - Top = 36 - Width = 12 - BorderSpacing.Left = 4 - Caption = '%' - ParentColor = False - end - object seStaticsProbability: TSpinEdit - AnchorSideLeft.Control = Label5 - AnchorSideTop.Control = Label5 - AnchorSideTop.Side = asrBottom - Left = 4 - Height = 19 - Top = 34 - Width = 50 - BorderSpacing.Bottom = 8 - TabOrder = 0 - Value = 100 - end - end - object gbStaticsPlacement: TGroupBox - AnchorSideLeft.Control = gbInserStaticsTiles - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = gbStaticsProbability - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = gbStaticsProbability - AnchorSideRight.Side = asrBottom - Left = 241 - Height = 111 - Top = 87 - Width = 185 - Anchors = [akTop, akLeft, akRight] - AutoSize = True - BorderSpacing.Top = 4 - Caption = 'Z Placement' - ClientHeight = 97 - ClientWidth = 183 - TabOrder = 2 - object rbPlaceStaticsOnTerrain: TRadioButton - AnchorSideLeft.Control = gbStaticsPlacement - AnchorSideTop.Control = gbStaticsPlacement - AnchorSideRight.Control = gbStaticsPlacement - AnchorSideRight.Side = asrBottom - Left = 4 - Height = 22 - Top = 4 - Width = 173 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Left = 4 - BorderSpacing.Top = 4 - BorderSpacing.Right = 4 - Caption = 'Place tiles on terrain' - Checked = True - State = cbChecked - TabOrder = 0 - end - object rbPlaceStaticsOnTop: TRadioButton - AnchorSideLeft.Control = rbPlaceStaticsOnTerrain - AnchorSideTop.Control = rbPlaceStaticsOnTerrain - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = rbPlaceStaticsOnTerrain - AnchorSideRight.Side = asrBottom - Left = 4 - Height = 22 - Top = 26 - Width = 173 - Anchors = [akTop, akLeft, akRight] - Caption = 'Place tiles on top' - TabOrder = 1 - TabStop = False - end - object rbPlaceStaticsOnZ: TRadioButton - AnchorSideLeft.Control = rbPlaceStaticsOnTop - AnchorSideTop.Control = rbPlaceStaticsOnTop - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = rbPlaceStaticsOnTop - AnchorSideRight.Side = asrBottom - Left = 4 - Height = 22 - Top = 48 - Width = 173 - Anchors = [akTop, akLeft, akRight] - Caption = 'Place tiles on:' - TabOrder = 2 - TabStop = False - end - object seInsertStaticsZ: TSpinEdit - AnchorSideLeft.Control = rbPlaceStaticsOnZ - AnchorSideTop.Control = rbPlaceStaticsOnZ - AnchorSideTop.Side = asrBottom - Left = 26 - Height = 19 - Top = 70 - Width = 50 - BorderSpacing.Left = 22 - BorderSpacing.Bottom = 8 - TabOrder = 3 - end - end - end - end - object btnClose: TButton - AnchorSideRight.Control = Owner - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = Owner - AnchorSideBottom.Side = asrBottom - Left = 548 - Height = 25 - Top = 357 - Width = 64 - Anchors = [akRight, akBottom] - BorderSpacing.Around = 8 - BorderSpacing.InnerBorder = 4 - Caption = 'Close' - OnClick = btnCloseClick - TabOrder = 1 - end - object btnExecute: TButton - AnchorSideRight.Control = btnClose - AnchorSideBottom.Control = btnClose - AnchorSideBottom.Side = asrBottom - Left = 476 - Height = 25 - Top = 357 - Width = 64 - Anchors = [akRight, akBottom] - BorderSpacing.InnerBorder = 4 - Caption = 'Execute' - OnClick = btnExecuteClick - TabOrder = 2 - end - object vstArea: TVirtualStringTree - AnchorSideLeft.Control = Label1 - AnchorSideTop.Control = Label1 - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = Label1 - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = btnDeleteArea - Left = 4 - Height = 122 - Top = 154 - Width = 144 - Anchors = [akTop, akLeft, akRight, akBottom] - BorderSpacing.Bottom = 4 - DefaultText = 'Node' - Header.AutoSizeIndex = 0 - Header.Columns = <> - Header.DefaultHeight = 17 - Header.MainColumn = -1 - Header.Options = [hoColumnResize, hoDrag] - TabOrder = 3 - TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] - TreeOptions.SelectionOptions = [toFullRowSelect] - OnChange = vstAreaChange - OnGetText = vstAreaGetText - end - object Label1: TLabel - AnchorSideLeft.Control = vstActions - AnchorSideTop.Control = vstActions - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = vstActions - AnchorSideRight.Side = asrBottom - Left = 4 - Height = 14 - Top = 140 - Width = 144 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Left = 4 - BorderSpacing.Top = 4 - BorderSpacing.Right = 4 - Caption = 'Area:' - ParentColor = False - end - object vstActions: TVirtualStringTree - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = Owner - Left = 0 - Height = 136 - Top = 0 - Width = 152 - DefaultText = 'Node' - Header.AutoSizeIndex = 0 - Header.Columns = < - item - Position = 0 - Text = 'Actions' - Width = 148 - end> - Header.DefaultHeight = 17 - Header.Options = [hoAutoResize, hoVisible] - Header.ParentFont = True - Header.Style = hsFlatButtons - TabOrder = 4 - TreeOptions.MiscOptions = [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning] - TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] - TreeOptions.SelectionOptions = [toFullRowSelect] - OnChange = vstActionsChange - OnChecked = vstActionsChecked - OnGetText = vstActionsGetText - OnPaintText = vstActionsPaintText - end - object btnAddArea: TSpeedButton - AnchorSideTop.Control = btnDeleteArea - AnchorSideRight.Control = btnDeleteArea - Left = 39 - Height = 22 - Hint = 'Add area' - Top = 280 - Width = 22 - Anchors = [akTop, akRight] - Color = clBtnFace - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000003A8C44FF368940FF32873CFF2F84 - 37FF000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000459653FF419950FF7DC28FFF96D0A6FF96CFA6FF78BE - 89FF368D42FF2C8134FF00000000000000000000000000000000000000000000 - 0000000000004D9C5DFF64B478FFA8DBB5FF87CC98FF66BC7DFF64BA7CFF86CB - 98FFA5D9B4FF58AA6BFF2C8134FF000000000000000000000000000000000000 - 000056A366FF6AB97DFFA8DBB2FF60BC77FF5CBA73FF59B870FF59B56FFF58B5 - 6FFF5BB774FFA5D9B3FF5AAA6CFF2C8234FF0000000000000000000000000000 - 000053AB68FFAADDB4FF64C179FF5FBE71FF60BC77FFFFFFFFFFFFFFFFFF59B8 - 70FF58B56EFF5CB774FFA6DAB4FF388F43FF00000000000000000000000061AC - 75FF8ACC98FF89D396FF6BC67AFF63C170FF55AB65FFFFFFFFFFFFFFFFFF59B8 - 70FF59B870FF5BB972FF85CC97FF7BBE8DFF308539FF000000000000000065AF - 7AFFA9DDB3FF7DCF8AFF75CC81FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFF59B870FF67BE7DFF9CD4ABFF34883DFF000000000000000069B2 - 7EFFB6E2BEFF8BD597FF7AC986FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFF59B870FF69C17EFF9DD4AAFF388B42FF00000000000000006DB5 - 83FFACDDB6FFA6DFAFFF81CB8CFF7CC986FF6EBD79FFFFFFFFFFFFFFFFFF5BAC - 6AFF60BC77FF5CBA73FF8BD199FF80C592FF3C8E47FF00000000000000000000 - 000085C797FFD2EED7FF95D9A0FF8AD394FF7FC889FFFFFFFFFFFFFFFFFF79CD - 85FF6BC37CFF6FC77EFFACDFB5FF459E57FF0000000000000000000000000000 - 000070B887FFAADAB7FFD8F1DCFF92D89DFF88CD93FF84CC8EFF8BD496FF8AD4 - 95FF83D28EFFAFE0B7FF6BB97DFF489856FF0000000000000000000000000000 - 00000000000070B887FFAFDCBBFFDCF2E0FFB6E4BDFF9BDBA5FF96D9A0FFA5DF - AFFFC0E8C5FF79C28AFF509E5FFF000000000000000000000000000000000000 - 0000000000000000000071B887FF94CEA4FFC3E6CBFFCFEBD4FFC9E9CEFFAFDD - B8FF6DB97FFF58A569FF00000000000000000000000000000000000000000000 - 0000000000000000000000000000000000006EB684FF6AB380FF67B17CFF63AE - 77FF000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000 - } - NumGlyphs = 0 - OnClick = btnAddAreaClick - ShowHint = True - ParentShowHint = False - end - object btnDeleteArea: TSpeedButton - AnchorSideLeft.Control = vstArea - AnchorSideLeft.Side = asrCenter - AnchorSideTop.Control = vstArea - AnchorSideBottom.Control = seX1 - Left = 65 - Height = 22 - Hint = 'Delete area' - Top = 280 - Width = 22 - Anchors = [akLeft, akBottom] - BorderSpacing.Bottom = 4 - BorderSpacing.Around = 4 - Color = clBtnFace - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000003853BEFF3551BDFF304BBCFF2E4E - B8FF000000000000000000000000000000000000000000000000000000000000 - 000000000000000000004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178 - E4FF334DC1FF2B4AB7FF00000000000000000000000000000000000000000000 - 0000000000004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84 - EEFF9EA0F4FF515DD7FF2B4AB7FF000000000000000000000000000000000000 - 00005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56 - E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FF0000000000000000000000000000 - 00004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59 - E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF0000000000000000000000005C62 - D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59 - E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF00000000000000005F63 - DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF00000000000000006469 - DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF0000000000000000676A - DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F - ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF00000000000000000000 - 00007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84 - F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF0000000000000000000000000000 - 00006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92 - F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF0000000000000000000000000000 - 0000000000006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9 - FBFFBAC7FCFF707BE9FF4C5BCCFF000000000000000000000000000000000000 - 000000000000000000006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4 - F4FF6670E2FF535ED1FF00000000000000000000000000000000000000000000 - 000000000000000000000000000000000000686ADDFF6364DCFF6164DAFF5D63 - D9FF000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000 - } - NumGlyphs = 0 - OnClick = btnDeleteAreaClick - ShowHint = True - ParentShowHint = False - end - object btnClearArea: TSpeedButton - AnchorSideLeft.Control = btnDeleteArea - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = btnDeleteArea - Left = 91 - Height = 22 - Hint = 'Delete all areas' - Top = 280 - Width = 22 - Color = clBtnFace - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000 - EFFF0000EDFF0000EDFF00000000000000000000000000000000000000000000 - 0000000000000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443 - F7FF3242F7FF141BF1FF0000EDFF000000000000000000000000000000000000 - 00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909 - F5FF161BF5FF3343F7FF141BF1FF0000EDFF0000000000000000000000000000 - F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333 - F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF00000000000000000000 - FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA - FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF00000000000000000000 - FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1 - FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00000000000000000000 - FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC - FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF00000000000000000000 - FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC - FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF00000000000000000000 - FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2 - FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FF00000000000000000000 - FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC - FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000000000000000 - FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B - FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000 - 00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D - FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000 - 0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663 - FEFF5461FEFF2227FCFF0000FBFF000000000000000000000000000000000000 - 000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000 - FDFF0000FDFF0000FDFF00000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000 - } - NumGlyphs = 0 - OnClick = btnClearAreaClick - ShowHint = True - ParentShowHint = False - end - object lblX: TLabel - AnchorSideLeft.Control = lblY - AnchorSideTop.Control = seX1 - AnchorSideTop.Side = asrCenter - Left = 4 - Height = 14 - Top = 312 - Width = 8 - Caption = 'X' - Enabled = False - ParentColor = False - end - object seX1: TSpinEdit - AnchorSideLeft.Control = seY1 - AnchorSideBottom.Control = seY1 - Left = 20 - Height = 19 - Top = 310 - Width = 50 - Anchors = [akLeft, akBottom] - BorderSpacing.Bottom = 8 - Enabled = False - OnChange = seX1Change - TabOrder = 5 - Value = 1 - end - object seX2: TSpinEdit - AnchorSideLeft.Control = seX1 - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = seX1 - Left = 78 - Height = 19 - Top = 310 - Width = 50 - BorderSpacing.Left = 8 - Enabled = False - OnChange = seX1Change - TabOrder = 6 - Value = 1 - end - object lblY: TLabel - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = seY1 - AnchorSideTop.Side = asrCenter - Left = 4 - Height = 14 - Top = 339 - Width = 8 - BorderSpacing.Left = 4 - Caption = 'Y' - Enabled = False - ParentColor = False - end - object seY1: TSpinEdit - AnchorSideLeft.Control = lblY - AnchorSideLeft.Side = asrBottom - AnchorSideBottom.Control = btnGrab1 - Left = 20 - Height = 19 - Top = 337 - Width = 50 - Anchors = [akLeft, akBottom] - BorderSpacing.Left = 8 - BorderSpacing.Bottom = 4 - Enabled = False - OnChange = seX1Change - TabOrder = 7 - Value = 1 - end - object seY2: TSpinEdit - AnchorSideLeft.Control = seX2 - AnchorSideTop.Control = seY1 - Left = 78 - Height = 19 - Top = 337 - Width = 50 - Enabled = False - OnChange = seX1Change - TabOrder = 8 - Value = 1 - end - object btnGrab1: TSpeedButton - AnchorSideLeft.Control = seY1 - AnchorSideLeft.Side = asrCenter - AnchorSideBottom.Control = Owner - AnchorSideBottom.Side = asrBottom - Left = 34 - Height = 22 - Hint = 'Grab coordinates from the main window.' - Top = 360 - Width = 22 - Anchors = [akLeft, akBottom] - BorderSpacing.Bottom = 8 - Color = clBtnFace - Enabled = False - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F7F7F067C7C - 7CE6787878CC75757581FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383835DAAAA - AAFFDBDBDBFF797979F275757506FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF0097979709FFFFFF00FFFFFF00FFFFFF00888888E7DBDB - DBFFB7B7B7FF7D7D7D80FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF009C9C9CC99898981EFFFFFF0090909050ADADADFFF2F2 - F2FF848484FD8181810FFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00A0A0A0FF9C9C9CE798989836949494DFD9D9D9FFC1C1 - C1FF898989A0FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00A4A4A4FFD7D7D7FF9D9D9DF8D0D0D0FFEEEEEEFF9191 - 91FE8D8D8D18FFFFFF00FFFFFF00818181097E7E7E09FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00A9A9A9FFF2F2F2FFE5E5E5FFE2E2E2FFE3E3E3FF9595 - 95F4919191CC8D8D8DF9898989FF86868693FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00ADADADFFEEEEEEFFE1E1E1FFDFDFDFFFE0E0E0FFE7E7 - E7FFE4E4E4FFBBBBBBFF8E8E8E93FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00B1B1B1FFF0F0F0FFE4E4E4FFE2E2E2FFE2E2E2FFE7E7 - E7FFC1C1C1FF96969690FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00B5B5B5FFF2F2F2FFE8E8E8FFE7E7E7FFEAEAEAFFC6C6 - C6FF9E9E9E8DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00B9B9B9FFF4F4F4FFECECECFFEDEDEDFFCBCBCBFFA7A7 - A78AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00BDBDBDFFF7F7F7FFEFEFEFFFD0D0D0FFAFAFAF8AFFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00C1C1C1FFF7F7F7FFD5D5D5FFB6B6B687FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00C4C4C4FFD9D9D9FFBEBEBE84FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00C8C8C8FFC5C5C581FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00CBCBCB7EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - NumGlyphs = 0 - OnClick = btnGrab1Click - ShowHint = True - ParentShowHint = False - end - object btnGrab2: TSpeedButton - AnchorSideLeft.Control = seY2 - AnchorSideLeft.Side = asrCenter - AnchorSideBottom.Control = btnGrab1 - AnchorSideBottom.Side = asrBottom - Left = 92 - Height = 22 - Hint = 'Grab coordinates from the main window.' - Top = 360 - Width = 22 - Anchors = [akLeft, akBottom] - Color = clBtnFace - Enabled = False - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F7F7F067C7C - 7CE6787878CC75757581FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383835DAAAA - AAFFDBDBDBFF797979F275757506FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF0097979709FFFFFF00FFFFFF00FFFFFF00888888E7DBDB - DBFFB7B7B7FF7D7D7D80FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF009C9C9CC99898981EFFFFFF0090909050ADADADFFF2F2 - F2FF848484FD8181810FFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00A0A0A0FF9C9C9CE798989836949494DFD9D9D9FFC1C1 - C1FF898989A0FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00A4A4A4FFD7D7D7FF9D9D9DF8D0D0D0FFEEEEEEFF9191 - 91FE8D8D8D18FFFFFF00FFFFFF00818181097E7E7E09FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00A9A9A9FFF2F2F2FFE5E5E5FFE2E2E2FFE3E3E3FF9595 - 95F4919191CC8D8D8DF9898989FF86868693FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00ADADADFFEEEEEEFFE1E1E1FFDFDFDFFFE0E0E0FFE7E7 - E7FFE4E4E4FFBBBBBBFF8E8E8E93FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00B1B1B1FFF0F0F0FFE4E4E4FFE2E2E2FFE2E2E2FFE7E7 - E7FFC1C1C1FF96969690FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00B5B5B5FFF2F2F2FFE8E8E8FFE7E7E7FFEAEAEAFFC6C6 - C6FF9E9E9E8DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00B9B9B9FFF4F4F4FFECECECFFEDEDEDFFCBCBCBFFA7A7 - A78AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00BDBDBDFFF7F7F7FFEFEFEFFFD0D0D0FFAFAFAF8AFFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00C1C1C1FFF7F7F7FFD5D5D5FFB6B6B687FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00C4C4C4FFD9D9D9FFBEBEBE84FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00C8C8C8FFC5C5C581FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00CBCBCB7EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - NumGlyphs = 0 - OnClick = btnGrab1Click - ShowHint = True - ParentShowHint = False - end - object pmSelectOffset: TPopupMenu - left = 421 - top = 82 - object mnuSelectTopLeft: TMenuItem - Caption = 'Select Top-Left Corner' - OnClick = mnuSelectTopLeftClick - end - object mnuSelectTopRight: TMenuItem - Caption = 'Select Top-Right Corner' - OnClick = mnuSelectTopLeftClick - end - object mnuSelectBottomLeft: TMenuItem - Caption = 'Select Bottom-Left Corner' - OnClick = mnuSelectTopLeftClick - end - object mnuSelectBottomRight: TMenuItem - Caption = 'Select Bottom-Right Corner' - OnClick = mnuSelectTopLeftClick - end - end -end +object frmLargeScaleCommand: TfrmLargeScaleCommand + Left = 290 + Height = 390 + Top = 171 + Width = 620 + ActiveControl = vstActions + Caption = 'Large Scale Commands' + ClientHeight = 390 + ClientWidth = 620 + Constraints.MinHeight = 390 + Constraints.MinWidth = 620 + Font.Height = -11 + OnCreate = FormCreate + OnDestroy = FormDestroy + OnShow = FormShow + Position = poOwnerFormCenter + ShowInTaskBar = stAlways + LCLVersion = '0.9.29' + object nbActions: TNotebook + AnchorSideLeft.Control = vstActions + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = btnClose + Left = 152 + Height = 349 + Top = 0 + Width = 468 + Anchors = [akTop, akLeft, akRight, akBottom] + PageIndex = 1 + ShowTabs = False + TabOrder = 0 + object pgArea: TPage + Caption = 'pgArea' + ClientWidth = 462 + ClientHeight = 316 + object sbArea: TScrollBox + Left = 0 + Height = 316 + Top = 0 + Width = 462 + Align = alClient + ClientHeight = 314 + ClientWidth = 460 + TabOrder = 0 + object pbArea: TPaintBox + Left = 0 + Height = 105 + Top = 0 + Width = 105 + OnMouseDown = pbAreaMouseDown + OnMouseMove = pbAreaMouseMove + OnPaint = pbAreaPaint + end + end + end + object pgCopyMove: TPage + Caption = 'Copy/Move' + ClientWidth = 462 + ClientHeight = 343 + object rgCMAction: TRadioGroup + AnchorSideLeft.Control = pgCopyMove + AnchorSideTop.Control = pgCopyMove + Left = 8 + Height = 40 + Top = 8 + Width = 184 + AutoFill = True + BorderSpacing.Around = 8 + Caption = 'Action' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 26 + ClientWidth = 182 + Columns = 2 + ItemIndex = 0 + Items.Strings = ( + 'Copy' + 'Move' + ) + TabOrder = 0 + end + object gbCMOffset: TGroupBox + AnchorSideLeft.Control = rgCMAction + AnchorSideTop.Control = rgCMAction + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 81 + Top = 56 + Width = 121 + Caption = 'Offset' + ClientHeight = 67 + ClientWidth = 119 + TabOrder = 1 + object Label9: TLabel + AnchorSideLeft.Control = gbCMOffset + AnchorSideTop.Control = seCMOffsetX + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 14 + Top = 10 + Width = 11 + BorderSpacing.Around = 8 + Caption = 'X:' + ParentColor = False + end + object Label10: TLabel + AnchorSideLeft.Control = Label9 + AnchorSideTop.Control = seCMOffsetY + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 14 + Top = 37 + Width = 10 + Caption = 'Y:' + ParentColor = False + end + object seCMOffsetX: TSpinEdit + AnchorSideLeft.Control = Label9 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = gbCMOffset + AnchorSideRight.Control = btnGrabOffset + Left = 27 + Height = 19 + Top = 8 + Width = 62 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + BorderSpacing.Bottom = 4 + BorderSpacing.Around = 4 + TabOrder = 0 + end + object seCMOffsetY: TSpinEdit + AnchorSideLeft.Control = seCMOffsetX + AnchorSideTop.Control = seCMOffsetX + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = seCMOffsetX + AnchorSideRight.Side = asrBottom + Left = 27 + Height = 19 + Top = 35 + Width = 62 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Bottom = 8 + TabOrder = 1 + end + object btnGrabOffset: TSpeedButton + AnchorSideTop.Control = gbCMOffset + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = gbCMOffset + AnchorSideRight.Side = asrBottom + Left = 93 + Height = 22 + Hint = 'Grab coordinates and calculate the offset in relation to the selected area.' + Top = 22 + Width = 22 + Anchors = [akTop, akRight] + BorderSpacing.Around = 4 + Color = clBtnFace + Enabled = False + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F7F7F067C7C + 7CE6787878CC75757581FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383835DAAAA + AAFFDBDBDBFF797979F275757506FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0097979709FFFFFF00FFFFFF00FFFFFF00888888E7DBDB + DBFFB7B7B7FF7D7D7D80FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF009C9C9CC99898981EFFFFFF0090909050ADADADFFF2F2 + F2FF848484FD8181810FFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00A0A0A0FF9C9C9CE798989836949494DFD9D9D9FFC1C1 + C1FF898989A0FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00A4A4A4FFD7D7D7FF9D9D9DF8D0D0D0FFEEEEEEFF9191 + 91FE8D8D8D18FFFFFF00FFFFFF00818181097E7E7E09FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00A9A9A9FFF2F2F2FFE5E5E5FFE2E2E2FFE3E3E3FF9595 + 95F4919191CC8D8D8DF9898989FF86868693FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00ADADADFFEEEEEEFFE1E1E1FFDFDFDFFFE0E0E0FFE7E7 + E7FFE4E4E4FFBBBBBBFF8E8E8E93FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00B1B1B1FFF0F0F0FFE4E4E4FFE2E2E2FFE2E2E2FFE7E7 + E7FFC1C1C1FF96969690FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00B5B5B5FFF2F2F2FFE8E8E8FFE7E7E7FFEAEAEAFFC6C6 + C6FF9E9E9E8DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00B9B9B9FFF4F4F4FFECECECFFEDEDEDFFCBCBCBFFA7A7 + A78AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00BDBDBDFFF7F7F7FFEFEFEFFFD0D0D0FFAFAFAF8AFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00C1C1C1FFF7F7F7FFD5D5D5FFB6B6B687FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00C4C4C4FFD9D9D9FFBEBEBE84FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00C8C8C8FFC5C5C581FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00CBCBCB7EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + NumGlyphs = 0 + OnClick = btnGrabOffsetClick + ShowHint = True + ParentShowHint = False + end + end + object cbCMEraseTarget: TCheckBox + AnchorSideLeft.Control = gbCMOffset + AnchorSideTop.Control = gbCMOffset + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 22 + Top = 145 + Width = 170 + BorderSpacing.Top = 8 + Caption = 'Erase target area (at offset)' + TabOrder = 2 + end + end + object pgModifyAltitude: TPage + Caption = 'Modify altitude' + ClientWidth = 462 + ClientHeight = 316 + object Label2: TLabel + AnchorSideLeft.Control = rbSetTerrainAltitude + AnchorSideTop.Control = rbSetTerrainAltitude + AnchorSideTop.Side = asrBottom + Left = 30 + Height = 46 + Top = 30 + Width = 142 + BorderSpacing.Left = 22 + Caption = 'The statics will be elevated according to the terrain change.' + Enabled = False + ParentColor = False + WordWrap = True + end + object Label3: TLabel + AnchorSideTop.Control = rbSetTerrainAltitude + Left = 228 + Height = 30 + Top = 8 + Width = 125 + Caption = 'Set the altitude to a value from this range:' + ParentColor = False + WordWrap = True + end + object Label4: TLabel + AnchorSideLeft.Control = seTerrainAltitude1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = seTerrainAltitude1 + AnchorSideTop.Side = asrCenter + Left = 286 + Height = 14 + Top = 48 + Width = 12 + BorderSpacing.Left = 8 + Caption = 'to' + ParentColor = False + end + object rbSetTerrainAltitude: TRadioButton + AnchorSideLeft.Control = pgModifyAltitude + AnchorSideTop.Control = pgModifyAltitude + Left = 8 + Height = 22 + Top = 8 + Width = 123 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Set terrain altitude' + Checked = True + State = cbChecked + TabOrder = 0 + end + object rbRelativeAltitudeChange: TRadioButton + AnchorSideLeft.Control = rbSetTerrainAltitude + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 22 + Top = 84 + Width = 153 + BorderSpacing.Top = 8 + Caption = 'Relative altitude change' + TabOrder = 1 + TabStop = False + end + object seTerrainAltitude1: TSpinEdit + AnchorSideLeft.Control = Label3 + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + Left = 228 + Height = 19 + Top = 46 + Width = 50 + BorderSpacing.Top = 8 + MaxValue = 127 + MinValue = -128 + TabOrder = 2 + end + object seTerrainAltitude2: TSpinEdit + AnchorSideLeft.Control = Label4 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = seTerrainAltitude1 + Left = 306 + Height = 19 + Top = 46 + Width = 50 + BorderSpacing.Left = 8 + MaxValue = 127 + MinValue = -128 + TabOrder = 3 + end + object seRelativeAltitude: TSpinEdit + AnchorSideLeft.Control = Label2 + AnchorSideTop.Control = rbRelativeAltitudeChange + AnchorSideTop.Side = asrBottom + Left = 30 + Height = 19 + Top = 106 + Width = 50 + MaxValue = 127 + MinValue = -128 + TabOrder = 4 + end + end + object pgDrawTerrain: TPage + Caption = 'Draw Terrain' + ClientWidth = 462 + ClientHeight = 316 + object gbDrawTerrainTiles: TGroupBox + AnchorSideLeft.Control = pgDrawTerrain + AnchorSideTop.Control = pgDrawTerrain + AnchorSideBottom.Control = pgDrawTerrain + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 300 + Top = 8 + Width = 225 + Anchors = [akTop, akLeft, akBottom] + BorderSpacing.Around = 8 + Caption = 'Tiles' + ClientHeight = 286 + ClientWidth = 223 + TabOrder = 0 + object lblDrawTerrainTilesDesc: TLabel + AnchorSideLeft.Control = gbDrawTerrainTiles + AnchorSideTop.Control = gbDrawTerrainTiles + AnchorSideRight.Control = gbDrawTerrainTiles + Left = 4 + Height = 62 + Top = 0 + Width = 215 + BorderSpacing.Left = 4 + BorderSpacing.Right = 4 + BorderSpacing.Bottom = 4 + Caption = 'Drag terrain tiles from the main window and drop them on the list. For each cell in the target area, one of these (random) will be used.' + ParentColor = False + WordWrap = True + end + object vdtTerrainTiles: TVirtualDrawTree + Tag = 1 + AnchorSideLeft.Control = gbDrawTerrainTiles + AnchorSideTop.Control = lblDrawTerrainTilesDesc + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = gbDrawTerrainTiles + AnchorSideBottom.Control = btnDeleteTerrain + Cursor = 63 + Left = 4 + Height = 200 + Top = 66 + Width = 215 + Anchors = [akTop, akLeft, akBottom] + BorderSpacing.Left = 4 + BorderSpacing.Right = 4 + BorderSpacing.Bottom = 4 + DefaultNodeHeight = 44 + DragMode = dmAutomatic + DragType = dtVCL + Header.AutoSizeIndex = 0 + Header.Columns = < + item + Position = 0 + Text = 'ID' + end + item + Position = 1 + Text = 'Tile' + Width = 44 + end + item + Position = 2 + Text = 'Name' + Width = 100 + end> + Header.DefaultHeight = 17 + Header.Options = [hoColumnResize, hoDrag, hoVisible] + Header.ParentFont = True + Header.Style = hsFlatButtons + TabOrder = 0 + TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toFullRowDrag] + TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] + TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect] + OnDragOver = vdtTerrainTilesDragOver + OnDragDrop = vdtTerrainTilesDragDrop + OnDrawNode = vdtTerrainTilesDrawNode + end + object btnClearTerrain: TSpeedButton + AnchorSideLeft.Control = btnDeleteTerrain + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = btnDeleteTerrain + AnchorSideBottom.Side = asrBottom + Left = 30 + Height = 22 + Hint = 'Clear' + Top = 270 + Width = 22 + Anchors = [akLeft, akBottom] + Color = clBtnFace + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000 + EFFF0000EDFF0000EDFF00000000000000000000000000000000000000000000 + 0000000000000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443 + F7FF3242F7FF141BF1FF0000EDFF000000000000000000000000000000000000 + 00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909 + F5FF161BF5FF3343F7FF141BF1FF0000EDFF0000000000000000000000000000 + F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333 + F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF00000000000000000000 + FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA + FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF00000000000000000000 + FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1 + FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00000000000000000000 + FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC + FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF00000000000000000000 + FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC + FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF00000000000000000000 + FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2 + FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FF00000000000000000000 + FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC + FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000000000000000 + FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B + FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000 + 00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D + FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000 + 0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663 + FEFF5461FEFF2227FCFF0000FBFF000000000000000000000000000000000000 + 000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000 + FDFF0000FDFF0000FDFF00000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000 + } + NumGlyphs = 0 + OnClick = btnClearTerrainClick + ShowHint = True + ParentShowHint = False + end + object btnDeleteTerrain: TSpeedButton + AnchorSideLeft.Control = gbDrawTerrainTiles + AnchorSideBottom.Control = gbDrawTerrainTiles + AnchorSideBottom.Side = asrBottom + Left = 4 + Height = 22 + Hint = 'Delete' + Top = 270 + Width = 22 + Anchors = [akLeft, akBottom] + BorderSpacing.Around = 4 + Color = clBtnFace + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000003853BEFF3551BDFF304BBCFF2E4E + B8FF000000000000000000000000000000000000000000000000000000000000 + 000000000000000000004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178 + E4FF334DC1FF2B4AB7FF00000000000000000000000000000000000000000000 + 0000000000004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84 + EEFF9EA0F4FF515DD7FF2B4AB7FF000000000000000000000000000000000000 + 00005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56 + E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FF0000000000000000000000000000 + 00004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59 + E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF0000000000000000000000005C62 + D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59 + E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF00000000000000005F63 + DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF00000000000000006469 + DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF0000000000000000676A + DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F + ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF00000000000000000000 + 00007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84 + F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF0000000000000000000000000000 + 00006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92 + F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF0000000000000000000000000000 + 0000000000006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9 + FBFFBAC7FCFF707BE9FF4C5BCCFF000000000000000000000000000000000000 + 000000000000000000006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4 + F4FF6670E2FF535ED1FF00000000000000000000000000000000000000000000 + 000000000000000000000000000000000000686ADDFF6364DCFF6164DAFF5D63 + D9FF000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000 + } + NumGlyphs = 0 + OnClick = btnDeleteTerrainClick + ShowHint = True + ParentShowHint = False + end + end + end + object pgDeleteStatics: TPage + Caption = 'Delete statics' + ClientWidth = 462 + ClientHeight = 316 + object gbDeleteStaticsTiles: TGroupBox + AnchorSideLeft.Control = pgDeleteStatics + AnchorSideTop.Control = pgDeleteStatics + AnchorSideBottom.Control = pgDeleteStatics + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 300 + Top = 8 + Width = 225 + Anchors = [akTop, akLeft, akBottom] + BorderSpacing.Around = 8 + Caption = 'Tiles' + ClientHeight = 286 + ClientWidth = 223 + TabOrder = 0 + object lblDeleteStaticsTilesDesc: TLabel + AnchorSideLeft.Control = gbDeleteStaticsTiles + AnchorSideTop.Control = gbDeleteStaticsTiles + AnchorSideRight.Control = gbDeleteStaticsTiles + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 78 + Top = 0 + Width = 213 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 4 + BorderSpacing.Right = 4 + BorderSpacing.Bottom = 4 + Caption = 'Drag statics tiles from the main window and drop them on the list. Only statics matching these tiles will be deleted. If the list is empty, every static will be deleted.' + ParentColor = False + WordWrap = True + end + object vdtDeleteStaticsTiles: TVirtualDrawTree + Tag = 1 + AnchorSideLeft.Control = gbDeleteStaticsTiles + AnchorSideTop.Control = lblDeleteStaticsTilesDesc + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = gbDeleteStaticsTiles + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = btnDeleteDStaticsTiles + Cursor = 63 + Left = 4 + Height = 184 + Top = 82 + Width = 213 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 4 + BorderSpacing.Right = 4 + BorderSpacing.Bottom = 4 + DefaultNodeHeight = 44 + DragMode = dmAutomatic + DragType = dtVCL + Header.AutoSizeIndex = 0 + Header.Columns = < + item + Position = 0 + Text = 'ID' + end + item + Position = 1 + Text = 'Tile' + Width = 44 + end + item + Position = 2 + Text = 'Name' + Width = 100 + end> + Header.DefaultHeight = 17 + Header.Options = [hoColumnResize, hoDrag, hoVisible] + Header.ParentFont = True + Header.Style = hsFlatButtons + TabOrder = 0 + TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toFullRowDrag] + TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] + TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect] + OnDragOver = vdtTerrainTilesDragOver + OnDragDrop = vdtTerrainTilesDragDrop + OnDrawNode = vdtTerrainTilesDrawNode + end + object btnClearDStaticsTiles: TSpeedButton + AnchorSideLeft.Control = btnDeleteDStaticsTiles + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = btnDeleteDStaticsTiles + AnchorSideBottom.Side = asrBottom + Left = 30 + Height = 22 + Hint = 'Clear' + Top = 270 + Width = 22 + Anchors = [akLeft, akBottom] + Color = clBtnFace + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000 + EFFF0000EDFF0000EDFF00000000000000000000000000000000000000000000 + 0000000000000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443 + F7FF3242F7FF141BF1FF0000EDFF000000000000000000000000000000000000 + 00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909 + F5FF161BF5FF3343F7FF141BF1FF0000EDFF0000000000000000000000000000 + F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333 + F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF00000000000000000000 + FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA + FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF00000000000000000000 + FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1 + FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00000000000000000000 + FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC + FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF00000000000000000000 + FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC + FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF00000000000000000000 + FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2 + FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FF00000000000000000000 + FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC + FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000000000000000 + FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B + FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000 + 00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D + FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000 + 0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663 + FEFF5461FEFF2227FCFF0000FBFF000000000000000000000000000000000000 + 000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000 + FDFF0000FDFF0000FDFF00000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000 + } + NumGlyphs = 0 + OnClick = btnClearDStaticsTilesClick + ShowHint = True + ParentShowHint = False + end + object btnDeleteDStaticsTiles: TSpeedButton + AnchorSideLeft.Control = gbDeleteStaticsTiles + AnchorSideBottom.Control = gbDeleteStaticsTiles + AnchorSideBottom.Side = asrBottom + Left = 4 + Height = 22 + Hint = 'Delete' + Top = 270 + Width = 22 + Anchors = [akLeft, akBottom] + BorderSpacing.Around = 4 + Color = clBtnFace + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000003853BEFF3551BDFF304BBCFF2E4E + B8FF000000000000000000000000000000000000000000000000000000000000 + 000000000000000000004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178 + E4FF334DC1FF2B4AB7FF00000000000000000000000000000000000000000000 + 0000000000004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84 + EEFF9EA0F4FF515DD7FF2B4AB7FF000000000000000000000000000000000000 + 00005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56 + E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FF0000000000000000000000000000 + 00004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59 + E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF0000000000000000000000005C62 + D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59 + E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF00000000000000005F63 + DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF00000000000000006469 + DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF0000000000000000676A + DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F + ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF00000000000000000000 + 00007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84 + F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF0000000000000000000000000000 + 00006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92 + F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF0000000000000000000000000000 + 0000000000006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9 + FBFFBAC7FCFF707BE9FF4C5BCCFF000000000000000000000000000000000000 + 000000000000000000006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4 + F4FF6670E2FF535ED1FF00000000000000000000000000000000000000000000 + 000000000000000000000000000000000000686ADDFF6364DCFF6164DAFF5D63 + D9FF000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000 + } + NumGlyphs = 0 + OnClick = btnDeleteDStaticsTilesClick + ShowHint = True + ParentShowHint = False + end + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = gbDeleteStaticsTiles + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = gbDeleteStaticsTiles + Left = 241 + Height = 79 + Top = 8 + Width = 176 + AutoSize = True + Caption = 'Z Boundaries' + ClientHeight = 65 + ClientWidth = 174 + TabOrder = 1 + object Label7: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = GroupBox1 + AnchorSideRight.Control = GroupBox1 + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 30 + Top = 0 + Width = 164 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 4 + BorderSpacing.Right = 4 + BorderSpacing.Bottom = 4 + Caption = 'Only statics within this Z range will be deleted.' + ParentColor = False + WordWrap = True + end + object Label8: TLabel + AnchorSideLeft.Control = seDeleteStaticsZ1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = seDeleteStaticsZ1 + AnchorSideTop.Side = asrCenter + Left = 62 + Height = 14 + Top = 40 + Width = 12 + Caption = 'to' + ParentColor = False + end + object seDeleteStaticsZ1: TSpinEdit + AnchorSideTop.Control = Label7 + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 19 + Top = 38 + Width = 50 + BorderSpacing.Around = 8 + MaxValue = 127 + MinValue = -128 + TabOrder = 0 + Value = -128 + end + object seDeleteStaticsZ2: TSpinEdit + AnchorSideLeft.Control = Label8 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = seDeleteStaticsZ1 + Left = 82 + Height = 19 + Top = 38 + Width = 50 + BorderSpacing.Left = 8 + MaxValue = 127 + MinValue = -128 + TabOrder = 1 + Value = 127 + end + end + end + object pgInsertStatics: TPage + Caption = 'Insert statics' + ClientWidth = 462 + ClientHeight = 316 + object gbInserStaticsTiles: TGroupBox + AnchorSideLeft.Control = pgInsertStatics + AnchorSideTop.Control = pgInsertStatics + AnchorSideBottom.Control = pgInsertStatics + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 300 + Top = 8 + Width = 225 + Anchors = [akTop, akLeft, akBottom] + BorderSpacing.Around = 8 + Caption = 'Tiles' + ClientHeight = 286 + ClientWidth = 223 + TabOrder = 0 + object lblInsertStaticsTiles: TLabel + AnchorSideLeft.Control = gbInserStaticsTiles + AnchorSideTop.Control = gbInserStaticsTiles + AnchorSideRight.Control = gbInserStaticsTiles + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 62 + Top = 0 + Width = 213 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 4 + BorderSpacing.Right = 4 + BorderSpacing.Bottom = 4 + Caption = 'Drag statics tiles from the main window and drop them on the list. For each cell in the target area, one of these (random) will be used.' + ParentColor = False + WordWrap = True + end + object vdtInsertStaticsTiles: TVirtualDrawTree + Tag = 1 + AnchorSideLeft.Control = gbInserStaticsTiles + AnchorSideTop.Control = lblInsertStaticsTiles + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = gbInserStaticsTiles + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = btnDeleteIStaticsTiles + Left = 4 + Height = 200 + Top = 66 + Width = 213 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 4 + BorderSpacing.Right = 4 + BorderSpacing.Bottom = 4 + DefaultNodeHeight = 44 + DragMode = dmAutomatic + DragType = dtVCL + Header.AutoSizeIndex = 0 + Header.Columns = < + item + Position = 0 + Text = 'ID' + end + item + Position = 1 + Text = 'Tile' + Width = 44 + end + item + Position = 2 + Text = 'Name' + Width = 100 + end> + Header.DefaultHeight = 17 + Header.Options = [hoColumnResize, hoDrag, hoVisible] + Header.ParentFont = True + Header.Style = hsFlatButtons + TabOrder = 0 + TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toFullRowDrag] + TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] + TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect] + OnDragOver = vdtTerrainTilesDragOver + OnDragDrop = vdtTerrainTilesDragDrop + OnDrawNode = vdtTerrainTilesDrawNode + end + object btnClearIStaticsTiles: TSpeedButton + AnchorSideLeft.Control = btnDeleteIStaticsTiles + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = btnDeleteIStaticsTiles + Left = 30 + Height = 22 + Hint = 'Clear' + Top = 270 + Width = 22 + Color = clBtnFace + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000 + EFFF0000EDFF0000EDFF00000000000000000000000000000000000000000000 + 0000000000000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443 + F7FF3242F7FF141BF1FF0000EDFF000000000000000000000000000000000000 + 00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909 + F5FF161BF5FF3343F7FF141BF1FF0000EDFF0000000000000000000000000000 + F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333 + F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF00000000000000000000 + FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA + FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF00000000000000000000 + FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1 + FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00000000000000000000 + FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC + FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF00000000000000000000 + FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC + FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF00000000000000000000 + FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2 + FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FF00000000000000000000 + FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC + FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000000000000000 + FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B + FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000 + 00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D + FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000 + 0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663 + FEFF5461FEFF2227FCFF0000FBFF000000000000000000000000000000000000 + 000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000 + FDFF0000FDFF0000FDFF00000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000 + } + NumGlyphs = 0 + OnClick = btnClearIStaticsTilesClick + ShowHint = True + ParentShowHint = False + end + object btnDeleteIStaticsTiles: TSpeedButton + AnchorSideLeft.Control = gbInserStaticsTiles + AnchorSideBottom.Control = gbInserStaticsTiles + AnchorSideBottom.Side = asrBottom + Left = 4 + Height = 22 + Hint = 'Delete' + Top = 270 + Width = 22 + Anchors = [akLeft, akBottom] + BorderSpacing.Around = 4 + Color = clBtnFace + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000003853BEFF3551BDFF304BBCFF2E4E + B8FF000000000000000000000000000000000000000000000000000000000000 + 000000000000000000004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178 + E4FF334DC1FF2B4AB7FF00000000000000000000000000000000000000000000 + 0000000000004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84 + EEFF9EA0F4FF515DD7FF2B4AB7FF000000000000000000000000000000000000 + 00005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56 + E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FF0000000000000000000000000000 + 00004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59 + E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF0000000000000000000000005C62 + D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59 + E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF00000000000000005F63 + DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF00000000000000006469 + DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF0000000000000000676A + DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F + ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF00000000000000000000 + 00007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84 + F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF0000000000000000000000000000 + 00006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92 + F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF0000000000000000000000000000 + 0000000000006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9 + FBFFBAC7FCFF707BE9FF4C5BCCFF000000000000000000000000000000000000 + 000000000000000000006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4 + F4FF6670E2FF535ED1FF00000000000000000000000000000000000000000000 + 000000000000000000000000000000000000686ADDFF6364DCFF6164DAFF5D63 + D9FF000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000 + } + NumGlyphs = 0 + OnClick = btnDeleteIStaticsTilesClick + ShowHint = True + ParentShowHint = False + end + end + object gbStaticsProbability: TGroupBox + AnchorSideLeft.Control = gbInserStaticsTiles + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = gbInserStaticsTiles + Left = 241 + Height = 75 + Top = 8 + Width = 185 + AutoSize = True + Caption = 'Probability' + ClientHeight = 61 + ClientWidth = 183 + TabOrder = 1 + object Label5: TLabel + AnchorSideLeft.Control = gbStaticsProbability + AnchorSideTop.Control = gbStaticsProbability + AnchorSideRight.Control = gbStaticsProbability + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 30 + Top = 0 + Width = 173 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 4 + BorderSpacing.Right = 4 + BorderSpacing.Bottom = 4 + Caption = 'A tile will only be placed with this probability:' + ParentColor = False + WordWrap = True + end + object Label6: TLabel + AnchorSideLeft.Control = seStaticsProbability + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = seStaticsProbability + AnchorSideTop.Side = asrCenter + Left = 58 + Height = 14 + Top = 36 + Width = 12 + BorderSpacing.Left = 4 + Caption = '%' + ParentColor = False + end + object seStaticsProbability: TSpinEdit + AnchorSideLeft.Control = Label5 + AnchorSideTop.Control = Label5 + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 19 + Top = 34 + Width = 50 + BorderSpacing.Bottom = 8 + TabOrder = 0 + Value = 100 + end + end + object gbStaticsPlacement: TGroupBox + AnchorSideLeft.Control = gbInserStaticsTiles + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = gbStaticsProbability + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = gbStaticsProbability + AnchorSideRight.Side = asrBottom + Left = 241 + Height = 111 + Top = 87 + Width = 185 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 4 + Caption = 'Z Placement' + ClientHeight = 97 + ClientWidth = 183 + TabOrder = 2 + object rbPlaceStaticsOnTerrain: TRadioButton + AnchorSideLeft.Control = gbStaticsPlacement + AnchorSideTop.Control = gbStaticsPlacement + AnchorSideRight.Control = gbStaticsPlacement + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 22 + Top = 4 + Width = 173 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 4 + BorderSpacing.Top = 4 + BorderSpacing.Right = 4 + Caption = 'Place tiles on terrain' + Checked = True + State = cbChecked + TabOrder = 0 + end + object rbPlaceStaticsOnTop: TRadioButton + AnchorSideLeft.Control = rbPlaceStaticsOnTerrain + AnchorSideTop.Control = rbPlaceStaticsOnTerrain + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = rbPlaceStaticsOnTerrain + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 22 + Top = 26 + Width = 173 + Anchors = [akTop, akLeft, akRight] + Caption = 'Place tiles on top' + TabOrder = 1 + TabStop = False + end + object rbPlaceStaticsOnZ: TRadioButton + AnchorSideLeft.Control = rbPlaceStaticsOnTop + AnchorSideTop.Control = rbPlaceStaticsOnTop + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = rbPlaceStaticsOnTop + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 22 + Top = 48 + Width = 173 + Anchors = [akTop, akLeft, akRight] + Caption = 'Place tiles on:' + TabOrder = 2 + TabStop = False + end + object seInsertStaticsZ: TSpinEdit + AnchorSideLeft.Control = rbPlaceStaticsOnZ + AnchorSideTop.Control = rbPlaceStaticsOnZ + AnchorSideTop.Side = asrBottom + Left = 26 + Height = 19 + Top = 70 + Width = 50 + BorderSpacing.Left = 22 + BorderSpacing.Bottom = 8 + TabOrder = 3 + end + end + end + end + object btnClose: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 548 + Height = 25 + Top = 357 + Width = 64 + Anchors = [akRight, akBottom] + BorderSpacing.Around = 8 + BorderSpacing.InnerBorder = 4 + Caption = 'Close' + OnClick = btnCloseClick + TabOrder = 1 + end + object btnExecute: TButton + AnchorSideRight.Control = btnClose + AnchorSideBottom.Control = btnClose + AnchorSideBottom.Side = asrBottom + Left = 476 + Height = 25 + Top = 357 + Width = 64 + Anchors = [akRight, akBottom] + BorderSpacing.InnerBorder = 4 + Caption = 'Execute' + OnClick = btnExecuteClick + TabOrder = 2 + end + object vstArea: TVirtualStringTree + AnchorSideLeft.Control = Label1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Label1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = btnDeleteArea + Left = 4 + Height = 122 + Top = 154 + Width = 144 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Bottom = 4 + DefaultText = 'Node' + Header.AutoSizeIndex = 0 + Header.Columns = <> + Header.DefaultHeight = 17 + Header.MainColumn = -1 + Header.Options = [hoColumnResize, hoDrag] + TabOrder = 3 + TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] + TreeOptions.SelectionOptions = [toFullRowSelect] + OnChange = vstAreaChange + OnGetText = vstAreaGetText + end + object Label1: TLabel + AnchorSideLeft.Control = vstActions + AnchorSideTop.Control = vstActions + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = vstActions + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 14 + Top = 140 + Width = 144 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 4 + BorderSpacing.Top = 4 + BorderSpacing.Right = 4 + Caption = 'Area:' + ParentColor = False + end + object vstActions: TVirtualStringTree + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 0 + Height = 136 + Top = 0 + Width = 152 + DefaultText = 'Node' + Header.AutoSizeIndex = 0 + Header.Columns = < + item + Position = 0 + Text = 'Actions' + Width = 148 + end> + Header.DefaultHeight = 17 + Header.Options = [hoAutoResize, hoVisible] + Header.ParentFont = True + Header.Style = hsFlatButtons + TabOrder = 4 + TreeOptions.MiscOptions = [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning] + TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] + TreeOptions.SelectionOptions = [toFullRowSelect] + OnChange = vstActionsChange + OnChecked = vstActionsChecked + OnGetText = vstActionsGetText + OnPaintText = vstActionsPaintText + end + object btnAddArea: TSpeedButton + AnchorSideTop.Control = btnDeleteArea + AnchorSideRight.Control = btnDeleteArea + Left = 39 + Height = 22 + Hint = 'Add area' + Top = 280 + Width = 22 + Anchors = [akTop, akRight] + Color = clBtnFace + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000003A8C44FF368940FF32873CFF2F84 + 37FF000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000459653FF419950FF7DC28FFF96D0A6FF96CFA6FF78BE + 89FF368D42FF2C8134FF00000000000000000000000000000000000000000000 + 0000000000004D9C5DFF64B478FFA8DBB5FF87CC98FF66BC7DFF64BA7CFF86CB + 98FFA5D9B4FF58AA6BFF2C8134FF000000000000000000000000000000000000 + 000056A366FF6AB97DFFA8DBB2FF60BC77FF5CBA73FF59B870FF59B56FFF58B5 + 6FFF5BB774FFA5D9B3FF5AAA6CFF2C8234FF0000000000000000000000000000 + 000053AB68FFAADDB4FF64C179FF5FBE71FF60BC77FFFFFFFFFFFFFFFFFF59B8 + 70FF58B56EFF5CB774FFA6DAB4FF388F43FF00000000000000000000000061AC + 75FF8ACC98FF89D396FF6BC67AFF63C170FF55AB65FFFFFFFFFFFFFFFFFF59B8 + 70FF59B870FF5BB972FF85CC97FF7BBE8DFF308539FF000000000000000065AF + 7AFFA9DDB3FF7DCF8AFF75CC81FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF59B870FF67BE7DFF9CD4ABFF34883DFF000000000000000069B2 + 7EFFB6E2BEFF8BD597FF7AC986FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF59B870FF69C17EFF9DD4AAFF388B42FF00000000000000006DB5 + 83FFACDDB6FFA6DFAFFF81CB8CFF7CC986FF6EBD79FFFFFFFFFFFFFFFFFF5BAC + 6AFF60BC77FF5CBA73FF8BD199FF80C592FF3C8E47FF00000000000000000000 + 000085C797FFD2EED7FF95D9A0FF8AD394FF7FC889FFFFFFFFFFFFFFFFFF79CD + 85FF6BC37CFF6FC77EFFACDFB5FF459E57FF0000000000000000000000000000 + 000070B887FFAADAB7FFD8F1DCFF92D89DFF88CD93FF84CC8EFF8BD496FF8AD4 + 95FF83D28EFFAFE0B7FF6BB97DFF489856FF0000000000000000000000000000 + 00000000000070B887FFAFDCBBFFDCF2E0FFB6E4BDFF9BDBA5FF96D9A0FFA5DF + AFFFC0E8C5FF79C28AFF509E5FFF000000000000000000000000000000000000 + 0000000000000000000071B887FF94CEA4FFC3E6CBFFCFEBD4FFC9E9CEFFAFDD + B8FF6DB97FFF58A569FF00000000000000000000000000000000000000000000 + 0000000000000000000000000000000000006EB684FF6AB380FF67B17CFF63AE + 77FF000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000 + } + NumGlyphs = 0 + OnClick = btnAddAreaClick + ShowHint = True + ParentShowHint = False + end + object btnDeleteArea: TSpeedButton + AnchorSideLeft.Control = vstArea + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = vstArea + AnchorSideBottom.Control = seX1 + Left = 65 + Height = 22 + Hint = 'Delete area' + Top = 280 + Width = 22 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 4 + BorderSpacing.Around = 4 + Color = clBtnFace + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000003853BEFF3551BDFF304BBCFF2E4E + B8FF000000000000000000000000000000000000000000000000000000000000 + 000000000000000000004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178 + E4FF334DC1FF2B4AB7FF00000000000000000000000000000000000000000000 + 0000000000004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84 + EEFF9EA0F4FF515DD7FF2B4AB7FF000000000000000000000000000000000000 + 00005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56 + E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FF0000000000000000000000000000 + 00004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59 + E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF0000000000000000000000005C62 + D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59 + E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF00000000000000005F63 + DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF00000000000000006469 + DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF0000000000000000676A + DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F + ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF00000000000000000000 + 00007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84 + F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF0000000000000000000000000000 + 00006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92 + F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF0000000000000000000000000000 + 0000000000006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9 + FBFFBAC7FCFF707BE9FF4C5BCCFF000000000000000000000000000000000000 + 000000000000000000006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4 + F4FF6670E2FF535ED1FF00000000000000000000000000000000000000000000 + 000000000000000000000000000000000000686ADDFF6364DCFF6164DAFF5D63 + D9FF000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000 + } + NumGlyphs = 0 + OnClick = btnDeleteAreaClick + ShowHint = True + ParentShowHint = False + end + object btnClearArea: TSpeedButton + AnchorSideLeft.Control = btnDeleteArea + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = btnDeleteArea + Left = 91 + Height = 22 + Hint = 'Delete all areas' + Top = 280 + Width = 22 + Color = clBtnFace + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000 + EFFF0000EDFF0000EDFF00000000000000000000000000000000000000000000 + 0000000000000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443 + F7FF3242F7FF141BF1FF0000EDFF000000000000000000000000000000000000 + 00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909 + F5FF161BF5FF3343F7FF141BF1FF0000EDFF0000000000000000000000000000 + F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333 + F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF00000000000000000000 + FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA + FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF00000000000000000000 + FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1 + FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00000000000000000000 + FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC + FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF00000000000000000000 + FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC + FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF00000000000000000000 + FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2 + FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FF00000000000000000000 + FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC + FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000000000000000 + FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B + FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000 + 00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D + FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000 + 0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663 + FEFF5461FEFF2227FCFF0000FBFF000000000000000000000000000000000000 + 000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000 + FDFF0000FDFF0000FDFF00000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000 + } + NumGlyphs = 0 + OnClick = btnClearAreaClick + ShowHint = True + ParentShowHint = False + end + object lblX: TLabel + AnchorSideLeft.Control = lblY + AnchorSideTop.Control = seX1 + AnchorSideTop.Side = asrCenter + Left = 4 + Height = 14 + Top = 312 + Width = 8 + Caption = 'X' + Enabled = False + ParentColor = False + end + object seX1: TSpinEdit + AnchorSideLeft.Control = seY1 + AnchorSideBottom.Control = seY1 + Left = 20 + Height = 19 + Top = 310 + Width = 50 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 8 + Enabled = False + OnChange = seX1Change + TabOrder = 5 + Value = 1 + end + object seX2: TSpinEdit + AnchorSideLeft.Control = seX1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = seX1 + Left = 78 + Height = 19 + Top = 310 + Width = 50 + BorderSpacing.Left = 8 + Enabled = False + OnChange = seX1Change + TabOrder = 6 + Value = 1 + end + object lblY: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = seY1 + AnchorSideTop.Side = asrCenter + Left = 4 + Height = 14 + Top = 339 + Width = 8 + BorderSpacing.Left = 4 + Caption = 'Y' + Enabled = False + ParentColor = False + end + object seY1: TSpinEdit + AnchorSideLeft.Control = lblY + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = btnGrab1 + Left = 20 + Height = 19 + Top = 337 + Width = 50 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 4 + Enabled = False + OnChange = seX1Change + TabOrder = 7 + Value = 1 + end + object seY2: TSpinEdit + AnchorSideLeft.Control = seX2 + AnchorSideTop.Control = seY1 + Left = 78 + Height = 19 + Top = 337 + Width = 50 + Enabled = False + OnChange = seX1Change + TabOrder = 8 + Value = 1 + end + object btnGrab1: TSpeedButton + AnchorSideLeft.Control = seY1 + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 34 + Height = 22 + Hint = 'Grab coordinates from the main window.' + Top = 360 + Width = 22 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 8 + Color = clBtnFace + Enabled = False + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F7F7F067C7C + 7CE6787878CC75757581FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383835DAAAA + AAFFDBDBDBFF797979F275757506FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0097979709FFFFFF00FFFFFF00FFFFFF00888888E7DBDB + DBFFB7B7B7FF7D7D7D80FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF009C9C9CC99898981EFFFFFF0090909050ADADADFFF2F2 + F2FF848484FD8181810FFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00A0A0A0FF9C9C9CE798989836949494DFD9D9D9FFC1C1 + C1FF898989A0FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00A4A4A4FFD7D7D7FF9D9D9DF8D0D0D0FFEEEEEEFF9191 + 91FE8D8D8D18FFFFFF00FFFFFF00818181097E7E7E09FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00A9A9A9FFF2F2F2FFE5E5E5FFE2E2E2FFE3E3E3FF9595 + 95F4919191CC8D8D8DF9898989FF86868693FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00ADADADFFEEEEEEFFE1E1E1FFDFDFDFFFE0E0E0FFE7E7 + E7FFE4E4E4FFBBBBBBFF8E8E8E93FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00B1B1B1FFF0F0F0FFE4E4E4FFE2E2E2FFE2E2E2FFE7E7 + E7FFC1C1C1FF96969690FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00B5B5B5FFF2F2F2FFE8E8E8FFE7E7E7FFEAEAEAFFC6C6 + C6FF9E9E9E8DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00B9B9B9FFF4F4F4FFECECECFFEDEDEDFFCBCBCBFFA7A7 + A78AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00BDBDBDFFF7F7F7FFEFEFEFFFD0D0D0FFAFAFAF8AFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00C1C1C1FFF7F7F7FFD5D5D5FFB6B6B687FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00C4C4C4FFD9D9D9FFBEBEBE84FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00C8C8C8FFC5C5C581FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00CBCBCB7EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + NumGlyphs = 0 + OnClick = btnGrab1Click + ShowHint = True + ParentShowHint = False + end + object btnGrab2: TSpeedButton + AnchorSideLeft.Control = seY2 + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = btnGrab1 + AnchorSideBottom.Side = asrBottom + Left = 92 + Height = 22 + Hint = 'Grab coordinates from the main window.' + Top = 360 + Width = 22 + Anchors = [akLeft, akBottom] + Color = clBtnFace + Enabled = False + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F7F7F067C7C + 7CE6787878CC75757581FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383835DAAAA + AAFFDBDBDBFF797979F275757506FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0097979709FFFFFF00FFFFFF00FFFFFF00888888E7DBDB + DBFFB7B7B7FF7D7D7D80FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF009C9C9CC99898981EFFFFFF0090909050ADADADFFF2F2 + F2FF848484FD8181810FFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00A0A0A0FF9C9C9CE798989836949494DFD9D9D9FFC1C1 + C1FF898989A0FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00A4A4A4FFD7D7D7FF9D9D9DF8D0D0D0FFEEEEEEFF9191 + 91FE8D8D8D18FFFFFF00FFFFFF00818181097E7E7E09FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00A9A9A9FFF2F2F2FFE5E5E5FFE2E2E2FFE3E3E3FF9595 + 95F4919191CC8D8D8DF9898989FF86868693FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00ADADADFFEEEEEEFFE1E1E1FFDFDFDFFFE0E0E0FFE7E7 + E7FFE4E4E4FFBBBBBBFF8E8E8E93FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00B1B1B1FFF0F0F0FFE4E4E4FFE2E2E2FFE2E2E2FFE7E7 + E7FFC1C1C1FF96969690FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00B5B5B5FFF2F2F2FFE8E8E8FFE7E7E7FFEAEAEAFFC6C6 + C6FF9E9E9E8DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00B9B9B9FFF4F4F4FFECECECFFEDEDEDFFCBCBCBFFA7A7 + A78AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00BDBDBDFFF7F7F7FFEFEFEFFFD0D0D0FFAFAFAF8AFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00C1C1C1FFF7F7F7FFD5D5D5FFB6B6B687FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00C4C4C4FFD9D9D9FFBEBEBE84FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00C8C8C8FFC5C5C581FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00CBCBCB7EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + NumGlyphs = 0 + OnClick = btnGrab1Click + ShowHint = True + ParentShowHint = False + end + object pmSelectOffset: TPopupMenu + left = 421 + top = 82 + object mnuSelectTopLeft: TMenuItem + Caption = 'Select Top-Left Corner' + OnClick = mnuSelectTopLeftClick + end + object mnuSelectTopRight: TMenuItem + Caption = 'Select Top-Right Corner' + OnClick = mnuSelectTopLeftClick + end + object mnuSelectBottomLeft: TMenuItem + Caption = 'Select Bottom-Left Corner' + OnClick = mnuSelectTopLeftClick + end + object mnuSelectBottomRight: TMenuItem + Caption = 'Select Bottom-Right Corner' + OnClick = mnuSelectTopLeftClick + end + end +end diff --git a/Client/UfrmLargeScaleCommand.pas b/Client/UfrmLargeScaleCommand.pas index fe64221..58c8927 100644 --- a/Client/UfrmLargeScaleCommand.pas +++ b/Client/UfrmLargeScaleCommand.pas @@ -1,782 +1,782 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2008 Andreas Schneider - *) -unit UfrmLargeScaleCommand; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Math, - VirtualTrees, ExtCtrls, ImagingComponents, StdCtrls, Buttons, Spin, LCLIntf, - Menus, UPlatformTypes, UEnhancedMemoryStream, UWorldItem; - -type - - TAreaMoveType = (amLeft, amTop, amRight, amBottom); - TAreaMove = set of TAreaMoveType; - - { TfrmLargeScaleCommand } - - TfrmLargeScaleCommand = class(TForm) - btnAddArea: TSpeedButton; - btnClearArea: TSpeedButton; - btnClearDStaticsTiles: TSpeedButton; - btnClearIStaticsTiles: TSpeedButton; - btnClearTerrain: TSpeedButton; - btnClose: TButton; - btnDeleteArea: TSpeedButton; - btnDeleteDStaticsTiles: TSpeedButton; - btnDeleteIStaticsTiles: TSpeedButton; - btnDeleteTerrain: TSpeedButton; - btnExecute: TButton; - cbCMEraseTarget: TCheckBox; - gbDrawTerrainTiles: TGroupBox; - gbDeleteStaticsTiles: TGroupBox; - gbInserStaticsTiles: TGroupBox; - gbStaticsProbability: TGroupBox; - gbStaticsPlacement: TGroupBox; - GroupBox1: TGroupBox; - gbCMOffset: TGroupBox; - Label1: TLabel; - Label10: TLabel; - Label2: TLabel; - Label3: TLabel; - Label4: TLabel; - Label5: TLabel; - Label6: TLabel; - Label7: TLabel; - Label8: TLabel; - Label9: TLabel; - lblDrawTerrainTilesDesc: TLabel; - lblDeleteStaticsTilesDesc: TLabel; - lblInsertStaticsTiles: TLabel; - lblX: TLabel; - lblY: TLabel; - mnuSelectTopLeft: TMenuItem; - mnuSelectTopRight: TMenuItem; - mnuSelectBottomLeft: TMenuItem; - mnuSelectBottomRight: TMenuItem; - nbActions: TNotebook; - pgCopyMove: TPage; - pgDeleteStatics: TPage; - pgInsertStatics: TPage; - pgModifyAltitude: TPage; - pbArea: TPaintBox; - pgArea: TPage; - pgDrawTerrain: TPage; - pmSelectOffset: TPopupMenu; - rgCMAction: TRadioGroup; - rbPlaceStaticsOnTerrain: TRadioButton; - rbPlaceStaticsOnTop: TRadioButton; - rbPlaceStaticsOnZ: TRadioButton; - rbSetTerrainAltitude: TRadioButton; - rbRelativeAltitudeChange: TRadioButton; - sbArea: TScrollBox; - seDeleteStaticsZ1: TSpinEdit; - seDeleteStaticsZ2: TSpinEdit; - seTerrainAltitude1: TSpinEdit; - seTerrainAltitude2: TSpinEdit; - seRelativeAltitude: TSpinEdit; - seStaticsProbability: TSpinEdit; - seInsertStaticsZ: TSpinEdit; - seCMOffsetX: TSpinEdit; - seCMOffsetY: TSpinEdit; - seX1: TSpinEdit; - seX2: TSpinEdit; - seY1: TSpinEdit; - seY2: TSpinEdit; - btnGrab1: TSpeedButton; - btnGrab2: TSpeedButton; - btnGrabOffset: TSpeedButton; - vdtTerrainTiles: TVirtualDrawTree; - vdtInsertStaticsTiles: TVirtualDrawTree; - vdtDeleteStaticsTiles: TVirtualDrawTree; - vstActions: TVirtualStringTree; - vstArea: TVirtualStringTree; - procedure btnGrab1Click(Sender: TObject); - procedure btnGrabOffsetClick(Sender: TObject); - procedure FormShow(Sender: TObject); - procedure btnAddAreaClick(Sender: TObject); - procedure btnClearDStaticsTilesClick(Sender: TObject); - procedure btnClearIStaticsTilesClick(Sender: TObject); - procedure btnClearTerrainClick(Sender: TObject); - procedure btnCloseClick(Sender: TObject); - procedure btnDeleteDStaticsTilesClick(Sender: TObject); - procedure btnDeleteIStaticsTilesClick(Sender: TObject); - procedure btnDeleteTerrainClick(Sender: TObject); - procedure btnExecuteClick(Sender: TObject); - procedure FormCreate(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure mnuSelectTopLeftClick(Sender: TObject); - procedure pbAreaMouseDown(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); - procedure pbAreaMouseMove(Sender: TObject; Shift: TShiftState; X, - Y: Integer); - procedure pbAreaPaint(Sender: TObject); - procedure btnDeleteAreaClick(Sender: TObject); - procedure btnClearAreaClick(Sender: TObject); - procedure seX1Change(Sender: TObject); - procedure vdtTerrainTilesDragDrop(Sender: TBaseVirtualTree; Source: TObject; - DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState; - Pt: TPoint; var Effect: Integer; Mode: TDropMode); - procedure vdtTerrainTilesDragOver(Sender: TBaseVirtualTree; Source: TObject; - Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode; - var Effect: Integer; var Accept: Boolean); - procedure vdtTerrainTilesDrawNode(Sender: TBaseVirtualTree; - const PaintInfo: TVTPaintInfo); - procedure vstActionsChange(Sender: TBaseVirtualTree; Node: PVirtualNode); - procedure vstActionsChecked(Sender: TBaseVirtualTree; Node: PVirtualNode); - procedure vstActionsGetText(Sender: TBaseVirtualTree; - Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; - var CellText: String); - procedure vstActionsPaintText(Sender: TBaseVirtualTree; - const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; - TextType: TVSTTextType); - procedure vstAreaChange(Sender: TBaseVirtualTree; Node: PVirtualNode); - procedure vstAreaGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; - Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); - protected - FLastX: Integer; - FLastY: Integer; - FAreaMove: TAreaMove; - FAreaNode: PVirtualNode; - FCopyMoveNode: PVirtualNode; - FAltitudeNode: PVirtualNode; - FDrawTerrainNode: PVirtualNode; - FDelStaticsNode: PVirtualNode; - FAddStaticsNode: PVirtualNode; - FSelectFirst: Boolean; - FOffsetSelection: TObject; - FOldWindowState: TWindowState; - function AddNode(AActionID: Integer; ACaption: String): PVirtualNode; - function FindNode(AActionID: Integer): PVirtualNode; - procedure TileSelection(AWorldItem: TWorldItem); - procedure OffsetSelection(AWorldItem: TWorldItem); - procedure SerializeTiles(ATileList: TVirtualDrawTree; - AStream: TEnhancedMemoryStream); - public - { public declarations } - end; - -var - frmLargeScaleCommand: TfrmLargeScaleCommand; - -implementation - -uses - UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UPackets, - UGUIPlatformUtils; - -type - PNodeInfo = ^TNodeInfo; - TNodeInfo = record - ActionID: Integer; - Caption: String; - end; - PTileInfo = ^TTileInfo; - TTileInfo = record - ID: Word; - end; - -{ TfrmLargeScaleCommand } - -procedure TfrmLargeScaleCommand.FormCreate(Sender: TObject); -begin - vstActions.NodeDataSize := SizeOf(TNodeInfo); - FAreaNode := AddNode(-1, 'Target Area'); - FCopyMoveNode := AddNode( 0, 'Copy/Move'); - FAltitudeNode := AddNode( 1, 'Modify altitude'); - FDrawTerrainNode := AddNode( 2, 'Draw terrain'); - FDelStaticsNode := AddNode( 3, 'Delete statics'); - FAddStaticsNode := AddNode( 4, 'Insert statics'); - vstActions.Selected[vstActions.GetFirst] := True; - - vstArea.NodeDataSize := SizeOf(TRect); - - pbArea.Width := frmRadarMap.Radar.Width; - pbArea.Height := frmRadarMap.Radar.Height; - seX1.MaxValue := ResMan.Landscape.CellWidth; - seX2.MaxValue := ResMan.Landscape.CellWidth; - seY1.MaxValue := ResMan.Landscape.CellHeight; - seY2.MaxValue := ResMan.Landscape.CellHeight; - - vdtTerrainTiles.NodeDataSize := SizeOf(TTileInfo); - vdtInsertStaticsTiles.NodeDataSize := SizeOf(TTileInfo); - vdtDeleteStaticsTiles.NodeDataSize := SizeOf(TTileInfo); - - seCMOffsetX.MinValue := -ResMan.Landscape.CellWidth; - seCMOffsetX.MaxValue := ResMan.Landscape.CellWidth; - seCMOffsetY.MinValue := -ResMan.Landscape.CellHeight; - seCMOffsetY.MaxValue := ResMan.Landscape.CellHeight; - - frmRadarMap.Dependencies.Add(pbArea); -end; - -procedure TfrmLargeScaleCommand.FormDestroy(Sender: TObject); -begin - frmRadarMap.Dependencies.Remove(pbArea); -end; - -procedure TfrmLargeScaleCommand.mnuSelectTopLeftClick(Sender: TObject); -begin - FOffsetSelection := Sender; - frmMain.RegisterSelectionListener(@OffsetSelection); - FOldWindowState := WindowState; - WindowState := wsMinimized; - frmMain.SwitchToSelection; -end; - -procedure TfrmLargeScaleCommand.pbAreaMouseDown(Sender: TObject; - Button: TMouseButton; Shift: TShiftState; X, Y: Integer); -var - node, match: PVirtualNode; - nodeInfo: ^TRect; - p: TPoint; -begin - FAreaMove := []; - p := Point(X * 8, Y * 8); - match := nil; - node := vstArea.GetFirst; - while node <> nil do - begin - nodeInfo := vstArea.GetNodeData(node); - if PtInRect(nodeInfo^, p) then - match := node; - node := vstArea.GetNext(node); - end; - if match <> nil then - begin - nodeInfo := vstArea.GetNodeData(match); - if p.x - nodeInfo^.Left <= 64 then Include(FAreaMove, amLeft); - if p.y - nodeInfo^.Top <= 64 then Include(FAreaMove, amTop); - if nodeInfo^.Right - p.x <= 64 then Include(FAreaMove, amRight); - if nodeInfo^.Bottom - p.y <= 64 then Include(FAreaMove, amBottom); - if FAreaMove = [] then - FAreaMove := [amLeft, amTop, amRight, amBottom]; - end else - begin - match := vstArea.AddChild(nil); - nodeInfo := vstArea.GetNodeData(match); - nodeInfo^.Left := p.x; - nodeInfo^.Top := p.y; - nodeInfo^.Right := p.x; - nodeInfo^.Bottom := p.y; - FAreaMove := [amRight, amBottom]; - end; - vstArea.ClearSelection; - vstArea.Selected[match] := True; - FLastX := X; - FLastY := Y; -end; - -procedure TfrmLargeScaleCommand.pbAreaMouseMove(Sender: TObject; - Shift: TShiftState; X, Y: Integer); -var - offsetX, offsetY: Integer; -begin - if (ssLeft in Shift) and (vstArea.GetFirstSelected <> nil) then - begin - offsetX := (X - FLastX) * 8; - offsetY := (Y - FLastY) * 8; - if amLeft in FAreaMove then seX1.Value := seX1.Value + offsetX; - if amRight in FAreaMove then seX2.Value := seX2.Value + offsetX; - if amTop in FAreaMove then seY1.Value := seY1.Value + offsetY; - if amBottom in FAreaMove then seY2.Value := seY2.Value + offsetY; - FLastX := X; - FLastY := Y; - seX1Change(nil); - end; -end; - -procedure TfrmLargeScaleCommand.btnAddAreaClick(Sender: TObject); -var - node: PVirtualNode; - nodeInfo: ^TRect; -begin - node := vstArea.AddChild(nil); - nodeInfo := vstArea.GetNodeData(node); - nodeInfo^.Left := 0; - nodeInfo^.Top := 0; - nodeInfo^.Right := 0; - nodeInfo^.Bottom := 0; - vstArea.ClearSelection; - vstArea.Selected[node] := True; - vstArea.FocusedNode := node; -end; - -procedure TfrmLargeScaleCommand.FormShow(Sender: TObject); -begin - SetWindowParent(Handle, frmMain.Handle); -end; - -procedure TfrmLargeScaleCommand.btnGrab1Click(Sender: TObject); -begin - FSelectFirst := (Sender = btnGrab1); - frmMain.RegisterSelectionListener(@TileSelection); - FOldWindowState := WindowState; - WindowState := wsMinimized; - frmMain.SwitchToSelection; -end; - -procedure TfrmLargeScaleCommand.btnGrabOffsetClick(Sender: TObject); -begin - pmSelectOffset.PopUp; -end; - -procedure TfrmLargeScaleCommand.btnClearDStaticsTilesClick(Sender: TObject); -begin - vdtDeleteStaticsTiles.Clear; -end; - -procedure TfrmLargeScaleCommand.btnClearIStaticsTilesClick(Sender: TObject); -begin - vdtInsertStaticsTiles.Clear; -end; - -procedure TfrmLargeScaleCommand.btnClearTerrainClick(Sender: TObject); -begin - vdtTerrainTiles.Clear; -end; - -procedure TfrmLargeScaleCommand.btnCloseClick(Sender: TObject); -begin - Close; -end; - -procedure TfrmLargeScaleCommand.btnDeleteDStaticsTilesClick(Sender: TObject); -begin - vdtDeleteStaticsTiles.DeleteSelectedNodes; -end; - -procedure TfrmLargeScaleCommand.btnDeleteIStaticsTilesClick(Sender: TObject); -begin - vdtInsertStaticsTiles.DeleteSelectedNodes; -end; - -procedure TfrmLargeScaleCommand.btnDeleteTerrainClick(Sender: TObject); -begin - vdtTerrainTiles.DeleteSelectedNodes; -end; - -procedure TfrmLargeScaleCommand.btnExecuteClick(Sender: TObject); -var - packet: TPacket; - stream: TEnhancedMemoryStream; - areaCount: Byte; - i: Integer; - node: PVirtualNode; - areaInfo: ^TRect; -begin - packet := TPacket.Create($0E, 0); - stream := packet.Stream; - stream.Position := stream.Size; - - //Area - areaCount := Min(vstArea.RootNodeCount, 255); - stream.WriteByte(areaCount); - if areaCount = 0 then Exit; - i := 0; - node := vstArea.GetFirst; - while (node <> nil) and (i < areaCount) do - begin - areaInfo := vstArea.GetNodeData(node); - stream.WriteWord(Min(areaInfo^.Left, areaInfo^.Right)); - stream.WriteWord(Min(areaInfo^.Top, areaInfo^.Bottom)); - stream.WriteWord(Max(areaInfo^.Left, areaInfo^.Right)); - stream.WriteWord(Max(areaInfo^.Top, areaInfo^.Bottom)); - node := vstArea.GetNext(node); - Inc(i); - end; - - //Copy/Move - node := FindNode(0); - if vstActions.CheckState[node] = csCheckedNormal then - begin - stream.WriteBoolean(True); - stream.WriteByte(rgCMAction.ItemIndex); - stream.WriteInteger(seCMOffsetX.Value); - stream.WriteInteger(seCMOffsetY.Value); - stream.WriteBoolean(cbCMEraseTarget.Checked); - end else - stream.WriteBoolean(False); - - //Modify altitude - node := FindNode(1); - if vstActions.CheckState[node] = csCheckedNormal then - begin - stream.WriteBoolean(True); - if rbSetTerrainAltitude.Checked then - begin - stream.WriteByte(1); - stream.WriteShortInt(Min(seTerrainAltitude1.Value, seTerrainAltitude2.Value)); - stream.WriteShortInt(Max(seTerrainAltitude1.Value, seTerrainAltitude2.Value)); - end else - begin - stream.WriteByte(2); - stream.WriteShortInt(seRelativeAltitude.Value); - end; - end else - stream.WriteBoolean(False); - - //Draw terrain - node := FindNode(2); - if vstActions.CheckState[node] = csCheckedNormal then - begin - stream.WriteBoolean(True); - SerializeTiles(vdtTerrainTiles, stream); - end else - stream.WriteBoolean(False); - - //Delete statics - node := FindNode(3); - if vstActions.CheckState[node] = csCheckedNormal then - begin - stream.WriteBoolean(True); - SerializeTiles(vdtDeleteStaticsTiles, stream); - stream.WriteShortInt(Min(seDeleteStaticsZ1.Value, seDeleteStaticsZ2.Value)); - stream.WriteShortInt(Max(seDeleteStaticsZ1.Value, seDeleteStaticsZ2.Value)); - end else - stream.WriteBoolean(False); - - //Insert statics - node := FindNode(4); - if vstActions.CheckState[node] = csCheckedNormal then - begin - stream.WriteBoolean(True); - SerializeTiles(vdtInsertStaticsTiles, stream); - stream.WriteByte(seStaticsProbability.Value); - if rbPlaceStaticsOnZ.Checked then - begin - stream.WriteByte(3); - stream.WriteShortInt(seInsertStaticsZ.Value); - end else if rbPlaceStaticsOnTerrain.Checked then - stream.WriteByte(1) - else - stream.WriteByte(2); - end else - stream.WriteBoolean(False); - - dmNetwork.Send(TCompressedPacket.Create(packet)); - Close; -end; - -procedure TfrmLargeScaleCommand.pbAreaPaint(Sender: TObject); -var - node: PVirtualNode; - nodeInfo: ^TRect; - showMoveTarget: Boolean; -begin - showMoveTarget := FCopyMoveNode^.CheckState = csCheckedNormal; - - DisplayImage(pbArea.Canvas, 0, 0, frmRadarMap.Radar); - pbArea.Canvas.Pen.Color := clRed; - pbArea.Canvas.Brush.Color := clMaroon; - pbArea.Canvas.Brush.Style := bsFDiagonal; - node := vstArea.GetFirst; - while node <> nil do - begin - nodeInfo := vstArea.GetNodeData(node); - if vstArea.Selected[node] then - begin - pbArea.Canvas.Pen.Width := 2; - pbArea.Canvas.Pen.Style := psSolid; - end else - begin - pbArea.Canvas.Pen.Width := 1; - pbArea.Canvas.Pen.Style := psDot; - end; - - pbArea.Canvas.Brush.Style := bsFDiagonal; - pbArea.Canvas.Pen.Color := clRed; - pbArea.Canvas.Brush.Color := clMaroon; - pbArea.Canvas.Rectangle(nodeInfo^.Left div 8, nodeInfo^.Top div 8, - nodeInfo^.Right div 8 + 1, nodeInfo^.Bottom div 8 + 1); - - if showMoveTarget then - begin - pbArea.Canvas.Brush.Style := bsBDiagonal; - pbArea.Canvas.Pen.Color := clBlue; - pbArea.Canvas.Brush.Color := clNavy; - pbArea.Canvas.Rectangle((nodeInfo^.Left + seCMOffsetX.Value) div 8, - (nodeInfo^.Top + seCMOffsetY.Value) div 8, - (nodeInfo^.Right + seCMOffsetX.Value) div 8 + 1, - (nodeInfo^.Bottom + seCMOffsetY.Value) div 8 + 1); - end; - - node := vstArea.GetNext(node); - end; -end; - -procedure TfrmLargeScaleCommand.btnDeleteAreaClick(Sender: TObject); -begin - vstArea.DeleteSelectedNodes; - vstAreaChange(vstArea, nil); -end; - -procedure TfrmLargeScaleCommand.btnClearAreaClick(Sender: TObject); -begin - vstArea.Clear; - vstAreaChange(vstArea, nil); -end; - -procedure TfrmLargeScaleCommand.seX1Change(Sender: TObject); -var - node: PVirtualNode; - nodeInfo: ^TRect; -begin - node := vstArea.GetFirstSelected; - if node <> nil then - begin - nodeInfo := vstArea.GetNodeData(node); - nodeInfo^.Left := seX1.Value; - nodeInfo^.Right := seX2.Value; - nodeInfo^.Top := seY1.Value; - nodeInfo^.Bottom := seY2.Value; - vstArea.InvalidateNode(node); - pbArea.Repaint; - end; -end; - -procedure TfrmLargeScaleCommand.vdtTerrainTilesDragDrop(Sender: TBaseVirtualTree; - Source: TObject; DataObject: IDataObject; Formats: TFormatArray; - Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode); -var - sourceTree: TVirtualDrawTree; - selected, node: PVirtualNode; - sourceTileInfo, targetTileInfo: PTileInfo; -begin - sourceTree := Source as TVirtualDrawTree; - if (sourceTree <> Sender) and (sourceTree <> nil) and - (sourceTree.Tag = 1) then - begin - Sender.BeginUpdate; - selected := sourceTree.GetFirstSelected; - while selected <> nil do - begin - sourceTileInfo := sourceTree.GetNodeData(selected); - if ((Sender = vdtTerrainTiles) and (sourceTileInfo^.ID < $4000)) or - ((Sender = vdtInsertStaticsTiles) and (sourceTileInfo^.ID > $3FFF)) or - ((Sender = vdtDeleteStaticsTiles) and (sourceTileInfo^.ID > $3FFF)) then - begin - node := Sender.AddChild(nil); - targetTileInfo := Sender.GetNodeData(node); - targetTileInfo^.ID := sourceTileInfo^.ID; - end; - selected := sourceTree.GetNextSelected(selected); - end; - Sender.EndUpdate; - end; -end; - -procedure TfrmLargeScaleCommand.vdtTerrainTilesDragOver(Sender: TBaseVirtualTree; - Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; - Mode: TDropMode; var Effect: Integer; var Accept: Boolean); -begin - if (Source <> Sender) and (Source is TVirtualDrawTree) and - (TVirtualDrawTree(Source).Tag = 1) then - begin - Accept := True; - end; -end; - -procedure TfrmLargeScaleCommand.vdtTerrainTilesDrawNode( - Sender: TBaseVirtualTree; const PaintInfo: TVTPaintInfo); -begin - frmMain.vdtTilesDrawNode(Sender, PaintInfo); -end; - -procedure TfrmLargeScaleCommand.vstActionsChange(Sender: TBaseVirtualTree; - Node: PVirtualNode); -var - nodeInfo: PNodeInfo; -begin - if Sender.Selected[Node] then - begin - nodeInfo := Sender.GetNodeData(Node); - nbActions.PageIndex := nodeInfo^.ActionID + 1; - end; -end; - -procedure TfrmLargeScaleCommand.vstActionsChecked(Sender: TBaseVirtualTree; - Node: PVirtualNode); -begin - if Node = FCopyMoveNode then - pbArea.Repaint; -end; - -procedure TfrmLargeScaleCommand.vstActionsGetText( - Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; - TextType: TVSTTextType; var CellText: String); -var - nodeInfo: PNodeInfo; -begin - nodeInfo := Sender.GetNodeData(Node); - CellText := nodeInfo^.Caption; -end; - -procedure TfrmLargeScaleCommand.vstActionsPaintText(Sender: TBaseVirtualTree; - const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; - TextType: TVSTTextType); -begin - if Sender.Selected[Node] then - TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold]; -end; - -procedure TfrmLargeScaleCommand.vstAreaChange(Sender: TBaseVirtualTree; - Node: PVirtualNode); -var - nodeInfo: ^TRect; - selected: Boolean; -begin - selected := (Node <> nil) and Sender.Selected[Node]; - btnDeleteArea.Enabled := selected; - lblX.Enabled := selected; - lblY.Enabled := selected; - seX1.Enabled := selected; - seX2.Enabled := selected; - seY1.Enabled := selected; - seY2.Enabled := selected; - btnGrab1.Enabled := selected; - btnGrab2.Enabled := selected; - btnGrabOffset.Enabled := selected; - if selected then - begin - nodeInfo := Sender.GetNodeData(Node); - seX1.Value := nodeInfo^.Left; - seX2.Value := nodeInfo^.Right; - seY1.Value := nodeInfo^.Top; - seY2.Value := nodeInfo^.Bottom; - end; - pbArea.Repaint; -end; - -procedure TfrmLargeScaleCommand.vstAreaGetText(Sender: TBaseVirtualTree; - Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; - var CellText: String); -var - nodeInfo: ^TRect; -begin - nodeInfo := Sender.GetNodeData(Node); - CellText := Format('(%d, %d), (%d, %d)', [nodeInfo^.Left, nodeInfo^.Top, - nodeInfo^.Right, nodeInfo^.Bottom]); -end; - -function TfrmLargeScaleCommand.AddNode(AActionID: Integer; - ACaption: String): PVirtualNode; -var - node: PVirtualNode; - nodeInfo: PNodeInfo; -begin - node := vstActions.AddChild(nil); - nodeInfo := vstActions.GetNodeData(node); - nodeInfo^.ActionID := AActionID; - nodeInfo^.Caption := ACaption; - if AActionID > -1 then - vstActions.CheckType[node] := ctCheckBox; - - Result := node; -end; - -function TfrmLargeScaleCommand.FindNode(AActionID: Integer): PVirtualNode; -var - node: PVirtualNode; - nodeInfo: PNodeInfo; -begin - Result := nil; - node := vstActions.GetFirst; - while (node <> nil) and (Result = nil) do - begin - nodeInfo := vstActions.GetNodeData(node); - if nodeInfo^.ActionID = AActionID then - Result := node; - node := vstActions.GetNext(node); - end; -end; - -procedure TfrmLargeScaleCommand.TileSelection(AWorldItem: TWorldItem); -begin - if FSelectFirst then - begin - seX1.Value := AWorldItem.X; - seY1.Value := AWorldItem.Y; - end else - begin - seX2.Value := AWorldItem.X; - seY2.Value := AWorldItem.Y; - end; - seX1Change(nil); - frmMain.UnregisterSelectionListener(@TileSelection); - WindowState := FOldWindowState; -end; - -procedure TfrmLargeScaleCommand.OffsetSelection(AWorldItem: TWorldItem); -begin - if FOffsetSelection = mnuSelectTopLeft then - begin - seCMOffsetX.Value := AWorldItem.X - Min(seX1.Value, seX2.Value); - seCMOffsetY.Value := AWorldItem.Y - Min(seY1.Value, seY2.Value); - end else - if FOffsetSelection = mnuSelectTopRight then - begin - seCMOffsetX.Value := AWorldItem.X - Max(seX1.Value, seX2.Value); - seCMOffsetY.Value := AWorldItem.Y - Min(seY1.Value,seY2.Value); - end else - if FOffsetSelection = mnuSelectBottomLeft then - begin - seCMOffsetX.Value := AWorldItem.X - Min(seX1.Value, seX2.Value); - seCMOffsetY.Value := AWorldItem.Y - Max(seY1.Value, seY2.Value); - end else - if FOffsetSelection = mnuSelectBottomRight then - begin - seCMOffsetX.Value := AWorldItem.X - Max(seX1.Value, seX2.Value); - seCMOffsetY.Value := AWorldItem.Y - Max(seY1.Value, seY2.Value); - end; - frmMain.UnregisterSelectionListener(@OffsetSelection); - WindowState := FOldWindowState; -end; - -procedure TfrmLargeScaleCommand.SerializeTiles(ATileList: TVirtualDrawTree; - AStream: TEnhancedMemoryStream); -var - node: PVirtualNode; - tileInfo: PTileInfo; -begin - AStream.WriteWord(ATileList.RootNodeCount); - node := ATileList.GetFirst; - while node <> nil do - begin - tileInfo := ATileList.GetNodeData(node); - AStream.WriteWord(tileInfo^.ID); - node := ATileList.GetNext(node); - end; -end; - -initialization - {$I UfrmLargeScaleCommand.lrs} - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2008 Andreas Schneider + *) +unit UfrmLargeScaleCommand; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Math, + VirtualTrees, ExtCtrls, ImagingComponents, StdCtrls, Buttons, Spin, LCLIntf, + Menus, UPlatformTypes, UEnhancedMemoryStream, UWorldItem; + +type + + TAreaMoveType = (amLeft, amTop, amRight, amBottom); + TAreaMove = set of TAreaMoveType; + + { TfrmLargeScaleCommand } + + TfrmLargeScaleCommand = class(TForm) + btnAddArea: TSpeedButton; + btnClearArea: TSpeedButton; + btnClearDStaticsTiles: TSpeedButton; + btnClearIStaticsTiles: TSpeedButton; + btnClearTerrain: TSpeedButton; + btnClose: TButton; + btnDeleteArea: TSpeedButton; + btnDeleteDStaticsTiles: TSpeedButton; + btnDeleteIStaticsTiles: TSpeedButton; + btnDeleteTerrain: TSpeedButton; + btnExecute: TButton; + cbCMEraseTarget: TCheckBox; + gbDrawTerrainTiles: TGroupBox; + gbDeleteStaticsTiles: TGroupBox; + gbInserStaticsTiles: TGroupBox; + gbStaticsProbability: TGroupBox; + gbStaticsPlacement: TGroupBox; + GroupBox1: TGroupBox; + gbCMOffset: TGroupBox; + Label1: TLabel; + Label10: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + Label6: TLabel; + Label7: TLabel; + Label8: TLabel; + Label9: TLabel; + lblDrawTerrainTilesDesc: TLabel; + lblDeleteStaticsTilesDesc: TLabel; + lblInsertStaticsTiles: TLabel; + lblX: TLabel; + lblY: TLabel; + mnuSelectTopLeft: TMenuItem; + mnuSelectTopRight: TMenuItem; + mnuSelectBottomLeft: TMenuItem; + mnuSelectBottomRight: TMenuItem; + nbActions: TNotebook; + pgCopyMove: TPage; + pgDeleteStatics: TPage; + pgInsertStatics: TPage; + pgModifyAltitude: TPage; + pbArea: TPaintBox; + pgArea: TPage; + pgDrawTerrain: TPage; + pmSelectOffset: TPopupMenu; + rgCMAction: TRadioGroup; + rbPlaceStaticsOnTerrain: TRadioButton; + rbPlaceStaticsOnTop: TRadioButton; + rbPlaceStaticsOnZ: TRadioButton; + rbSetTerrainAltitude: TRadioButton; + rbRelativeAltitudeChange: TRadioButton; + sbArea: TScrollBox; + seDeleteStaticsZ1: TSpinEdit; + seDeleteStaticsZ2: TSpinEdit; + seTerrainAltitude1: TSpinEdit; + seTerrainAltitude2: TSpinEdit; + seRelativeAltitude: TSpinEdit; + seStaticsProbability: TSpinEdit; + seInsertStaticsZ: TSpinEdit; + seCMOffsetX: TSpinEdit; + seCMOffsetY: TSpinEdit; + seX1: TSpinEdit; + seX2: TSpinEdit; + seY1: TSpinEdit; + seY2: TSpinEdit; + btnGrab1: TSpeedButton; + btnGrab2: TSpeedButton; + btnGrabOffset: TSpeedButton; + vdtTerrainTiles: TVirtualDrawTree; + vdtInsertStaticsTiles: TVirtualDrawTree; + vdtDeleteStaticsTiles: TVirtualDrawTree; + vstActions: TVirtualStringTree; + vstArea: TVirtualStringTree; + procedure btnGrab1Click(Sender: TObject); + procedure btnGrabOffsetClick(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure btnAddAreaClick(Sender: TObject); + procedure btnClearDStaticsTilesClick(Sender: TObject); + procedure btnClearIStaticsTilesClick(Sender: TObject); + procedure btnClearTerrainClick(Sender: TObject); + procedure btnCloseClick(Sender: TObject); + procedure btnDeleteDStaticsTilesClick(Sender: TObject); + procedure btnDeleteIStaticsTilesClick(Sender: TObject); + procedure btnDeleteTerrainClick(Sender: TObject); + procedure btnExecuteClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure mnuSelectTopLeftClick(Sender: TObject); + procedure pbAreaMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure pbAreaMouseMove(Sender: TObject; Shift: TShiftState; X, + Y: Integer); + procedure pbAreaPaint(Sender: TObject); + procedure btnDeleteAreaClick(Sender: TObject); + procedure btnClearAreaClick(Sender: TObject); + procedure seX1Change(Sender: TObject); + procedure vdtTerrainTilesDragDrop(Sender: TBaseVirtualTree; Source: TObject; + DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState; + Pt: TPoint; var Effect: Integer; Mode: TDropMode); + procedure vdtTerrainTilesDragOver(Sender: TBaseVirtualTree; Source: TObject; + Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode; + var Effect: Integer; var Accept: Boolean); + procedure vdtTerrainTilesDrawNode(Sender: TBaseVirtualTree; + const PaintInfo: TVTPaintInfo); + procedure vstActionsChange(Sender: TBaseVirtualTree; Node: PVirtualNode); + procedure vstActionsChecked(Sender: TBaseVirtualTree; Node: PVirtualNode); + procedure vstActionsGetText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: String); + procedure vstActionsPaintText(Sender: TBaseVirtualTree; + const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType); + procedure vstAreaChange(Sender: TBaseVirtualTree; Node: PVirtualNode); + procedure vstAreaGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); + protected + FLastX: Integer; + FLastY: Integer; + FAreaMove: TAreaMove; + FAreaNode: PVirtualNode; + FCopyMoveNode: PVirtualNode; + FAltitudeNode: PVirtualNode; + FDrawTerrainNode: PVirtualNode; + FDelStaticsNode: PVirtualNode; + FAddStaticsNode: PVirtualNode; + FSelectFirst: Boolean; + FOffsetSelection: TObject; + FOldWindowState: TWindowState; + function AddNode(AActionID: Integer; ACaption: String): PVirtualNode; + function FindNode(AActionID: Integer): PVirtualNode; + procedure TileSelection(AWorldItem: TWorldItem); + procedure OffsetSelection(AWorldItem: TWorldItem); + procedure SerializeTiles(ATileList: TVirtualDrawTree; + AStream: TEnhancedMemoryStream); + public + { public declarations } + end; + +var + frmLargeScaleCommand: TfrmLargeScaleCommand; + +implementation + +uses + UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UPackets, + UGUIPlatformUtils; + +type + PNodeInfo = ^TNodeInfo; + TNodeInfo = record + ActionID: Integer; + Caption: String; + end; + PTileInfo = ^TTileInfo; + TTileInfo = record + ID: Word; + end; + +{ TfrmLargeScaleCommand } + +procedure TfrmLargeScaleCommand.FormCreate(Sender: TObject); +begin + vstActions.NodeDataSize := SizeOf(TNodeInfo); + FAreaNode := AddNode(-1, 'Target Area'); + FCopyMoveNode := AddNode( 0, 'Copy/Move'); + FAltitudeNode := AddNode( 1, 'Modify altitude'); + FDrawTerrainNode := AddNode( 2, 'Draw terrain'); + FDelStaticsNode := AddNode( 3, 'Delete statics'); + FAddStaticsNode := AddNode( 4, 'Insert statics'); + vstActions.Selected[vstActions.GetFirst] := True; + + vstArea.NodeDataSize := SizeOf(TRect); + + pbArea.Width := frmRadarMap.Radar.Width; + pbArea.Height := frmRadarMap.Radar.Height; + seX1.MaxValue := ResMan.Landscape.CellWidth; + seX2.MaxValue := ResMan.Landscape.CellWidth; + seY1.MaxValue := ResMan.Landscape.CellHeight; + seY2.MaxValue := ResMan.Landscape.CellHeight; + + vdtTerrainTiles.NodeDataSize := SizeOf(TTileInfo); + vdtInsertStaticsTiles.NodeDataSize := SizeOf(TTileInfo); + vdtDeleteStaticsTiles.NodeDataSize := SizeOf(TTileInfo); + + seCMOffsetX.MinValue := -ResMan.Landscape.CellWidth; + seCMOffsetX.MaxValue := ResMan.Landscape.CellWidth; + seCMOffsetY.MinValue := -ResMan.Landscape.CellHeight; + seCMOffsetY.MaxValue := ResMan.Landscape.CellHeight; + + frmRadarMap.Dependencies.Add(pbArea); +end; + +procedure TfrmLargeScaleCommand.FormDestroy(Sender: TObject); +begin + frmRadarMap.Dependencies.Remove(pbArea); +end; + +procedure TfrmLargeScaleCommand.mnuSelectTopLeftClick(Sender: TObject); +begin + FOffsetSelection := Sender; + frmMain.RegisterSelectionListener(@OffsetSelection); + FOldWindowState := WindowState; + WindowState := wsMinimized; + frmMain.SwitchToSelection; +end; + +procedure TfrmLargeScaleCommand.pbAreaMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var + node, match: PVirtualNode; + nodeInfo: ^TRect; + p: TPoint; +begin + FAreaMove := []; + p := Point(X * 8, Y * 8); + match := nil; + node := vstArea.GetFirst; + while node <> nil do + begin + nodeInfo := vstArea.GetNodeData(node); + if PtInRect(nodeInfo^, p) then + match := node; + node := vstArea.GetNext(node); + end; + if match <> nil then + begin + nodeInfo := vstArea.GetNodeData(match); + if p.x - nodeInfo^.Left <= 64 then Include(FAreaMove, amLeft); + if p.y - nodeInfo^.Top <= 64 then Include(FAreaMove, amTop); + if nodeInfo^.Right - p.x <= 64 then Include(FAreaMove, amRight); + if nodeInfo^.Bottom - p.y <= 64 then Include(FAreaMove, amBottom); + if FAreaMove = [] then + FAreaMove := [amLeft, amTop, amRight, amBottom]; + end else + begin + match := vstArea.AddChild(nil); + nodeInfo := vstArea.GetNodeData(match); + nodeInfo^.Left := p.x; + nodeInfo^.Top := p.y; + nodeInfo^.Right := p.x; + nodeInfo^.Bottom := p.y; + FAreaMove := [amRight, amBottom]; + end; + vstArea.ClearSelection; + vstArea.Selected[match] := True; + FLastX := X; + FLastY := Y; +end; + +procedure TfrmLargeScaleCommand.pbAreaMouseMove(Sender: TObject; + Shift: TShiftState; X, Y: Integer); +var + offsetX, offsetY: Integer; +begin + if (ssLeft in Shift) and (vstArea.GetFirstSelected <> nil) then + begin + offsetX := (X - FLastX) * 8; + offsetY := (Y - FLastY) * 8; + if amLeft in FAreaMove then seX1.Value := seX1.Value + offsetX; + if amRight in FAreaMove then seX2.Value := seX2.Value + offsetX; + if amTop in FAreaMove then seY1.Value := seY1.Value + offsetY; + if amBottom in FAreaMove then seY2.Value := seY2.Value + offsetY; + FLastX := X; + FLastY := Y; + seX1Change(nil); + end; +end; + +procedure TfrmLargeScaleCommand.btnAddAreaClick(Sender: TObject); +var + node: PVirtualNode; + nodeInfo: ^TRect; +begin + node := vstArea.AddChild(nil); + nodeInfo := vstArea.GetNodeData(node); + nodeInfo^.Left := 0; + nodeInfo^.Top := 0; + nodeInfo^.Right := 0; + nodeInfo^.Bottom := 0; + vstArea.ClearSelection; + vstArea.Selected[node] := True; + vstArea.FocusedNode := node; +end; + +procedure TfrmLargeScaleCommand.FormShow(Sender: TObject); +begin + SetWindowParent(Handle, frmMain.Handle); +end; + +procedure TfrmLargeScaleCommand.btnGrab1Click(Sender: TObject); +begin + FSelectFirst := (Sender = btnGrab1); + frmMain.RegisterSelectionListener(@TileSelection); + FOldWindowState := WindowState; + WindowState := wsMinimized; + frmMain.SwitchToSelection; +end; + +procedure TfrmLargeScaleCommand.btnGrabOffsetClick(Sender: TObject); +begin + pmSelectOffset.PopUp; +end; + +procedure TfrmLargeScaleCommand.btnClearDStaticsTilesClick(Sender: TObject); +begin + vdtDeleteStaticsTiles.Clear; +end; + +procedure TfrmLargeScaleCommand.btnClearIStaticsTilesClick(Sender: TObject); +begin + vdtInsertStaticsTiles.Clear; +end; + +procedure TfrmLargeScaleCommand.btnClearTerrainClick(Sender: TObject); +begin + vdtTerrainTiles.Clear; +end; + +procedure TfrmLargeScaleCommand.btnCloseClick(Sender: TObject); +begin + Close; +end; + +procedure TfrmLargeScaleCommand.btnDeleteDStaticsTilesClick(Sender: TObject); +begin + vdtDeleteStaticsTiles.DeleteSelectedNodes; +end; + +procedure TfrmLargeScaleCommand.btnDeleteIStaticsTilesClick(Sender: TObject); +begin + vdtInsertStaticsTiles.DeleteSelectedNodes; +end; + +procedure TfrmLargeScaleCommand.btnDeleteTerrainClick(Sender: TObject); +begin + vdtTerrainTiles.DeleteSelectedNodes; +end; + +procedure TfrmLargeScaleCommand.btnExecuteClick(Sender: TObject); +var + packet: TPacket; + stream: TEnhancedMemoryStream; + areaCount: Byte; + i: Integer; + node: PVirtualNode; + areaInfo: ^TRect; +begin + packet := TPacket.Create($0E, 0); + stream := packet.Stream; + stream.Position := stream.Size; + + //Area + areaCount := Min(vstArea.RootNodeCount, 255); + stream.WriteByte(areaCount); + if areaCount = 0 then Exit; + i := 0; + node := vstArea.GetFirst; + while (node <> nil) and (i < areaCount) do + begin + areaInfo := vstArea.GetNodeData(node); + stream.WriteWord(Min(areaInfo^.Left, areaInfo^.Right)); + stream.WriteWord(Min(areaInfo^.Top, areaInfo^.Bottom)); + stream.WriteWord(Max(areaInfo^.Left, areaInfo^.Right)); + stream.WriteWord(Max(areaInfo^.Top, areaInfo^.Bottom)); + node := vstArea.GetNext(node); + Inc(i); + end; + + //Copy/Move + node := FindNode(0); + if vstActions.CheckState[node] = csCheckedNormal then + begin + stream.WriteBoolean(True); + stream.WriteByte(rgCMAction.ItemIndex); + stream.WriteInteger(seCMOffsetX.Value); + stream.WriteInteger(seCMOffsetY.Value); + stream.WriteBoolean(cbCMEraseTarget.Checked); + end else + stream.WriteBoolean(False); + + //Modify altitude + node := FindNode(1); + if vstActions.CheckState[node] = csCheckedNormal then + begin + stream.WriteBoolean(True); + if rbSetTerrainAltitude.Checked then + begin + stream.WriteByte(1); + stream.WriteShortInt(Min(seTerrainAltitude1.Value, seTerrainAltitude2.Value)); + stream.WriteShortInt(Max(seTerrainAltitude1.Value, seTerrainAltitude2.Value)); + end else + begin + stream.WriteByte(2); + stream.WriteShortInt(seRelativeAltitude.Value); + end; + end else + stream.WriteBoolean(False); + + //Draw terrain + node := FindNode(2); + if vstActions.CheckState[node] = csCheckedNormal then + begin + stream.WriteBoolean(True); + SerializeTiles(vdtTerrainTiles, stream); + end else + stream.WriteBoolean(False); + + //Delete statics + node := FindNode(3); + if vstActions.CheckState[node] = csCheckedNormal then + begin + stream.WriteBoolean(True); + SerializeTiles(vdtDeleteStaticsTiles, stream); + stream.WriteShortInt(Min(seDeleteStaticsZ1.Value, seDeleteStaticsZ2.Value)); + stream.WriteShortInt(Max(seDeleteStaticsZ1.Value, seDeleteStaticsZ2.Value)); + end else + stream.WriteBoolean(False); + + //Insert statics + node := FindNode(4); + if vstActions.CheckState[node] = csCheckedNormal then + begin + stream.WriteBoolean(True); + SerializeTiles(vdtInsertStaticsTiles, stream); + stream.WriteByte(seStaticsProbability.Value); + if rbPlaceStaticsOnZ.Checked then + begin + stream.WriteByte(3); + stream.WriteShortInt(seInsertStaticsZ.Value); + end else if rbPlaceStaticsOnTerrain.Checked then + stream.WriteByte(1) + else + stream.WriteByte(2); + end else + stream.WriteBoolean(False); + + dmNetwork.Send(TCompressedPacket.Create(packet)); + Close; +end; + +procedure TfrmLargeScaleCommand.pbAreaPaint(Sender: TObject); +var + node: PVirtualNode; + nodeInfo: ^TRect; + showMoveTarget: Boolean; +begin + showMoveTarget := FCopyMoveNode^.CheckState = csCheckedNormal; + + DisplayImage(pbArea.Canvas, 0, 0, frmRadarMap.Radar); + pbArea.Canvas.Pen.Color := clRed; + pbArea.Canvas.Brush.Color := clMaroon; + pbArea.Canvas.Brush.Style := bsFDiagonal; + node := vstArea.GetFirst; + while node <> nil do + begin + nodeInfo := vstArea.GetNodeData(node); + if vstArea.Selected[node] then + begin + pbArea.Canvas.Pen.Width := 2; + pbArea.Canvas.Pen.Style := psSolid; + end else + begin + pbArea.Canvas.Pen.Width := 1; + pbArea.Canvas.Pen.Style := psDot; + end; + + pbArea.Canvas.Brush.Style := bsFDiagonal; + pbArea.Canvas.Pen.Color := clRed; + pbArea.Canvas.Brush.Color := clMaroon; + pbArea.Canvas.Rectangle(nodeInfo^.Left div 8, nodeInfo^.Top div 8, + nodeInfo^.Right div 8 + 1, nodeInfo^.Bottom div 8 + 1); + + if showMoveTarget then + begin + pbArea.Canvas.Brush.Style := bsBDiagonal; + pbArea.Canvas.Pen.Color := clBlue; + pbArea.Canvas.Brush.Color := clNavy; + pbArea.Canvas.Rectangle((nodeInfo^.Left + seCMOffsetX.Value) div 8, + (nodeInfo^.Top + seCMOffsetY.Value) div 8, + (nodeInfo^.Right + seCMOffsetX.Value) div 8 + 1, + (nodeInfo^.Bottom + seCMOffsetY.Value) div 8 + 1); + end; + + node := vstArea.GetNext(node); + end; +end; + +procedure TfrmLargeScaleCommand.btnDeleteAreaClick(Sender: TObject); +begin + vstArea.DeleteSelectedNodes; + vstAreaChange(vstArea, nil); +end; + +procedure TfrmLargeScaleCommand.btnClearAreaClick(Sender: TObject); +begin + vstArea.Clear; + vstAreaChange(vstArea, nil); +end; + +procedure TfrmLargeScaleCommand.seX1Change(Sender: TObject); +var + node: PVirtualNode; + nodeInfo: ^TRect; +begin + node := vstArea.GetFirstSelected; + if node <> nil then + begin + nodeInfo := vstArea.GetNodeData(node); + nodeInfo^.Left := seX1.Value; + nodeInfo^.Right := seX2.Value; + nodeInfo^.Top := seY1.Value; + nodeInfo^.Bottom := seY2.Value; + vstArea.InvalidateNode(node); + pbArea.Repaint; + end; +end; + +procedure TfrmLargeScaleCommand.vdtTerrainTilesDragDrop(Sender: TBaseVirtualTree; + Source: TObject; DataObject: IDataObject; Formats: TFormatArray; + Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode); +var + sourceTree: TVirtualDrawTree; + selected, node: PVirtualNode; + sourceTileInfo, targetTileInfo: PTileInfo; +begin + sourceTree := Source as TVirtualDrawTree; + if (sourceTree <> Sender) and (sourceTree <> nil) and + (sourceTree.Tag = 1) then + begin + Sender.BeginUpdate; + selected := sourceTree.GetFirstSelected; + while selected <> nil do + begin + sourceTileInfo := sourceTree.GetNodeData(selected); + if ((Sender = vdtTerrainTiles) and (sourceTileInfo^.ID < $4000)) or + ((Sender = vdtInsertStaticsTiles) and (sourceTileInfo^.ID > $3FFF)) or + ((Sender = vdtDeleteStaticsTiles) and (sourceTileInfo^.ID > $3FFF)) then + begin + node := Sender.AddChild(nil); + targetTileInfo := Sender.GetNodeData(node); + targetTileInfo^.ID := sourceTileInfo^.ID; + end; + selected := sourceTree.GetNextSelected(selected); + end; + Sender.EndUpdate; + end; +end; + +procedure TfrmLargeScaleCommand.vdtTerrainTilesDragOver(Sender: TBaseVirtualTree; + Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; + Mode: TDropMode; var Effect: Integer; var Accept: Boolean); +begin + if (Source <> Sender) and (Source is TVirtualDrawTree) and + (TVirtualDrawTree(Source).Tag = 1) then + begin + Accept := True; + end; +end; + +procedure TfrmLargeScaleCommand.vdtTerrainTilesDrawNode( + Sender: TBaseVirtualTree; const PaintInfo: TVTPaintInfo); +begin + frmMain.vdtTilesDrawNode(Sender, PaintInfo); +end; + +procedure TfrmLargeScaleCommand.vstActionsChange(Sender: TBaseVirtualTree; + Node: PVirtualNode); +var + nodeInfo: PNodeInfo; +begin + if Sender.Selected[Node] then + begin + nodeInfo := Sender.GetNodeData(Node); + nbActions.PageIndex := nodeInfo^.ActionID + 1; + end; +end; + +procedure TfrmLargeScaleCommand.vstActionsChecked(Sender: TBaseVirtualTree; + Node: PVirtualNode); +begin + if Node = FCopyMoveNode then + pbArea.Repaint; +end; + +procedure TfrmLargeScaleCommand.vstActionsGetText( + Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType; var CellText: String); +var + nodeInfo: PNodeInfo; +begin + nodeInfo := Sender.GetNodeData(Node); + CellText := nodeInfo^.Caption; +end; + +procedure TfrmLargeScaleCommand.vstActionsPaintText(Sender: TBaseVirtualTree; + const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType); +begin + if Sender.Selected[Node] then + TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold]; +end; + +procedure TfrmLargeScaleCommand.vstAreaChange(Sender: TBaseVirtualTree; + Node: PVirtualNode); +var + nodeInfo: ^TRect; + selected: Boolean; +begin + selected := (Node <> nil) and Sender.Selected[Node]; + btnDeleteArea.Enabled := selected; + lblX.Enabled := selected; + lblY.Enabled := selected; + seX1.Enabled := selected; + seX2.Enabled := selected; + seY1.Enabled := selected; + seY2.Enabled := selected; + btnGrab1.Enabled := selected; + btnGrab2.Enabled := selected; + btnGrabOffset.Enabled := selected; + if selected then + begin + nodeInfo := Sender.GetNodeData(Node); + seX1.Value := nodeInfo^.Left; + seX2.Value := nodeInfo^.Right; + seY1.Value := nodeInfo^.Top; + seY2.Value := nodeInfo^.Bottom; + end; + pbArea.Repaint; +end; + +procedure TfrmLargeScaleCommand.vstAreaGetText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: String); +var + nodeInfo: ^TRect; +begin + nodeInfo := Sender.GetNodeData(Node); + CellText := Format('(%d, %d), (%d, %d)', [nodeInfo^.Left, nodeInfo^.Top, + nodeInfo^.Right, nodeInfo^.Bottom]); +end; + +function TfrmLargeScaleCommand.AddNode(AActionID: Integer; + ACaption: String): PVirtualNode; +var + node: PVirtualNode; + nodeInfo: PNodeInfo; +begin + node := vstActions.AddChild(nil); + nodeInfo := vstActions.GetNodeData(node); + nodeInfo^.ActionID := AActionID; + nodeInfo^.Caption := ACaption; + if AActionID > -1 then + vstActions.CheckType[node] := ctCheckBox; + + Result := node; +end; + +function TfrmLargeScaleCommand.FindNode(AActionID: Integer): PVirtualNode; +var + node: PVirtualNode; + nodeInfo: PNodeInfo; +begin + Result := nil; + node := vstActions.GetFirst; + while (node <> nil) and (Result = nil) do + begin + nodeInfo := vstActions.GetNodeData(node); + if nodeInfo^.ActionID = AActionID then + Result := node; + node := vstActions.GetNext(node); + end; +end; + +procedure TfrmLargeScaleCommand.TileSelection(AWorldItem: TWorldItem); +begin + if FSelectFirst then + begin + seX1.Value := AWorldItem.X; + seY1.Value := AWorldItem.Y; + end else + begin + seX2.Value := AWorldItem.X; + seY2.Value := AWorldItem.Y; + end; + seX1Change(nil); + frmMain.UnregisterSelectionListener(@TileSelection); + WindowState := FOldWindowState; +end; + +procedure TfrmLargeScaleCommand.OffsetSelection(AWorldItem: TWorldItem); +begin + if FOffsetSelection = mnuSelectTopLeft then + begin + seCMOffsetX.Value := AWorldItem.X - Min(seX1.Value, seX2.Value); + seCMOffsetY.Value := AWorldItem.Y - Min(seY1.Value, seY2.Value); + end else + if FOffsetSelection = mnuSelectTopRight then + begin + seCMOffsetX.Value := AWorldItem.X - Max(seX1.Value, seX2.Value); + seCMOffsetY.Value := AWorldItem.Y - Min(seY1.Value,seY2.Value); + end else + if FOffsetSelection = mnuSelectBottomLeft then + begin + seCMOffsetX.Value := AWorldItem.X - Min(seX1.Value, seX2.Value); + seCMOffsetY.Value := AWorldItem.Y - Max(seY1.Value, seY2.Value); + end else + if FOffsetSelection = mnuSelectBottomRight then + begin + seCMOffsetX.Value := AWorldItem.X - Max(seX1.Value, seX2.Value); + seCMOffsetY.Value := AWorldItem.Y - Max(seY1.Value, seY2.Value); + end; + frmMain.UnregisterSelectionListener(@OffsetSelection); + WindowState := FOldWindowState; +end; + +procedure TfrmLargeScaleCommand.SerializeTiles(ATileList: TVirtualDrawTree; + AStream: TEnhancedMemoryStream); +var + node: PVirtualNode; + tileInfo: PTileInfo; +begin + AStream.WriteWord(ATileList.RootNodeCount); + node := ATileList.GetFirst; + while node <> nil do + begin + tileInfo := ATileList.GetNodeData(node); + AStream.WriteWord(tileInfo^.ID); + node := ATileList.GetNext(node); + end; +end; + +initialization + {$I UfrmLargeScaleCommand.lrs} + +end. + diff --git a/Client/UfrmLogin.lfm b/Client/UfrmLogin.lfm index 8274866..8fd30cc 100644 --- a/Client/UfrmLogin.lfm +++ b/Client/UfrmLogin.lfm @@ -1,684 +1,684 @@ -object frmLogin: TfrmLogin - Left = 290 - Height = 266 - Top = 171 - Width = 481 - ActiveControl = btnOK - AutoSize = True - BorderIcons = [biSystemMenu] - BorderStyle = bsDialog - Caption = 'UO CentrED' - ClientHeight = 266 - ClientWidth = 481 - Font.Height = -11 - OnClose = FormClose - OnCreate = FormCreate - Position = poScreenCenter - ShowInTaskBar = stAlways - LCLVersion = '0.9.29' - object lblCopyright: TLabel - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = gbData - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = Owner - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = Owner - AnchorSideBottom.Side = asrBottom - Left = 0 - Height = 19 - Top = 239 - Width = 481 - Alignment = taCenter - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Top = 8 - ParentColor = False - end - object gbConnection: TGroupBox - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = Owner - AnchorSideRight.Control = gbActions - AnchorSideBottom.Side = asrCenter - Left = 8 - Height = 128 - Top = 4 - Width = 314 - Anchors = [akTop, akLeft, akRight] - AutoSize = True - BorderSpacing.Left = 8 - BorderSpacing.Top = 4 - Caption = 'Connection' - ClientHeight = 114 - ClientWidth = 312 - TabOrder = 0 - object lblHost: TLabel - AnchorSideLeft.Control = imgHost - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = edHost - AnchorSideTop.Side = asrCenter - Left = 32 - Height = 14 - Top = 10 - Width = 28 - BorderSpacing.Left = 8 - Caption = 'Host:' - ParentColor = False - end - object lblUsername: TLabel - AnchorSideLeft.Control = imgUsername - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = edUsername - AnchorSideTop.Side = asrCenter - Left = 32 - Height = 14 - Top = 46 - Width = 58 - BorderSpacing.Left = 8 - Caption = 'Username:' - ParentColor = False - end - object lblPassword: TLabel - AnchorSideLeft.Control = imgPassword - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = edPassword - AnchorSideTop.Side = asrCenter - Left = 32 - Height = 14 - Top = 81 - Width = 54 - BorderSpacing.Left = 8 - Caption = 'Password:' - ParentColor = False - end - object imgHost: TImage - AnchorSideLeft.Control = gbConnection - AnchorSideTop.Control = lblHost - AnchorSideTop.Side = asrCenter - Left = 8 - Height = 16 - Top = 9 - Width = 16 - AutoSize = True - BorderSpacing.Left = 8 - Picture.Data = { - 07545069786D61702E0A00002F2A2058504D202A2F0A73746174696320636861 - 72202A64756D6D795B5D3D7B0A223136203136203132342032222C0A22517420 - 63204E6F6E65222C0A22236E20632023333739343337222C0A22236D20632023 - 343261313362222C0A22236620632023353661393530222C0A22233520632023 - 363036303630222C0A22233420632023363336333633222C0A22235920632023 - 363436343634222C0A22233320632023363736373637222C0A22235420632023 - 363836383638222C0A22233220632023366236623662222C0A22234920632023 - 366436643664222C0A22233120632023373037303730222C0A22237920632023 - 373337333733222C0A22233020632023373437343734222C0A22237020632023 - 373837383738222C0A22235A20632023373937393739222C0A22236820632023 - 376537653765222C0A22232E20632023383438343834222C0A222E3020632023 - 386138613861222C0A222E3220632023386238623862222C0A222E5A20632023 - 386438643864222C0A222E5920632023386638663866222C0A222E5420632023 - 393139313931222C0A222E4720632023393139313932222C0A222E4620632023 - 393339333934222C0A222E4520632023393539353936222C0A222E4420632023 - 393739373938222C0A222E4920632023393839383938222C0A22234A20632023 - 396239623962222C0A222E7A20632023396539653965222C0A22237A20632023 - 613261326132222C0A22235520632023613361336133222C0A22236520632023 - 613463386130222C0A222E7020632023613561356135222C0A22237120632023 - 613861386138222C0A222E6720632023616261626162222C0A22235220632023 - 616561666237222C0A22235120632023616562316239222C0A22236920632023 - 616661666166222C0A22234720632023616662316239222C0A222E6620632023 - 623062306230222C0A22235020632023623062316239222C0A22234620632023 - 623162326261222C0A22237720632023623162336262222C0A22234520632023 - 623262346262222C0A22234B20632023623362336233222C0A22237620632023 - 623362346262222C0A22234F20632023623362356264222C0A22234420632023 - 623462356263222C0A22237520632023623462366264222C0A22232320632023 - 623562356235222C0A22234320632023623562366265222C0A222E6520632023 - 623662366236222C0A22237420632023623662376265222C0A22236C20632023 - 623662386265222C0A22237320632023623762396330222C0A222E3820632023 - 623862396330222C0A22236420632023623962616331222C0A222E3720632023 - 623962626331222C0A22236320632023626162626332222C0A222E6420632023 - 626262626262222C0A222E3620632023626262636333222C0A222E5220632023 - 626262646333222C0A222E3520632023626362656334222C0A22234E20632023 - 626462666335222C0A222E5120632023626562666335222C0A222E3420632023 - 626562666336222C0A222E5020632023626663316336222C0A222E6320632023 - 633063306330222C0A222E5820632023633063316337222C0A222E7820632023 - 633163316337222C0A222E4F20632023633163326338222C0A222E7720632023 - 633163336338222C0A222E4E20632023633263336338222C0A222E7620632023 - 633363346361222C0A222E6220632023633463346334222C0A22235620632023 - 633463356336222C0A222E4320632023633463366362222C0A222E7520632023 - 633563366362222C0A222E4A20632023633663366336222C0A222E6120632023 - 633963396339222C0A222E7420632023633963616366222C0A222E7120632023 - 636263626362222C0A222E6820632023636363636363222C0A222E2320632023 - 636463646364222C0A22235320632023636463656433222C0A22234820632023 - 636563666434222C0A22237820632023636664306434222C0A22236F20632023 - 643064316436222C0A22236720632023643164336437222C0A22234220632023 - 643264326434222C0A222E3920632023643364336437222C0A22237220632023 - 643364346435222C0A22235720632023643364346439222C0A22234C20632023 - 643464346434222C0A222E3120632023643464356439222C0A22236B20632023 - 643564356437222C0A222E5320632023643564366461222C0A222E4820632023 - 643664376462222C0A22236220632023643864386439222C0A222E7920632023 - 643864396463222C0A222E3320632023643964396461222C0A222E6E20632023 - 646264626465222C0A222E6D20632023646264636466222C0A222E6920632023 - 646364636463222C0A222E5720632023646364636464222C0A222E6C20632023 - 646364636466222C0A222E6B20632023646364656531222C0A222E4D20632023 - 646464646464222C0A22236120632023646564656465222C0A222E7220632023 - 646664666466222C0A22234D20632023646664666531222C0A222E5620632023 - 653065306530222C0A222E4C20632023653165316531222C0A222E4220632023 - 653165316532222C0A222E6A20632023653365336536222C0A22235820632023 - 653565356538222C0A222E4120632023653965396539222C0A222E7320632023 - 656165616561222C0A22236A20632023656265626562222C0A222E5520632023 - 656365636563222C0A222E6F20632023656365636565222C0A222E4B20632023 - 656665666566222C0A22234120632023663066306630222C0A22517451745174 - 5174517451745174517451745174517451745174517451745174222C0A225174 - 51745174517451742E232E612E622E632E642E652E662E67517451745174222C - 0A2251745174517451742E682E692E6A2E6B2E6C2E6D2E6E2E6F2E7051745174 - 5174222C0A225174517451742E712E722E732E742E752E762E772E782E792E7A - 517451745174222C0A22517451742E712E412E412E422E432E442E452E462E47 - 2E482E49517451745174222C0A22517451742E4A2E4B2E4C2E4D2E4E2E4F2E50 - 2E512E522E532E54517451745174222C0A22517451742E632E552E562E572E58 - 2E472E592E5A2E302E312E32517451745174222C0A22517451742E642E552E72 - 2E332E342E352E362E372E382E39232E517451745174222C0A22517451742323 - 2E55236123622E52236323642365236623672368517451745174222C0A225174 - 51742369236A2E4D236B2E372E38236C236D236E236F2370517451745174222C - 0A225174517423712E732E4D2372237323742375237623772378237951745174 - 5174222C0A2251745174237A23412E5623422343234423452346234723482349 - 517451745174222C0A2251745174234A234B234C234D234E234F235023512352 - 23532354517451745174222C0A2251745174517451742E302355235623572348 - 2353235323582359517451745174222C0A22517451745174517451745174235A - 233023312332233323342335517451745174222C0A2251745174517451745174 - 51745174517451745174517451745174517451745174227D3B0A - } - Transparent = True - end - object imgUsername: TImage - AnchorSideLeft.Control = imgHost - AnchorSideTop.Control = lblUsername - AnchorSideTop.Side = asrCenter - Left = 8 - Height = 16 - Top = 45 - Width = 16 - AutoSize = True - Picture.Data = { - 07545069786D61702E0A00002F2A2058504D202A2F0A73746174696320636861 - 72202A64756D6D795B5D3D7B0A223136203136203132342032222C0A22517420 - 63204E6F6E65222C0A222E3220632023316334366265222C0A222E5820632023 - 316334386263222C0A22233420632023316633643966222C0A22235A20632023 - 316634306130222C0A22236120632023316634396335222C0A222E3320632023 - 316634636334222C0A22235920632023323035306233222C0A22233320632023 - 323134316137222C0A22233220632023323234346162222C0A22233020632023 - 323234356161222C0A22233120632023323234366163222C0A22235520632023 - 323434396231222C0A22233520632023323434666232222C0A222E5120632023 - 323533633661222C0A222E5720632023326433653638222C0A22235220632023 - 333536306266222C0A22236D20632023343235303838222C0A22237820632023 - 343338646666222C0A22236220632023343435343861222C0A22234D20632023 - 346135656134222C0A222E6B20632023346232653133222C0A22237720632023 - 346539376665222C0A22234B20632023353039666666222C0A22234920632023 - 353339636665222C0A22237620632023353339656664222C0A22236A20632023 - 353461306664222C0A22234A20632023353561336666222C0A22234820632023 - 353761326665222C0A22234420632023353836363966222C0A22237520632023 - 353961356665222C0A22236920632023353961386665222C0A22234720632023 - 356161386665222C0A222E6420632023356233333135222C0A22234620632023 - 356261636666222C0A222E7320632023356333333066222C0A22237420632023 - 356461636665222C0A22236820632023356562316665222C0A222E3920632023 - 356662366666222C0A22237120632023363062376666222C0A22235120632023 - 363136313836222C0A22237320632023363162326665222C0A22235320632023 - 363162396665222C0A22235420632023363262396665222C0A22237220632023 - 363362366666222C0A222E3820632023363363306666222C0A22236720632023 - 363462396665222C0A222E4120632023363633623131222C0A22236620632023 - 363862666665222C0A222E3720632023363963396666222C0A222E7A20632023 - 366234353232222C0A22235620632023366436343761222C0A22236520632023 - 366463376665222C0A222E7820632023366534303135222C0A222E6A20632023 - 373133653065222C0A222E7920632023373234343139222C0A222E3620632023 - 373264346666222C0A222E7220632023373534313132222C0A22234C20632023 - 373861656638222C0A22236B20632023376162376666222C0A222E6320632023 - 376434323131222C0A22236C20632023383061396665222C0A22232E20632023 - 383063316666222C0A22237920632023383238666263222C0A22234520632023 - 383462626635222C0A222E7120632023383534633135222C0A222E7420632023 - 383733653063222C0A222E6920632023383734613066222C0A222E6F20632023 - 383734623066222C0A222E7020632023383734623131222C0A222E6220632023 - 386134383066222C0A222E6E20632023386134613066222C0A222E2320632023 - 386434383132222C0A222E6120632023393034623130222C0A222E4A20632023 - 393235623261222C0A222E6820632023393335333131222C0A22237020632023 - 393439656233222C0A222E6520632023393634653131222C0A222E6C20632023 - 393734623066222C0A22236420632023393864316666222C0A222E6720632023 - 393935383132222C0A222E5020632023396136323264222C0A222E6620632023 - 396235383132222C0A222E4220632023396235653166222C0A222E6D20632023 - 396635383132222C0A222E3520632023613465346666222C0A222E4920632023 - 613736383233222C0A222E5220632023613736643334222C0A222E3020632023 - 613837623464222C0A222E5A20632023613937623465222C0A22236320632023 - 616263386663222C0A222E5620632023616537343334222C0A222E7520632023 - 623839373763222C0A222E3120632023633364366633222C0A22232320632023 - 633664376636222C0A22234120632023633737343239222C0A222E7720632023 - 633839633731222C0A22234F20632023636137373261222C0A22235020632023 - 636437393235222C0A22236E20632023636537633238222C0A22235720632023 - 636537653265222C0A22234220632023643137643239222C0A222E4620632023 - 643161393766222C0A22235820632023643361323664222C0A222E5920632023 - 643465326634222C0A222E3420632023643665346636222C0A222E4720632023 - 646662353839222C0A222E7620632023653462373861222C0A222E4520632023 - 653562623865222C0A22236F20632023656162333738222C0A222E4C20632023 - 656163636162222C0A22237A20632023656462383765222C0A22234320632023 - 656562613832222C0A222E4B20632023656563616136222C0A222E4F20632023 - 656563646137222C0A222E4820632023656564666364222C0A22234E20632023 - 656662633833222C0A222E4420632023663163353937222C0A222E5520632023 - 663663666135222C0A222E4D20632023663664306137222C0A222E4E20632023 - 663664306138222C0A222E5420632023663764346166222C0A222E4320632023 - 663765386439222C0A222E5320632023663863633963222C0A22517451745174 - 5174517451745174517451745174517451745174517451745174222C0A225174 - 517451745174517451742E232E612E622E632E6451745174517451745174222C - 0A22517451745174517451742E652E662E672E682E692E6A2E6B517451745174 - 5174222C0A2251745174517451742E6C2E6D2E6E2E6F2E702E712E722E735174 - 517451745174222C0A2251745174517451742E742E752E762E772E782E792E7A - 2E415174517451745174222C0A2251745174517451742E422E432E442E452E46 - 2E472E482E495174517451745174222C0A2251745174517451742E4A2E4B2E4C - 2E4D2E4E2E4C2E4F2E505174517451745174222C0A2251745174517451742E51 - 2E522E532E542E542E552E562E575174517451745174222C0A22517451745174 - 51742E582E592E5A2E302E302E5A2E312E325174517451745174222C0A225174 - 517451742E332E342E352E362E372E382E39232E23232361517451745174222C - 0A225174517423622363236423652366236723682369236A236B236C236D5174 - 5174222C0A225174236E236F2370237123722373237423752376237723782379 - 237A23415174222C0A22517423422343234423452346234723482349234A234B - 234C234D234E234F5174222C0A22517451742350235123522353235423542354 - 2353235323552356235723585174222C0A2251745174517451742359235A2330 - 233123322333233423355174517451745174222C0A2251745174517451745174 - 51745174517451745174517451745174517451745174227D3B0A - } - Transparent = True - end - object imgPassword: TImage - AnchorSideLeft.Control = imgUsername - AnchorSideTop.Control = lblPassword - AnchorSideTop.Side = asrCenter - Left = 8 - Height = 16 - Top = 80 - Width = 16 - AutoSize = True - Picture.Data = { - 07545069786D6170DE0800002F2A2058504D202A2F0A73746174696320636861 - 72202A64756D6D795B5D3D7B0A223136203136203130332032222C0A22517420 - 63204E6F6E65222C0A22236F20632023623238383338222C0A22237620632023 - 623538623339222C0A22234220632023623738643339222C0A22236420632023 - 623838333333222C0A222E4E20632023626138363334222C0A22234820632023 - 626139303361222C0A222E5820632023626238383335222C0A222E3820632023 - 626638623335222C0A22236720632023633138653336222C0A22234B20632023 - 633239353362222C0A22234120632023633838383331222C0A222E6B20632023 - 633839353339222C0A22234720632023633938613332222C0A22236320632023 - 636138613332222C0A22237520632023636138623332222C0A22236E20632023 - 636238623332222C0A22234A20632023636339303333222C0A22234920632023 - 643139363336222C0A222E4420632023643637633239222C0A22236520632023 - 643637643239222C0A222E4D20632023643637663239222C0A222E5720632023 - 643738313262222C0A222E3720632023643738323262222C0A22236620632023 - 643838353263222C0A222E7720632023646139303330222C0A222E7120632023 - 646439383332222C0A222E6A20632023646661313339222C0A222E6620632023 - 646661623432222C0A22234320632023653161633432222C0A222E3420632023 - 653361393365222C0A222E6F20632023653361633432222C0A222E2320632023 - 653362303434222C0A222E4F20632023653362323435222C0A222E4520632023 - 656163343666222C0A222E5020632023656163353736222C0A22237220632023 - 656563353238222C0A22236B20632023656563383238222C0A22232320632023 - 656663393262222C0A222E5620632023656663393332222C0A222E4B20632023 - 656663643334222C0A222E4220632023663063653338222C0A222E3120632023 - 663064323238222C0A22237120632023663164313339222C0A222E4720632023 - 663164313364222C0A22237820632023663164363433222C0A222E5520632023 - 663263653363222C0A222E5220632023663264363339222C0A222E4120632023 - 663264363437222C0A22236120632023663364363364222C0A222E4A20632023 - 663364373530222C0A22232E20632023663364383465222C0A222E7420632023 - 663364613862222C0A22236C20632023663464373431222C0A22236A20632023 - 663464383433222C0A222E3220632023663564343337222C0A22237920632023 - 663564623438222C0A222E5320632023663564623464222C0A222E4820632023 - 663564623564222C0A222E7520632023663564643439222C0A22237A20632023 - 663565313832222C0A22237320632023663664633465222C0A222E4920632023 - 663664663639222C0A222E3320632023663665303833222C0A22234520632023 - 663665313766222C0A222E3020632023663665343762222C0A22236220632023 - 663765313861222C0A22237420632023663765323835222C0A22236D20632023 - 663765323839222C0A222E5420632023663765343635222C0A222E6C20632023 - 663765343765222C0A222E4620632023663765353830222C0A222E7220632023 - 663765353831222C0A222E7A20632023663765353832222C0A22234620632023 - 663765363966222C0A22234420632023663765626334222C0A222E7920632023 - 663865373839222C0A222E6720632023663865373864222C0A222E6D20632023 - 663865393934222C0A222E6E20632023663865396263222C0A222E3920632023 - 663965616162222C0A222E6320632023663965623965222C0A222E6820632023 - 663965636131222C0A222E5120632023666165656163222C0A22236920632023 - 666165656230222C0A22237020632023666165666262222C0A222E4C20632023 - 666265663835222C0A222E5A20632023666266316262222C0A222E7320632023 - 666266316263222C0A222E6420632023666266326265222C0A22237720632023 - 666266346336222C0A222E3520632023666366336130222C0A222E3620632023 - 666366356139222C0A222E4320632023666366356165222C0A222E6220632023 - 666366356365222C0A222E7820632023666366376435222C0A222E6120632023 - 666366386465222C0A222E7620632023666466386331222C0A222E7020632023 - 666566636565222C0A22236820632023666566636630222C0A222E5920632023 - 666566636631222C0A222E6520632023666666666665222C0A222E6920632023 - 666666666666222C0A22517451745174517451745174517451742E232E232E23 - 2E235174517451745174222C0A2251745174517451745174517451742E232E23 - 2E612E612E232E23517451745174222C0A225174517451745174517451742E23 - 2E232E622E632E642E652E232E6651745174222C0A2251745174517451745174 - 2E232E232E622E672E682E232E232E692E6A2E6B5174222C0A22517451745174 - 517451742E232E612E672E6C2E6D2E6E2E232E6F2E702E712E6B222C0A225174 - 51745174517451742E232E642E6C2E6C2E722E6D2E732E742E752E762E77222C - 0A22517451745174517451742E232E782E792E6C2E6C2E6C2E7A2E412E422E43 - 2E44222C0A22517451745174517451742E232E452E462E472E482E492E4A2E4B - 2E4C2E4D2E4E222C0A22517451742E232E232E4F2E502E512E522E532E542E55 - 2E562E4C2E572E585174222C0A22517451742E232E592E5A2E302E312E322E33 - 2E342E352E362E372E3851745174222C0A222E232E232E232E39232E23232361 - 236223632364236523662367517451745174222C0A222E2323682369236A236B - 236C236D236E236F5174517451745174517451745174222C0A222E2323702371 - 2372237323742375237651745174517451745174517451745174222C0A222E23 - 237723782379237A23412342517451745174517451745174517451745174222C - 0A22234323442345234623472348517451745174517451745174517451745174 - 5174222C0A2251742349234A236E234B51745174517451745174517451745174 - 517451745174227D3B0A - } - Transparent = True - end - object edHost: TEdit - AnchorSideLeft.Control = lblUsername - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = gbConnection - AnchorSideRight.Control = edPort - Left = 98 - Height = 19 - Top = 8 - Width = 143 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Left = 8 - BorderSpacing.Top = 8 - TabOrder = 0 - Text = 'localhost' - end - object edUsername: TEdit - AnchorSideLeft.Control = edHost - AnchorSideTop.Control = edHost - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = edPort - AnchorSideRight.Side = asrBottom - Left = 98 - Height = 19 - Top = 44 - Width = 206 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Top = 17 - TabOrder = 2 - end - object edPassword: TEdit - AnchorSideLeft.Control = edUsername - AnchorSideTop.Control = edUsername - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = edUsername - AnchorSideRight.Side = asrBottom - Left = 98 - Height = 19 - Top = 79 - Width = 206 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Top = 16 - BorderSpacing.Bottom = 16 - EchoMode = emPassword - PasswordChar = '*' - TabOrder = 3 - end - object edPort: TSpinEdit - AnchorSideLeft.Control = edHost - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = edHost - AnchorSideRight.Control = gbConnection - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = edHost - AnchorSideBottom.Side = asrBottom - Left = 249 - Height = 19 - Top = 8 - Width = 55 - Anchors = [akTop, akRight, akBottom] - BorderSpacing.Left = 8 - BorderSpacing.Right = 8 - MaxValue = 65565 - MinValue = 1024 - TabOrder = 1 - Value = 2597 - end - end - object gbActions: TGroupBox - AnchorSideLeft.Control = gbConnection - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = gbConnection - AnchorSideRight.Control = Owner - AnchorSideRight.Side = asrBottom - Left = 330 - Height = 78 - Top = 12 - Width = 143 - Anchors = [akTop, akLeft, akRight] - AutoSize = True - BorderSpacing.Left = 8 - BorderSpacing.Top = 8 - BorderSpacing.Right = 8 - ClientHeight = 76 - ClientWidth = 141 - TabOrder = 2 - object btnOK: TButton - AnchorSideLeft.Control = gbActions - AnchorSideTop.Control = gbActions - AnchorSideRight.Control = gbActions - AnchorSideRight.Side = asrBottom - Left = 8 - Height = 25 - Top = 8 - Width = 125 - BorderSpacing.Around = 8 - BorderSpacing.InnerBorder = 4 - Caption = '&OK' - Default = True - OnClick = btnOKClick - TabOrder = 0 - end - object btnCancel: TButton - AnchorSideLeft.Control = btnOK - AnchorSideTop.Control = btnOK - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = btnOK - AnchorSideRight.Side = asrBottom - Left = 8 - Height = 25 - Top = 41 - Width = 125 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Bottom = 8 - BorderSpacing.InnerBorder = 4 - Caption = '&Cancel' - ModalResult = 2 - OnClick = btnCancelClick - TabOrder = 1 - end - end - object gbData: TGroupBox - AnchorSideLeft.Control = gbConnection - AnchorSideTop.Control = gbConnection - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = gbConnection - AnchorSideRight.Side = asrBottom - Left = 8 - Height = 95 - Top = 136 - Width = 314 - Anchors = [akTop, akLeft, akRight] - AutoSize = True - BorderSpacing.Top = 4 - Caption = 'Data files' - ClientHeight = 81 - ClientWidth = 312 - TabOrder = 1 - object lblData: TLabel - AnchorSideLeft.Control = gbData - AnchorSideTop.Control = gbData - AnchorSideRight.Control = gbData - AnchorSideRight.Side = asrBottom - Left = 8 - Height = 46 - Top = 4 - Width = 296 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Left = 8 - BorderSpacing.Top = 4 - BorderSpacing.Right = 8 - Caption = 'Select the directory containing art.mul, artidx.mul, hues.mul, tiledata.mul, animdata.mul, texmaps.mul, texidx.mul, light.mul and lightidx.mul.' - ParentColor = False - WordWrap = True - end - object edData: TDirectoryEdit - AnchorSideLeft.Control = lblData - AnchorSideTop.Control = lblData - AnchorSideTop.Side = asrBottom - Left = 8 - Height = 19 - Top = 54 - Width = 272 - ShowHidden = False - ButtonWidth = 23 - NumGlyphs = 1 - BorderSpacing.Top = 4 - BorderSpacing.Bottom = 8 - MaxLength = 0 - TabOrder = 0 - end - end - object gbProfiles: TGroupBox - AnchorSideLeft.Control = gbActions - AnchorSideTop.Control = gbActions - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = gbActions - AnchorSideRight.Side = asrBottom - Left = 330 - Height = 85 - Top = 98 - Width = 143 - Anchors = [akTop, akLeft, akRight] - AutoSize = True - BorderSpacing.Top = 8 - Caption = 'Profiles' - ClientHeight = 71 - ClientWidth = 141 - TabOrder = 3 - object btnSaveProfile: TSpeedButton - AnchorSideTop.Control = btnDeleteProfile - AnchorSideRight.Control = btnDeleteProfile - Left = 81 - Height = 22 - Hint = 'Save profile' - Top = 41 - Width = 22 - Anchors = [akTop, akRight] - BorderSpacing.Right = 8 - Color = clBtnFace - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000BA6A36FFB969 - 35FFB86935FFB76835FFB56835FFB46734FFB26634FFB06533FFAE6433FFAC63 - 32FFAA6232FFA96132FFA86031FFA76031FFA66031FFA86131FFBA6A35FFEBC6 - ADFFEAC5ADFFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFB - F8FFFEFBF8FFFEFBF8FFFEFBF8FFC89A7CFFC79879FFA76031FFBA6B37FFEDCA - B3FFE0A27AFFFEFAF7FF62C088FF62C088FF62C088FF62C088FF62C088FF62C0 - 88FF62C088FF62C088FFFDF9F6FFCA8D65FFC99B7CFFA76031FFBB6C38FFEECC - B6FFE1A27AFFFEFAF7FFBFDCC2FFBFDCC2FFBFDCC2FFBFDCC2FFBFDCC2FFBFDC - C2FFBFDCC2FFBFDCC2FFFDF9F6FFCD9068FFCC9E81FFA86132FFBB6B38FFEFCE - B8FFE1A279FFFEFAF7FF62C088FF62C088FF62C088FF62C088FF62C088FF62C0 - 88FF62C088FF62C088FFFDF9F6FFCF936AFFCEA384FFAA6132FFBA6A36FFEFD0 - BBFFE2A27AFFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFB - F8FFFEFBF8FFFEFBF8FFFEFBF8FFD3966DFFD2A78AFFAB6232FFBB6A36FFF0D2 - BEFFE2A37AFFE2A37AFFE1A37AFFE2A37BFFE1A37BFFE0A178FFDE9F77FFDD9F - 76FFDC9D74FFD99B72FFD89971FFD69970FFD5AB8EFFAD6333FFBB6A36FFF2D5 - C2FFE3A37AFFE3A37AFFE2A37BFFE2A37BFFE2A47BFFE1A279FFE0A178FFDEA0 - 77FFDE9E75FFDC9D74FFDA9B73FFD99B73FFDAB095FFAF6433FFBB6A36FFF2D8 - C5FFE3A47BFFE3A37AFFE3A47AFFE2A47BFFE2A37BFFE1A37BFFE1A279FFDFA0 - 77FFDE9F76FFDD9E74FFDB9C72FFDC9D74FFDDB59AFFB16534FFBB6B36FFF4D9 - C7FFE6A67DFFC88C64FFC98D65FFC98E67FFCB926CFFCB926DFFCA9069FFC88C - 65FFC88C64FFC88C64FFC88C64FFDA9C74FFE1BA9FFFB36634FFBB6B36FFF4DC - C9FFE7A77DFFF9ECE1FFF9ECE1FFF9EDE3FFFCF4EEFFFDFAF7FFFDF7F3FFFAED - E5FFF7E7DBFFF7E5D9FFF6E5D8FFDEA077FFE4BEA4FFB46734FFBC6B36FFF5DD - CCFFE7A87EFFFAF0E8FFFAF0E8FFC98D66FFFAF0E9FFFDF8F3FFFEFAF8FFFCF4 - EFFFF9E9DFFFF7E7DBFFF7E5D9FFE0A278FFE7C2A9FFB66835FFBC6B36FFF6DF - D0FFE8A87EFFFCF6F1FFFCF6F1FFC88C64FFFAF1E9FFFBF4EEFFFDFAF7FFFDF9 - F6FFFAF0E8FFF8E8DDFFF7E6DBFFE1A37AFFEFD5C3FFB76935FFBC6B36FFF6DF - D1FFE9AA80FFFEFAF6FFFDFAF6FFC88C64FFFBF3EEFFFBF1EAFFFCF6F2FFFEFB - F8FFFCF6F1FFF9ECE2FFF8E7DBFFEED0BAFFECD0BDFFBB703EFFBC6B36FFF6E0 - D1FFF7E0D1FFFEFBF8FFFEFBF7FFFDF9F6FFFCF5F0FFFAF0EAFFFBF2EDFFFDF9 - F6FFFDFAF7FFFBF1EBFFF8E9DFFFECD0BDFFC9895EFF0000000000000000BC6B - 36FFBC6B36FFBC6B36FFBC6B36FFBB6B36FFBB6B36FFBB6A36FFBB6A36FFBC6C - 39FFBD6E3BFFBB6D3AFFBB6B38FFBB703EFF0000000000000000 - } - NumGlyphs = 0 - OnClick = btnSaveProfileClick - ShowCaption = False - ShowHint = True - ParentShowHint = False - end - object btnDeleteProfile: TSpeedButton - AnchorSideTop.Control = cbProfile - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = cbProfile - AnchorSideRight.Side = asrBottom - Left = 111 - Height = 22 - Hint = 'Delete profile' - Top = 41 - Width = 22 - Anchors = [akTop, akRight] - BorderSpacing.Top = 8 - BorderSpacing.Bottom = 8 - Color = clBtnFace - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000004F4CF2FF403EEDFF000000000000000000000000000000000000 - 0000000000002422E4FF312FEAFF000000000000000000000000000000000000 - 00005856F5FF6361FAFF5855F6FF413FEDFF0000000000000000000000000000 - 00002C2AE6FF413FF1FF4C4AF6FF312FEAFF0000000000000000000000000000 - 00005B58F6FF6562FAFF7170FFFF5956F6FF4240EEFF00000000000000003532 - E9FF4745F2FF6362FFFF4A48F4FF2F2DE9FF0000000000000000000000000000 - 0000000000005B59F6FF6663FAFF7471FFFF5A58F6FF4341EEFF3E3CECFF504D - F4FF6867FFFF504EF5FF3634EBFF000000000000000000000000000000000000 - 000000000000000000005C5AF6FF6764FAFF7472FFFF7370FFFF706EFFFF6E6C - FFFF5755F7FF3F3DEEFF00000000000000000000000000000000000000000000 - 00000000000000000000000000005D5BF7FF7976FFFF5956FFFF5754FFFF7270 - FFFF4846F0FF0000000000000000000000000000000000000000000000000000 - 00000000000000000000000000005D5AF6FF7D79FFFF5E5BFFFF5B58FFFF7674 - FFFF4643EFFF0000000000000000000000000000000000000000000000000000 - 000000000000000000006663F9FF706DFBFF807EFFFF7E7BFFFF7C79FFFF7977 - FFFF5E5CF7FF4744EFFF00000000000000000000000000000000000000000000 - 0000000000006E6BFCFF7774FDFF8682FFFF7673FCFF6462F8FF605DF7FF6D6A - FAFF7B79FFFF605DF7FF4845EFFF000000000000000000000000000000000000 - 00007471FEFF7D7AFEFF8A87FFFF7C79FDFF6C69FBFF0000000000000000615E - F8FF6E6CFAFF7D7AFFFF615FF7FF4946F0FF0000000000000000000000000000 - 00007A77FFFF817EFFFF817EFEFF7471FDFF0000000000000000000000000000 - 0000625FF8FF6F6DFBFF7E7CFFFF625FF8FF0000000000000000000000000000 - 0000000000007A77FFFF7976FEFF000000000000000000000000000000000000 - 0000000000006461F8FF6A68F9FF5451F3FF0000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000 - } - NumGlyphs = 0 - OnClick = btnDeleteProfileClick - ShowCaption = False - ShowHint = True - ParentShowHint = False - end - object cbProfile: TComboBox - AnchorSideLeft.Control = gbProfiles - AnchorSideTop.Control = gbProfiles - AnchorSideRight.Control = gbProfiles - AnchorSideRight.Side = asrBottom - Left = 8 - Height = 29 - Top = 4 - Width = 125 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Left = 8 - BorderSpacing.Top = 4 - BorderSpacing.Right = 8 - ItemHeight = 0 - OnChange = cbProfileChange - Style = csDropDownList - TabOrder = 0 - end - end -end +object frmLogin: TfrmLogin + Left = 290 + Height = 266 + Top = 171 + Width = 481 + ActiveControl = btnOK + AutoSize = True + BorderIcons = [biSystemMenu] + BorderStyle = bsDialog + Caption = 'UO CentrED' + ClientHeight = 266 + ClientWidth = 481 + Font.Height = -11 + OnClose = FormClose + OnCreate = FormCreate + Position = poScreenCenter + ShowInTaskBar = stAlways + LCLVersion = '0.9.29' + object lblCopyright: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = gbData + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 19 + Top = 239 + Width = 481 + Alignment = taCenter + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + ParentColor = False + end + object gbConnection: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = gbActions + AnchorSideBottom.Side = asrCenter + Left = 8 + Height = 128 + Top = 4 + Width = 314 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 4 + Caption = 'Connection' + ClientHeight = 114 + ClientWidth = 312 + TabOrder = 0 + object lblHost: TLabel + AnchorSideLeft.Control = imgHost + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = edHost + AnchorSideTop.Side = asrCenter + Left = 32 + Height = 14 + Top = 10 + Width = 28 + BorderSpacing.Left = 8 + Caption = 'Host:' + ParentColor = False + end + object lblUsername: TLabel + AnchorSideLeft.Control = imgUsername + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = edUsername + AnchorSideTop.Side = asrCenter + Left = 32 + Height = 14 + Top = 46 + Width = 58 + BorderSpacing.Left = 8 + Caption = 'Username:' + ParentColor = False + end + object lblPassword: TLabel + AnchorSideLeft.Control = imgPassword + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = edPassword + AnchorSideTop.Side = asrCenter + Left = 32 + Height = 14 + Top = 81 + Width = 54 + BorderSpacing.Left = 8 + Caption = 'Password:' + ParentColor = False + end + object imgHost: TImage + AnchorSideLeft.Control = gbConnection + AnchorSideTop.Control = lblHost + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 16 + Top = 9 + Width = 16 + AutoSize = True + BorderSpacing.Left = 8 + Picture.Data = { + 07545069786D61702E0A00002F2A2058504D202A2F0A73746174696320636861 + 72202A64756D6D795B5D3D7B0A223136203136203132342032222C0A22517420 + 63204E6F6E65222C0A22236E20632023333739343337222C0A22236D20632023 + 343261313362222C0A22236620632023353661393530222C0A22233520632023 + 363036303630222C0A22233420632023363336333633222C0A22235920632023 + 363436343634222C0A22233320632023363736373637222C0A22235420632023 + 363836383638222C0A22233220632023366236623662222C0A22234920632023 + 366436643664222C0A22233120632023373037303730222C0A22237920632023 + 373337333733222C0A22233020632023373437343734222C0A22237020632023 + 373837383738222C0A22235A20632023373937393739222C0A22236820632023 + 376537653765222C0A22232E20632023383438343834222C0A222E3020632023 + 386138613861222C0A222E3220632023386238623862222C0A222E5A20632023 + 386438643864222C0A222E5920632023386638663866222C0A222E5420632023 + 393139313931222C0A222E4720632023393139313932222C0A222E4620632023 + 393339333934222C0A222E4520632023393539353936222C0A222E4420632023 + 393739373938222C0A222E4920632023393839383938222C0A22234A20632023 + 396239623962222C0A222E7A20632023396539653965222C0A22237A20632023 + 613261326132222C0A22235520632023613361336133222C0A22236520632023 + 613463386130222C0A222E7020632023613561356135222C0A22237120632023 + 613861386138222C0A222E6720632023616261626162222C0A22235220632023 + 616561666237222C0A22235120632023616562316239222C0A22236920632023 + 616661666166222C0A22234720632023616662316239222C0A222E6620632023 + 623062306230222C0A22235020632023623062316239222C0A22234620632023 + 623162326261222C0A22237720632023623162336262222C0A22234520632023 + 623262346262222C0A22234B20632023623362336233222C0A22237620632023 + 623362346262222C0A22234F20632023623362356264222C0A22234420632023 + 623462356263222C0A22237520632023623462366264222C0A22232320632023 + 623562356235222C0A22234320632023623562366265222C0A222E6520632023 + 623662366236222C0A22237420632023623662376265222C0A22236C20632023 + 623662386265222C0A22237320632023623762396330222C0A222E3820632023 + 623862396330222C0A22236420632023623962616331222C0A222E3720632023 + 623962626331222C0A22236320632023626162626332222C0A222E6420632023 + 626262626262222C0A222E3620632023626262636333222C0A222E5220632023 + 626262646333222C0A222E3520632023626362656334222C0A22234E20632023 + 626462666335222C0A222E5120632023626562666335222C0A222E3420632023 + 626562666336222C0A222E5020632023626663316336222C0A222E6320632023 + 633063306330222C0A222E5820632023633063316337222C0A222E7820632023 + 633163316337222C0A222E4F20632023633163326338222C0A222E7720632023 + 633163336338222C0A222E4E20632023633263336338222C0A222E7620632023 + 633363346361222C0A222E6220632023633463346334222C0A22235620632023 + 633463356336222C0A222E4320632023633463366362222C0A222E7520632023 + 633563366362222C0A222E4A20632023633663366336222C0A222E6120632023 + 633963396339222C0A222E7420632023633963616366222C0A222E7120632023 + 636263626362222C0A222E6820632023636363636363222C0A222E2320632023 + 636463646364222C0A22235320632023636463656433222C0A22234820632023 + 636563666434222C0A22237820632023636664306434222C0A22236F20632023 + 643064316436222C0A22236720632023643164336437222C0A22234220632023 + 643264326434222C0A222E3920632023643364336437222C0A22237220632023 + 643364346435222C0A22235720632023643364346439222C0A22234C20632023 + 643464346434222C0A222E3120632023643464356439222C0A22236B20632023 + 643564356437222C0A222E5320632023643564366461222C0A222E4820632023 + 643664376462222C0A22236220632023643864386439222C0A222E7920632023 + 643864396463222C0A222E3320632023643964396461222C0A222E6E20632023 + 646264626465222C0A222E6D20632023646264636466222C0A222E6920632023 + 646364636463222C0A222E5720632023646364636464222C0A222E6C20632023 + 646364636466222C0A222E6B20632023646364656531222C0A222E4D20632023 + 646464646464222C0A22236120632023646564656465222C0A222E7220632023 + 646664666466222C0A22234D20632023646664666531222C0A222E5620632023 + 653065306530222C0A222E4C20632023653165316531222C0A222E4220632023 + 653165316532222C0A222E6A20632023653365336536222C0A22235820632023 + 653565356538222C0A222E4120632023653965396539222C0A222E7320632023 + 656165616561222C0A22236A20632023656265626562222C0A222E5520632023 + 656365636563222C0A222E6F20632023656365636565222C0A222E4B20632023 + 656665666566222C0A22234120632023663066306630222C0A22517451745174 + 5174517451745174517451745174517451745174517451745174222C0A225174 + 51745174517451742E232E612E622E632E642E652E662E67517451745174222C + 0A2251745174517451742E682E692E6A2E6B2E6C2E6D2E6E2E6F2E7051745174 + 5174222C0A225174517451742E712E722E732E742E752E762E772E782E792E7A + 517451745174222C0A22517451742E712E412E412E422E432E442E452E462E47 + 2E482E49517451745174222C0A22517451742E4A2E4B2E4C2E4D2E4E2E4F2E50 + 2E512E522E532E54517451745174222C0A22517451742E632E552E562E572E58 + 2E472E592E5A2E302E312E32517451745174222C0A22517451742E642E552E72 + 2E332E342E352E362E372E382E39232E517451745174222C0A22517451742323 + 2E55236123622E52236323642365236623672368517451745174222C0A225174 + 51742369236A2E4D236B2E372E38236C236D236E236F2370517451745174222C + 0A225174517423712E732E4D2372237323742375237623772378237951745174 + 5174222C0A2251745174237A23412E5623422343234423452346234723482349 + 517451745174222C0A2251745174234A234B234C234D234E234F235023512352 + 23532354517451745174222C0A2251745174517451742E302355235623572348 + 2353235323582359517451745174222C0A22517451745174517451745174235A + 233023312332233323342335517451745174222C0A2251745174517451745174 + 51745174517451745174517451745174517451745174227D3B0A + } + Transparent = True + end + object imgUsername: TImage + AnchorSideLeft.Control = imgHost + AnchorSideTop.Control = lblUsername + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 16 + Top = 45 + Width = 16 + AutoSize = True + Picture.Data = { + 07545069786D61702E0A00002F2A2058504D202A2F0A73746174696320636861 + 72202A64756D6D795B5D3D7B0A223136203136203132342032222C0A22517420 + 63204E6F6E65222C0A222E3220632023316334366265222C0A222E5820632023 + 316334386263222C0A22233420632023316633643966222C0A22235A20632023 + 316634306130222C0A22236120632023316634396335222C0A222E3320632023 + 316634636334222C0A22235920632023323035306233222C0A22233320632023 + 323134316137222C0A22233220632023323234346162222C0A22233020632023 + 323234356161222C0A22233120632023323234366163222C0A22235520632023 + 323434396231222C0A22233520632023323434666232222C0A222E5120632023 + 323533633661222C0A222E5720632023326433653638222C0A22235220632023 + 333536306266222C0A22236D20632023343235303838222C0A22237820632023 + 343338646666222C0A22236220632023343435343861222C0A22234D20632023 + 346135656134222C0A222E6B20632023346232653133222C0A22237720632023 + 346539376665222C0A22234B20632023353039666666222C0A22234920632023 + 353339636665222C0A22237620632023353339656664222C0A22236A20632023 + 353461306664222C0A22234A20632023353561336666222C0A22234820632023 + 353761326665222C0A22234420632023353836363966222C0A22237520632023 + 353961356665222C0A22236920632023353961386665222C0A22234720632023 + 356161386665222C0A222E6420632023356233333135222C0A22234620632023 + 356261636666222C0A222E7320632023356333333066222C0A22237420632023 + 356461636665222C0A22236820632023356562316665222C0A222E3920632023 + 356662366666222C0A22237120632023363062376666222C0A22235120632023 + 363136313836222C0A22237320632023363162326665222C0A22235320632023 + 363162396665222C0A22235420632023363262396665222C0A22237220632023 + 363362366666222C0A222E3820632023363363306666222C0A22236720632023 + 363462396665222C0A222E4120632023363633623131222C0A22236620632023 + 363862666665222C0A222E3720632023363963396666222C0A222E7A20632023 + 366234353232222C0A22235620632023366436343761222C0A22236520632023 + 366463376665222C0A222E7820632023366534303135222C0A222E6A20632023 + 373133653065222C0A222E7920632023373234343139222C0A222E3620632023 + 373264346666222C0A222E7220632023373534313132222C0A22234C20632023 + 373861656638222C0A22236B20632023376162376666222C0A222E6320632023 + 376434323131222C0A22236C20632023383061396665222C0A22232E20632023 + 383063316666222C0A22237920632023383238666263222C0A22234520632023 + 383462626635222C0A222E7120632023383534633135222C0A222E7420632023 + 383733653063222C0A222E6920632023383734613066222C0A222E6F20632023 + 383734623066222C0A222E7020632023383734623131222C0A222E6220632023 + 386134383066222C0A222E6E20632023386134613066222C0A222E2320632023 + 386434383132222C0A222E6120632023393034623130222C0A222E4A20632023 + 393235623261222C0A222E6820632023393335333131222C0A22237020632023 + 393439656233222C0A222E6520632023393634653131222C0A222E6C20632023 + 393734623066222C0A22236420632023393864316666222C0A222E6720632023 + 393935383132222C0A222E5020632023396136323264222C0A222E6620632023 + 396235383132222C0A222E4220632023396235653166222C0A222E6D20632023 + 396635383132222C0A222E3520632023613465346666222C0A222E4920632023 + 613736383233222C0A222E5220632023613736643334222C0A222E3020632023 + 613837623464222C0A222E5A20632023613937623465222C0A22236320632023 + 616263386663222C0A222E5620632023616537343334222C0A222E7520632023 + 623839373763222C0A222E3120632023633364366633222C0A22232320632023 + 633664376636222C0A22234120632023633737343239222C0A222E7720632023 + 633839633731222C0A22234F20632023636137373261222C0A22235020632023 + 636437393235222C0A22236E20632023636537633238222C0A22235720632023 + 636537653265222C0A22234220632023643137643239222C0A222E4620632023 + 643161393766222C0A22235820632023643361323664222C0A222E5920632023 + 643465326634222C0A222E3420632023643665346636222C0A222E4720632023 + 646662353839222C0A222E7620632023653462373861222C0A222E4520632023 + 653562623865222C0A22236F20632023656162333738222C0A222E4C20632023 + 656163636162222C0A22237A20632023656462383765222C0A22234320632023 + 656562613832222C0A222E4B20632023656563616136222C0A222E4F20632023 + 656563646137222C0A222E4820632023656564666364222C0A22234E20632023 + 656662633833222C0A222E4420632023663163353937222C0A222E5520632023 + 663663666135222C0A222E4D20632023663664306137222C0A222E4E20632023 + 663664306138222C0A222E5420632023663764346166222C0A222E4320632023 + 663765386439222C0A222E5320632023663863633963222C0A22517451745174 + 5174517451745174517451745174517451745174517451745174222C0A225174 + 517451745174517451742E232E612E622E632E6451745174517451745174222C + 0A22517451745174517451742E652E662E672E682E692E6A2E6B517451745174 + 5174222C0A2251745174517451742E6C2E6D2E6E2E6F2E702E712E722E735174 + 517451745174222C0A2251745174517451742E742E752E762E772E782E792E7A + 2E415174517451745174222C0A2251745174517451742E422E432E442E452E46 + 2E472E482E495174517451745174222C0A2251745174517451742E4A2E4B2E4C + 2E4D2E4E2E4C2E4F2E505174517451745174222C0A2251745174517451742E51 + 2E522E532E542E542E552E562E575174517451745174222C0A22517451745174 + 51742E582E592E5A2E302E302E5A2E312E325174517451745174222C0A225174 + 517451742E332E342E352E362E372E382E39232E23232361517451745174222C + 0A225174517423622363236423652366236723682369236A236B236C236D5174 + 5174222C0A225174236E236F2370237123722373237423752376237723782379 + 237A23415174222C0A22517423422343234423452346234723482349234A234B + 234C234D234E234F5174222C0A22517451742350235123522353235423542354 + 2353235323552356235723585174222C0A2251745174517451742359235A2330 + 233123322333233423355174517451745174222C0A2251745174517451745174 + 51745174517451745174517451745174517451745174227D3B0A + } + Transparent = True + end + object imgPassword: TImage + AnchorSideLeft.Control = imgUsername + AnchorSideTop.Control = lblPassword + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 16 + Top = 80 + Width = 16 + AutoSize = True + Picture.Data = { + 07545069786D6170DE0800002F2A2058504D202A2F0A73746174696320636861 + 72202A64756D6D795B5D3D7B0A223136203136203130332032222C0A22517420 + 63204E6F6E65222C0A22236F20632023623238383338222C0A22237620632023 + 623538623339222C0A22234220632023623738643339222C0A22236420632023 + 623838333333222C0A222E4E20632023626138363334222C0A22234820632023 + 626139303361222C0A222E5820632023626238383335222C0A222E3820632023 + 626638623335222C0A22236720632023633138653336222C0A22234B20632023 + 633239353362222C0A22234120632023633838383331222C0A222E6B20632023 + 633839353339222C0A22234720632023633938613332222C0A22236320632023 + 636138613332222C0A22237520632023636138623332222C0A22236E20632023 + 636238623332222C0A22234A20632023636339303333222C0A22234920632023 + 643139363336222C0A222E4420632023643637633239222C0A22236520632023 + 643637643239222C0A222E4D20632023643637663239222C0A222E5720632023 + 643738313262222C0A222E3720632023643738323262222C0A22236620632023 + 643838353263222C0A222E7720632023646139303330222C0A222E7120632023 + 646439383332222C0A222E6A20632023646661313339222C0A222E6620632023 + 646661623432222C0A22234320632023653161633432222C0A222E3420632023 + 653361393365222C0A222E6F20632023653361633432222C0A222E2320632023 + 653362303434222C0A222E4F20632023653362323435222C0A222E4520632023 + 656163343666222C0A222E5020632023656163353736222C0A22237220632023 + 656563353238222C0A22236B20632023656563383238222C0A22232320632023 + 656663393262222C0A222E5620632023656663393332222C0A222E4B20632023 + 656663643334222C0A222E4220632023663063653338222C0A222E3120632023 + 663064323238222C0A22237120632023663164313339222C0A222E4720632023 + 663164313364222C0A22237820632023663164363433222C0A222E5520632023 + 663263653363222C0A222E5220632023663264363339222C0A222E4120632023 + 663264363437222C0A22236120632023663364363364222C0A222E4A20632023 + 663364373530222C0A22232E20632023663364383465222C0A222E7420632023 + 663364613862222C0A22236C20632023663464373431222C0A22236A20632023 + 663464383433222C0A222E3220632023663564343337222C0A22237920632023 + 663564623438222C0A222E5320632023663564623464222C0A222E4820632023 + 663564623564222C0A222E7520632023663564643439222C0A22237A20632023 + 663565313832222C0A22237320632023663664633465222C0A222E4920632023 + 663664663639222C0A222E3320632023663665303833222C0A22234520632023 + 663665313766222C0A222E3020632023663665343762222C0A22236220632023 + 663765313861222C0A22237420632023663765323835222C0A22236D20632023 + 663765323839222C0A222E5420632023663765343635222C0A222E6C20632023 + 663765343765222C0A222E4620632023663765353830222C0A222E7220632023 + 663765353831222C0A222E7A20632023663765353832222C0A22234620632023 + 663765363966222C0A22234420632023663765626334222C0A222E7920632023 + 663865373839222C0A222E6720632023663865373864222C0A222E6D20632023 + 663865393934222C0A222E6E20632023663865396263222C0A222E3920632023 + 663965616162222C0A222E6320632023663965623965222C0A222E6820632023 + 663965636131222C0A222E5120632023666165656163222C0A22236920632023 + 666165656230222C0A22237020632023666165666262222C0A222E4C20632023 + 666265663835222C0A222E5A20632023666266316262222C0A222E7320632023 + 666266316263222C0A222E6420632023666266326265222C0A22237720632023 + 666266346336222C0A222E3520632023666366336130222C0A222E3620632023 + 666366356139222C0A222E4320632023666366356165222C0A222E6220632023 + 666366356365222C0A222E7820632023666366376435222C0A222E6120632023 + 666366386465222C0A222E7620632023666466386331222C0A222E7020632023 + 666566636565222C0A22236820632023666566636630222C0A222E5920632023 + 666566636631222C0A222E6520632023666666666665222C0A222E6920632023 + 666666666666222C0A22517451745174517451745174517451742E232E232E23 + 2E235174517451745174222C0A2251745174517451745174517451742E232E23 + 2E612E612E232E23517451745174222C0A225174517451745174517451742E23 + 2E232E622E632E642E652E232E6651745174222C0A2251745174517451745174 + 2E232E232E622E672E682E232E232E692E6A2E6B5174222C0A22517451745174 + 517451742E232E612E672E6C2E6D2E6E2E232E6F2E702E712E6B222C0A225174 + 51745174517451742E232E642E6C2E6C2E722E6D2E732E742E752E762E77222C + 0A22517451745174517451742E232E782E792E6C2E6C2E6C2E7A2E412E422E43 + 2E44222C0A22517451745174517451742E232E452E462E472E482E492E4A2E4B + 2E4C2E4D2E4E222C0A22517451742E232E232E4F2E502E512E522E532E542E55 + 2E562E4C2E572E585174222C0A22517451742E232E592E5A2E302E312E322E33 + 2E342E352E362E372E3851745174222C0A222E232E232E232E39232E23232361 + 236223632364236523662367517451745174222C0A222E2323682369236A236B + 236C236D236E236F5174517451745174517451745174222C0A222E2323702371 + 2372237323742375237651745174517451745174517451745174222C0A222E23 + 237723782379237A23412342517451745174517451745174517451745174222C + 0A22234323442345234623472348517451745174517451745174517451745174 + 5174222C0A2251742349234A236E234B51745174517451745174517451745174 + 517451745174227D3B0A + } + Transparent = True + end + object edHost: TEdit + AnchorSideLeft.Control = lblUsername + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = gbConnection + AnchorSideRight.Control = edPort + Left = 98 + Height = 19 + Top = 8 + Width = 143 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + TabOrder = 0 + Text = 'localhost' + end + object edUsername: TEdit + AnchorSideLeft.Control = edHost + AnchorSideTop.Control = edHost + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = edPort + AnchorSideRight.Side = asrBottom + Left = 98 + Height = 19 + Top = 44 + Width = 206 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 17 + TabOrder = 2 + end + object edPassword: TEdit + AnchorSideLeft.Control = edUsername + AnchorSideTop.Control = edUsername + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = edUsername + AnchorSideRight.Side = asrBottom + Left = 98 + Height = 19 + Top = 79 + Width = 206 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 16 + BorderSpacing.Bottom = 16 + EchoMode = emPassword + PasswordChar = '*' + TabOrder = 3 + end + object edPort: TSpinEdit + AnchorSideLeft.Control = edHost + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = edHost + AnchorSideRight.Control = gbConnection + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = edHost + AnchorSideBottom.Side = asrBottom + Left = 249 + Height = 19 + Top = 8 + Width = 55 + Anchors = [akTop, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + MaxValue = 65565 + MinValue = 1024 + TabOrder = 1 + Value = 2597 + end + end + object gbActions: TGroupBox + AnchorSideLeft.Control = gbConnection + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = gbConnection + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 330 + Height = 78 + Top = 12 + Width = 143 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + ClientHeight = 76 + ClientWidth = 141 + TabOrder = 2 + object btnOK: TButton + AnchorSideLeft.Control = gbActions + AnchorSideTop.Control = gbActions + AnchorSideRight.Control = gbActions + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 25 + Top = 8 + Width = 125 + BorderSpacing.Around = 8 + BorderSpacing.InnerBorder = 4 + Caption = '&OK' + Default = True + OnClick = btnOKClick + TabOrder = 0 + end + object btnCancel: TButton + AnchorSideLeft.Control = btnOK + AnchorSideTop.Control = btnOK + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = btnOK + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 25 + Top = 41 + Width = 125 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Bottom = 8 + BorderSpacing.InnerBorder = 4 + Caption = '&Cancel' + ModalResult = 2 + OnClick = btnCancelClick + TabOrder = 1 + end + end + object gbData: TGroupBox + AnchorSideLeft.Control = gbConnection + AnchorSideTop.Control = gbConnection + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = gbConnection + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 95 + Top = 136 + Width = 314 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 4 + Caption = 'Data files' + ClientHeight = 81 + ClientWidth = 312 + TabOrder = 1 + object lblData: TLabel + AnchorSideLeft.Control = gbData + AnchorSideTop.Control = gbData + AnchorSideRight.Control = gbData + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 46 + Top = 4 + Width = 296 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 + Caption = 'Select the directory containing art.mul, artidx.mul, hues.mul, tiledata.mul, animdata.mul, texmaps.mul, texidx.mul, light.mul and lightidx.mul.' + ParentColor = False + WordWrap = True + end + object edData: TDirectoryEdit + AnchorSideLeft.Control = lblData + AnchorSideTop.Control = lblData + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 19 + Top = 54 + Width = 272 + ShowHidden = False + ButtonWidth = 23 + NumGlyphs = 1 + BorderSpacing.Top = 4 + BorderSpacing.Bottom = 8 + MaxLength = 0 + TabOrder = 0 + end + end + object gbProfiles: TGroupBox + AnchorSideLeft.Control = gbActions + AnchorSideTop.Control = gbActions + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = gbActions + AnchorSideRight.Side = asrBottom + Left = 330 + Height = 85 + Top = 98 + Width = 143 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 8 + Caption = 'Profiles' + ClientHeight = 71 + ClientWidth = 141 + TabOrder = 3 + object btnSaveProfile: TSpeedButton + AnchorSideTop.Control = btnDeleteProfile + AnchorSideRight.Control = btnDeleteProfile + Left = 81 + Height = 22 + Hint = 'Save profile' + Top = 41 + Width = 22 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Color = clBtnFace + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000BA6A36FFB969 + 35FFB86935FFB76835FFB56835FFB46734FFB26634FFB06533FFAE6433FFAC63 + 32FFAA6232FFA96132FFA86031FFA76031FFA66031FFA86131FFBA6A35FFEBC6 + ADFFEAC5ADFFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFB + F8FFFEFBF8FFFEFBF8FFFEFBF8FFC89A7CFFC79879FFA76031FFBA6B37FFEDCA + B3FFE0A27AFFFEFAF7FF62C088FF62C088FF62C088FF62C088FF62C088FF62C0 + 88FF62C088FF62C088FFFDF9F6FFCA8D65FFC99B7CFFA76031FFBB6C38FFEECC + B6FFE1A27AFFFEFAF7FFBFDCC2FFBFDCC2FFBFDCC2FFBFDCC2FFBFDCC2FFBFDC + C2FFBFDCC2FFBFDCC2FFFDF9F6FFCD9068FFCC9E81FFA86132FFBB6B38FFEFCE + B8FFE1A279FFFEFAF7FF62C088FF62C088FF62C088FF62C088FF62C088FF62C0 + 88FF62C088FF62C088FFFDF9F6FFCF936AFFCEA384FFAA6132FFBA6A36FFEFD0 + BBFFE2A27AFFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFB + F8FFFEFBF8FFFEFBF8FFFEFBF8FFD3966DFFD2A78AFFAB6232FFBB6A36FFF0D2 + BEFFE2A37AFFE2A37AFFE1A37AFFE2A37BFFE1A37BFFE0A178FFDE9F77FFDD9F + 76FFDC9D74FFD99B72FFD89971FFD69970FFD5AB8EFFAD6333FFBB6A36FFF2D5 + C2FFE3A37AFFE3A37AFFE2A37BFFE2A37BFFE2A47BFFE1A279FFE0A178FFDEA0 + 77FFDE9E75FFDC9D74FFDA9B73FFD99B73FFDAB095FFAF6433FFBB6A36FFF2D8 + C5FFE3A47BFFE3A37AFFE3A47AFFE2A47BFFE2A37BFFE1A37BFFE1A279FFDFA0 + 77FFDE9F76FFDD9E74FFDB9C72FFDC9D74FFDDB59AFFB16534FFBB6B36FFF4D9 + C7FFE6A67DFFC88C64FFC98D65FFC98E67FFCB926CFFCB926DFFCA9069FFC88C + 65FFC88C64FFC88C64FFC88C64FFDA9C74FFE1BA9FFFB36634FFBB6B36FFF4DC + C9FFE7A77DFFF9ECE1FFF9ECE1FFF9EDE3FFFCF4EEFFFDFAF7FFFDF7F3FFFAED + E5FFF7E7DBFFF7E5D9FFF6E5D8FFDEA077FFE4BEA4FFB46734FFBC6B36FFF5DD + CCFFE7A87EFFFAF0E8FFFAF0E8FFC98D66FFFAF0E9FFFDF8F3FFFEFAF8FFFCF4 + EFFFF9E9DFFFF7E7DBFFF7E5D9FFE0A278FFE7C2A9FFB66835FFBC6B36FFF6DF + D0FFE8A87EFFFCF6F1FFFCF6F1FFC88C64FFFAF1E9FFFBF4EEFFFDFAF7FFFDF9 + F6FFFAF0E8FFF8E8DDFFF7E6DBFFE1A37AFFEFD5C3FFB76935FFBC6B36FFF6DF + D1FFE9AA80FFFEFAF6FFFDFAF6FFC88C64FFFBF3EEFFFBF1EAFFFCF6F2FFFEFB + F8FFFCF6F1FFF9ECE2FFF8E7DBFFEED0BAFFECD0BDFFBB703EFFBC6B36FFF6E0 + D1FFF7E0D1FFFEFBF8FFFEFBF7FFFDF9F6FFFCF5F0FFFAF0EAFFFBF2EDFFFDF9 + F6FFFDFAF7FFFBF1EBFFF8E9DFFFECD0BDFFC9895EFF0000000000000000BC6B + 36FFBC6B36FFBC6B36FFBC6B36FFBB6B36FFBB6B36FFBB6A36FFBB6A36FFBC6C + 39FFBD6E3BFFBB6D3AFFBB6B38FFBB703EFF0000000000000000 + } + NumGlyphs = 0 + OnClick = btnSaveProfileClick + ShowCaption = False + ShowHint = True + ParentShowHint = False + end + object btnDeleteProfile: TSpeedButton + AnchorSideTop.Control = cbProfile + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = cbProfile + AnchorSideRight.Side = asrBottom + Left = 111 + Height = 22 + Hint = 'Delete profile' + Top = 41 + Width = 22 + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 8 + Color = clBtnFace + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000004F4CF2FF403EEDFF000000000000000000000000000000000000 + 0000000000002422E4FF312FEAFF000000000000000000000000000000000000 + 00005856F5FF6361FAFF5855F6FF413FEDFF0000000000000000000000000000 + 00002C2AE6FF413FF1FF4C4AF6FF312FEAFF0000000000000000000000000000 + 00005B58F6FF6562FAFF7170FFFF5956F6FF4240EEFF00000000000000003532 + E9FF4745F2FF6362FFFF4A48F4FF2F2DE9FF0000000000000000000000000000 + 0000000000005B59F6FF6663FAFF7471FFFF5A58F6FF4341EEFF3E3CECFF504D + F4FF6867FFFF504EF5FF3634EBFF000000000000000000000000000000000000 + 000000000000000000005C5AF6FF6764FAFF7472FFFF7370FFFF706EFFFF6E6C + FFFF5755F7FF3F3DEEFF00000000000000000000000000000000000000000000 + 00000000000000000000000000005D5BF7FF7976FFFF5956FFFF5754FFFF7270 + FFFF4846F0FF0000000000000000000000000000000000000000000000000000 + 00000000000000000000000000005D5AF6FF7D79FFFF5E5BFFFF5B58FFFF7674 + FFFF4643EFFF0000000000000000000000000000000000000000000000000000 + 000000000000000000006663F9FF706DFBFF807EFFFF7E7BFFFF7C79FFFF7977 + FFFF5E5CF7FF4744EFFF00000000000000000000000000000000000000000000 + 0000000000006E6BFCFF7774FDFF8682FFFF7673FCFF6462F8FF605DF7FF6D6A + FAFF7B79FFFF605DF7FF4845EFFF000000000000000000000000000000000000 + 00007471FEFF7D7AFEFF8A87FFFF7C79FDFF6C69FBFF0000000000000000615E + F8FF6E6CFAFF7D7AFFFF615FF7FF4946F0FF0000000000000000000000000000 + 00007A77FFFF817EFFFF817EFEFF7471FDFF0000000000000000000000000000 + 0000625FF8FF6F6DFBFF7E7CFFFF625FF8FF0000000000000000000000000000 + 0000000000007A77FFFF7976FEFF000000000000000000000000000000000000 + 0000000000006461F8FF6A68F9FF5451F3FF0000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000 + } + NumGlyphs = 0 + OnClick = btnDeleteProfileClick + ShowCaption = False + ShowHint = True + ParentShowHint = False + end + object cbProfile: TComboBox + AnchorSideLeft.Control = gbProfiles + AnchorSideTop.Control = gbProfiles + AnchorSideRight.Control = gbProfiles + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 29 + Top = 4 + Width = 125 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnChange = cbProfileChange + Style = csDropDownList + TabOrder = 0 + end + end +end diff --git a/Client/UfrmLogin.pas b/Client/UfrmLogin.pas index 812077d..c0fcae6 100644 --- a/Client/UfrmLogin.pas +++ b/Client/UfrmLogin.pas @@ -1,192 +1,192 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2009 Andreas Schneider - *) -unit UfrmLogin; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, - ExtCtrls, Spin, EditBtn, Buttons, IniFiles; - -type - - { TfrmLogin } - - TfrmLogin = class(TForm) - btnOK: TButton; - btnCancel: TButton; - cbProfile: TComboBox; - edData: TDirectoryEdit; - edHost: TEdit; - edUsername: TEdit; - edPassword: TEdit; - gbConnection: TGroupBox; - gbData: TGroupBox; - gbActions: TGroupBox; - gbProfiles: TGroupBox; - imgHost: TImage; - imgUsername: TImage; - imgPassword: TImage; - lblCopyright: TLabel; - lblHost: TLabel; - lblUsername: TLabel; - lblPassword: TLabel; - edPort: TSpinEdit; - lblData: TLabel; - btnSaveProfile: TSpeedButton; - btnDeleteProfile: TSpeedButton; - procedure btnCancelClick(Sender: TObject); - procedure btnDeleteProfileClick(Sender: TObject); - procedure btnOKClick(Sender: TObject); - procedure btnSaveProfileClick(Sender: TObject); - procedure cbProfileChange(Sender: TObject); - procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); - procedure FormCreate(Sender: TObject); - protected - FProfilePath: string; - public - { public declarations } - end; - -var - frmLogin: TfrmLogin; - -implementation - -uses - UdmNetwork; - -{$I version.inc} - -{ TfrmLogin } - -procedure TfrmLogin.btnCancelClick(Sender: TObject); -begin - Close; -end; - -procedure TfrmLogin.btnDeleteProfileClick(Sender: TObject); -begin - if cbProfile.ItemIndex > -1 then - begin - DeleteFile(FProfilePath + cbProfile.Text + '.ini'); - cbProfile.Items.Delete(cbProfile.ItemIndex); - end; -end; - -procedure TfrmLogin.btnOKClick(Sender: TObject); -var - path: string; -begin - path := IncludeTrailingPathDelimiter(edData.Text); - if (not FileExists(path + 'art.mul')) or - (not FileExists(path + 'artidx.mul')) or - (not FileExists(path + 'hues.mul')) or - (not FileExists(path + 'tiledata.mul')) or - (not FileExists(path + 'animdata.mul')) or - (not FileExists(path + 'texmaps.mul')) or - (not FileExists(path + 'texidx.mul')) or - (not FileExists(path + 'light.mul')) or - (not FileExists(path + 'lightidx.mul')) then - begin - MessageDlg('Incorrect directory', 'The data path you specified does not ' - + 'seem to be correct.', mtWarning, [mbOK], 0); - edData.SetFocus; - end else - ModalResult := mrOK; -end; - -procedure TfrmLogin.btnSaveProfileClick(Sender: TObject); -var - profileName: string; - profile: TIniFile; -begin - profileName := cbProfile.Text; - if InputQuery('Save profile', 'Enter the name of the profile:', profileName) then - begin - profile := TIniFile.Create(FProfilePath + profileName + '.ini'); - profile.WriteString('Connection', 'Host', edHost.Text); - profile.WriteInteger('Connection', 'Port', edPort.Value); - profile.WriteString('Connection', 'Username', edUsername.Text); - profile.WriteString('Data', 'Path', edData.Text); - profile.Free; - cbProfile.ItemIndex := cbProfile.Items.IndexOf(profileName); - if cbProfile.ItemIndex = -1 then - begin - cbProfile.Items.Add(profileName); - cbProfile.ItemIndex := cbProfile.Items.Count - 1; - end; - end; -end; - -procedure TfrmLogin.cbProfileChange(Sender: TObject); -var - profile: TIniFile; -begin - if cbProfile.ItemIndex > -1 then - begin - profile := TIniFile.Create(FProfilePath + cbProfile.Text + '.ini'); - edHost.Text := profile.ReadString('Connection', 'Host', ''); - edPort.Value := profile.ReadInteger('Connection', 'Port', 2597); - edUsername.Text := profile.ReadString('Connection', 'Username', ''); - edPassword.Text := ''; - edData.Text := profile.ReadString('Data', 'Path', ''); - edPassword.SetFocus; - profile.Free; - end; -end; - -procedure TfrmLogin.FormClose(Sender: TObject; var CloseAction: TCloseAction); -begin - if ModalResult <> mrOK then - dmNetwork.CheckClose(Self); -end; - -procedure TfrmLogin.FormCreate(Sender: TObject); -var - searchRec: TSearchRec; -begin - lblCopyright.Caption := Format('UO CentrED Client Version %s (c) %s', - [ProductVersion, Copyright]); - - FProfilePath := GetAppConfigDir(False) + 'Profiles' + PathDelim; - ForceDirectories(FProfilePath); - if FindFirst(FProfilePath + '*.ini', faAnyFile, searchRec) = 0 then - begin - repeat - cbProfile.Items.Add(ChangeFileExt(searchRec.Name, '')); - until FindNext(searchRec) <> 0; - end; - FindClose(searchRec); -end; - -initialization - {$I UfrmLogin.lrs} - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2009 Andreas Schneider + *) +unit UfrmLogin; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, + ExtCtrls, Spin, EditBtn, Buttons, IniFiles; + +type + + { TfrmLogin } + + TfrmLogin = class(TForm) + btnOK: TButton; + btnCancel: TButton; + cbProfile: TComboBox; + edData: TDirectoryEdit; + edHost: TEdit; + edUsername: TEdit; + edPassword: TEdit; + gbConnection: TGroupBox; + gbData: TGroupBox; + gbActions: TGroupBox; + gbProfiles: TGroupBox; + imgHost: TImage; + imgUsername: TImage; + imgPassword: TImage; + lblCopyright: TLabel; + lblHost: TLabel; + lblUsername: TLabel; + lblPassword: TLabel; + edPort: TSpinEdit; + lblData: TLabel; + btnSaveProfile: TSpeedButton; + btnDeleteProfile: TSpeedButton; + procedure btnCancelClick(Sender: TObject); + procedure btnDeleteProfileClick(Sender: TObject); + procedure btnOKClick(Sender: TObject); + procedure btnSaveProfileClick(Sender: TObject); + procedure cbProfileChange(Sender: TObject); + procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); + procedure FormCreate(Sender: TObject); + protected + FProfilePath: string; + public + { public declarations } + end; + +var + frmLogin: TfrmLogin; + +implementation + +uses + UdmNetwork; + +{$I version.inc} + +{ TfrmLogin } + +procedure TfrmLogin.btnCancelClick(Sender: TObject); +begin + Close; +end; + +procedure TfrmLogin.btnDeleteProfileClick(Sender: TObject); +begin + if cbProfile.ItemIndex > -1 then + begin + DeleteFile(FProfilePath + cbProfile.Text + '.ini'); + cbProfile.Items.Delete(cbProfile.ItemIndex); + end; +end; + +procedure TfrmLogin.btnOKClick(Sender: TObject); +var + path: string; +begin + path := IncludeTrailingPathDelimiter(edData.Text); + if (not FileExists(path + 'art.mul')) or + (not FileExists(path + 'artidx.mul')) or + (not FileExists(path + 'hues.mul')) or + (not FileExists(path + 'tiledata.mul')) or + (not FileExists(path + 'animdata.mul')) or + (not FileExists(path + 'texmaps.mul')) or + (not FileExists(path + 'texidx.mul')) or + (not FileExists(path + 'light.mul')) or + (not FileExists(path + 'lightidx.mul')) then + begin + MessageDlg('Incorrect directory', 'The data path you specified does not ' + + 'seem to be correct.', mtWarning, [mbOK], 0); + edData.SetFocus; + end else + ModalResult := mrOK; +end; + +procedure TfrmLogin.btnSaveProfileClick(Sender: TObject); +var + profileName: string; + profile: TIniFile; +begin + profileName := cbProfile.Text; + if InputQuery('Save profile', 'Enter the name of the profile:', profileName) then + begin + profile := TIniFile.Create(FProfilePath + profileName + '.ini'); + profile.WriteString('Connection', 'Host', edHost.Text); + profile.WriteInteger('Connection', 'Port', edPort.Value); + profile.WriteString('Connection', 'Username', edUsername.Text); + profile.WriteString('Data', 'Path', edData.Text); + profile.Free; + cbProfile.ItemIndex := cbProfile.Items.IndexOf(profileName); + if cbProfile.ItemIndex = -1 then + begin + cbProfile.Items.Add(profileName); + cbProfile.ItemIndex := cbProfile.Items.Count - 1; + end; + end; +end; + +procedure TfrmLogin.cbProfileChange(Sender: TObject); +var + profile: TIniFile; +begin + if cbProfile.ItemIndex > -1 then + begin + profile := TIniFile.Create(FProfilePath + cbProfile.Text + '.ini'); + edHost.Text := profile.ReadString('Connection', 'Host', ''); + edPort.Value := profile.ReadInteger('Connection', 'Port', 2597); + edUsername.Text := profile.ReadString('Connection', 'Username', ''); + edPassword.Text := ''; + edData.Text := profile.ReadString('Data', 'Path', ''); + edPassword.SetFocus; + profile.Free; + end; +end; + +procedure TfrmLogin.FormClose(Sender: TObject; var CloseAction: TCloseAction); +begin + if ModalResult <> mrOK then + dmNetwork.CheckClose(Self); +end; + +procedure TfrmLogin.FormCreate(Sender: TObject); +var + searchRec: TSearchRec; +begin + lblCopyright.Caption := Format('UO CentrED Client Version %s (c) %s', + [ProductVersion, Copyright]); + + FProfilePath := GetAppConfigDir(False) + 'Profiles' + PathDelim; + ForceDirectories(FProfilePath); + if FindFirst(FProfilePath + '*.ini', faAnyFile, searchRec) = 0 then + begin + repeat + cbProfile.Items.Add(ChangeFileExt(searchRec.Name, '')); + until FindNext(searchRec) <> 0; + end; + FindClose(searchRec); +end; + +initialization + {$I UfrmLogin.lrs} + +end. + diff --git a/Client/UfrmRegionControl.lfm b/Client/UfrmRegionControl.lfm index 0877a94..64cce01 100644 --- a/Client/UfrmRegionControl.lfm +++ b/Client/UfrmRegionControl.lfm @@ -1,635 +1,635 @@ -object frmRegionControl: TfrmRegionControl - Left = 247 - Height = 413 - Top = 139 - Width = 620 - ActiveControl = vstRegions - Caption = 'Region Control' - ClientHeight = 413 - ClientWidth = 620 - Font.Height = -11 - OnClose = FormClose - OnCreate = FormCreate - OnDestroy = FormDestroy - OnShow = FormShow - Position = poOwnerFormCenter - ShowInTaskBar = stAlways - LCLVersion = '0.9.29' - object sbArea: TScrollBox - AnchorSideLeft.Control = vstRegions - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = Owner - AnchorSideRight.Control = Owner - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = btnClose - Left = 160 - Height = 372 - Top = 0 - Width = 460 - Anchors = [akTop, akLeft, akRight, akBottom] - ClientHeight = 368 - ClientWidth = 456 - TabOrder = 0 - object pbArea: TPaintBox - Left = 0 - Height = 105 - Top = 0 - Width = 105 - OnMouseDown = pbAreaMouseDown - OnMouseMove = pbAreaMouseMove - OnPaint = pbAreaPaint - end - end - object btnClose: TButton - AnchorSideRight.Control = Owner - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = Owner - AnchorSideBottom.Side = asrBottom - Left = 548 - Height = 25 - Top = 380 - Width = 64 - Anchors = [akRight, akBottom] - BorderSpacing.Around = 8 - Caption = 'Close' - OnClick = btnCloseClick - TabOrder = 1 - end - object btnSave: TButton - AnchorSideRight.Control = btnClose - AnchorSideBottom.Control = btnClose - AnchorSideBottom.Side = asrBottom - Left = 476 - Height = 25 - Top = 380 - Width = 64 - Anchors = [akRight, akBottom] - BorderSpacing.Right = 4 - Caption = 'Save' - Enabled = False - OnClick = btnSaveClick - TabOrder = 2 - end - object vstRegions: TVirtualStringTree - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = Owner - AnchorSideBottom.Control = btnAddRegion - Left = 0 - Height = 130 - Top = 0 - Width = 160 - Anchors = [akTop, akLeft, akBottom] - DefaultText = 'Node' - Header.AutoSizeIndex = 0 - Header.Columns = < - item - Position = 0 - Text = 'Regions' - Width = 156 - end> - Header.DefaultHeight = 17 - Header.Options = [hoAutoResize, hoVisible] - Header.ParentFont = True - Header.Style = hsFlatButtons - PopupMenu = pmRegions - TabOrder = 3 - TreeOptions.MiscOptions = [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning] - TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] - TreeOptions.SelectionOptions = [toFullRowSelect] - OnChange = vstRegionsChange - OnFreeNode = vstRegionsFreeNode - OnGetText = vstRegionsGetText - end - object btnAddRegion: TSpeedButton - AnchorSideLeft.Control = vstRegions - AnchorSideBottom.Control = spRegionsArea - Left = 4 - Height = 22 - Hint = 'Add region' - Top = 134 - Width = 22 - Anchors = [akLeft, akBottom] - BorderSpacing.Around = 4 - Color = clBtnFace - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000003A8C44FF368940FF32873CFF2F84 - 37FF000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000459653FF419950FF7DC28FFF96D0A6FF96CFA6FF78BE - 89FF368D42FF2C8134FF00000000000000000000000000000000000000000000 - 0000000000004D9C5DFF64B478FFA8DBB5FF87CC98FF66BC7DFF64BA7CFF86CB - 98FFA5D9B4FF58AA6BFF2C8134FF000000000000000000000000000000000000 - 000056A366FF6AB97DFFA8DBB2FF60BC77FF5CBA73FF59B870FF59B56FFF58B5 - 6FFF5BB774FFA5D9B3FF5AAA6CFF2C8234FF0000000000000000000000000000 - 000053AB68FFAADDB4FF64C179FF5FBE71FF60BC77FFFFFFFFFFFFFFFFFF59B8 - 70FF58B56EFF5CB774FFA6DAB4FF388F43FF00000000000000000000000061AC - 75FF8ACC98FF89D396FF6BC67AFF63C170FF55AB65FFFFFFFFFFFFFFFFFF59B8 - 70FF59B870FF5BB972FF85CC97FF7BBE8DFF308539FF000000000000000065AF - 7AFFA9DDB3FF7DCF8AFF75CC81FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFF59B870FF67BE7DFF9CD4ABFF34883DFF000000000000000069B2 - 7EFFB6E2BEFF8BD597FF7AC986FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFF59B870FF69C17EFF9DD4AAFF388B42FF00000000000000006DB5 - 83FFACDDB6FFA6DFAFFF81CB8CFF7CC986FF6EBD79FFFFFFFFFFFFFFFFFF5BAC - 6AFF60BC77FF5CBA73FF8BD199FF80C592FF3C8E47FF00000000000000000000 - 000085C797FFD2EED7FF95D9A0FF8AD394FF7FC889FFFFFFFFFFFFFFFFFF79CD - 85FF6BC37CFF6FC77EFFACDFB5FF459E57FF0000000000000000000000000000 - 000070B887FFAADAB7FFD8F1DCFF92D89DFF88CD93FF84CC8EFF8BD496FF8AD4 - 95FF83D28EFFAFE0B7FF6BB97DFF489856FF0000000000000000000000000000 - 00000000000070B887FFAFDCBBFFDCF2E0FFB6E4BDFF9BDBA5FF96D9A0FFA5DF - AFFFC0E8C5FF79C28AFF509E5FFF000000000000000000000000000000000000 - 0000000000000000000071B887FF94CEA4FFC3E6CBFFCFEBD4FFC9E9CEFFAFDD - B8FF6DB97FFF58A569FF00000000000000000000000000000000000000000000 - 0000000000000000000000000000000000006EB684FF6AB380FF67B17CFF63AE - 77FF000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000 - } - NumGlyphs = 0 - OnClick = mnuAddRegionClick - ShowHint = True - ParentShowHint = False - end - object btnDeleteRegion: TSpeedButton - AnchorSideLeft.Control = btnAddRegion - AnchorSideLeft.Side = asrBottom - AnchorSideBottom.Control = btnAddRegion - AnchorSideBottom.Side = asrBottom - Left = 30 - Height = 22 - Hint = 'Delete region' - Top = 134 - Width = 22 - Anchors = [akLeft, akBottom] - BorderSpacing.Left = 4 - Color = clBtnFace - Enabled = False - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000003853BEFF3551BDFF304BBCFF2E4E - B8FF000000000000000000000000000000000000000000000000000000000000 - 000000000000000000004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178 - E4FF334DC1FF2B4AB7FF00000000000000000000000000000000000000000000 - 0000000000004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84 - EEFF9EA0F4FF515DD7FF2B4AB7FF000000000000000000000000000000000000 - 00005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56 - E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FF0000000000000000000000000000 - 00004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59 - E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF0000000000000000000000005C62 - D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59 - E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF00000000000000005F63 - DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF00000000000000006469 - DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF0000000000000000676A - DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F - ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF00000000000000000000 - 00007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84 - F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF0000000000000000000000000000 - 00006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92 - F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF0000000000000000000000000000 - 0000000000006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9 - FBFFBAC7FCFF707BE9FF4C5BCCFF000000000000000000000000000000000000 - 000000000000000000006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4 - F4FF6670E2FF535ED1FF00000000000000000000000000000000000000000000 - 000000000000000000000000000000000000686ADDFF6364DCFF6164DAFF5D63 - D9FF000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000 - } - NumGlyphs = 0 - OnClick = mnuDeleteRegionClick - ShowHint = True - ParentShowHint = False - end - object vstArea: TVirtualStringTree - AnchorSideLeft.Control = spRegionsArea - AnchorSideTop.Control = Label1 - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = spRegionsArea - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = btnDeleteArea - Left = 4 - Height = 124 - Top = 179 - Width = 152 - Anchors = [akTop, akLeft, akRight, akBottom] - BorderSpacing.Left = 4 - BorderSpacing.Right = 4 - BorderSpacing.Bottom = 4 - DefaultText = 'Node' - Header.AutoSizeIndex = 0 - Header.Columns = <> - Header.DefaultHeight = 17 - Header.MainColumn = -1 - Header.Options = [hoColumnResize, hoDrag] - TabOrder = 4 - TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] - TreeOptions.SelectionOptions = [toFullRowSelect] - OnChange = vstAreaChange - OnGetText = vstAreaGetText - end - object Label1: TLabel - AnchorSideLeft.Control = spRegionsArea - AnchorSideTop.Control = spRegionsArea - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = spRegionsArea - AnchorSideRight.Side = asrBottom - Left = 4 - Height = 14 - Top = 165 - Width = 152 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Left = 4 - BorderSpacing.Right = 4 - Caption = 'Area:' - ParentColor = False - end - object spRegionsArea: TSplitter - AnchorSideLeft.Control = vstRegions - AnchorSideRight.Control = vstRegions - AnchorSideRight.Side = asrBottom - Cursor = crVSplit - Left = 0 - Height = 5 - Top = 160 - Width = 160 - Align = alNone - Anchors = [akTop, akLeft, akRight] - AutoSnap = False - ResizeAnchor = akTop - end - object btnAddArea: TSpeedButton - AnchorSideTop.Control = btnDeleteArea - AnchorSideRight.Control = btnDeleteArea - Left = 43 - Height = 22 - Hint = 'Add area' - Top = 307 - Width = 22 - Anchors = [akTop, akRight] - Color = clBtnFace - Enabled = False - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000003A8C44FF368940FF32873CFF2F84 - 37FF000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000459653FF419950FF7DC28FFF96D0A6FF96CFA6FF78BE - 89FF368D42FF2C8134FF00000000000000000000000000000000000000000000 - 0000000000004D9C5DFF64B478FFA8DBB5FF87CC98FF66BC7DFF64BA7CFF86CB - 98FFA5D9B4FF58AA6BFF2C8134FF000000000000000000000000000000000000 - 000056A366FF6AB97DFFA8DBB2FF60BC77FF5CBA73FF59B870FF59B56FFF58B5 - 6FFF5BB774FFA5D9B3FF5AAA6CFF2C8234FF0000000000000000000000000000 - 000053AB68FFAADDB4FF64C179FF5FBE71FF60BC77FFFFFFFFFFFFFFFFFF59B8 - 70FF58B56EFF5CB774FFA6DAB4FF388F43FF00000000000000000000000061AC - 75FF8ACC98FF89D396FF6BC67AFF63C170FF55AB65FFFFFFFFFFFFFFFFFF59B8 - 70FF59B870FF5BB972FF85CC97FF7BBE8DFF308539FF000000000000000065AF - 7AFFA9DDB3FF7DCF8AFF75CC81FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFF59B870FF67BE7DFF9CD4ABFF34883DFF000000000000000069B2 - 7EFFB6E2BEFF8BD597FF7AC986FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFF59B870FF69C17EFF9DD4AAFF388B42FF00000000000000006DB5 - 83FFACDDB6FFA6DFAFFF81CB8CFF7CC986FF6EBD79FFFFFFFFFFFFFFFFFF5BAC - 6AFF60BC77FF5CBA73FF8BD199FF80C592FF3C8E47FF00000000000000000000 - 000085C797FFD2EED7FF95D9A0FF8AD394FF7FC889FFFFFFFFFFFFFFFFFF79CD - 85FF6BC37CFF6FC77EFFACDFB5FF459E57FF0000000000000000000000000000 - 000070B887FFAADAB7FFD8F1DCFF92D89DFF88CD93FF84CC8EFF8BD496FF8AD4 - 95FF83D28EFFAFE0B7FF6BB97DFF489856FF0000000000000000000000000000 - 00000000000070B887FFAFDCBBFFDCF2E0FFB6E4BDFF9BDBA5FF96D9A0FFA5DF - AFFFC0E8C5FF79C28AFF509E5FFF000000000000000000000000000000000000 - 0000000000000000000071B887FF94CEA4FFC3E6CBFFCFEBD4FFC9E9CEFFAFDD - B8FF6DB97FFF58A569FF00000000000000000000000000000000000000000000 - 0000000000000000000000000000000000006EB684FF6AB380FF67B17CFF63AE - 77FF000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000 - } - NumGlyphs = 0 - OnClick = btnAddAreaClick - ShowHint = True - ParentShowHint = False - end - object btnDeleteArea: TSpeedButton - AnchorSideLeft.Control = vstArea - AnchorSideLeft.Side = asrCenter - AnchorSideBottom.Control = seX1 - Left = 69 - Height = 22 - Hint = 'Delete area' - Top = 307 - Width = 22 - Anchors = [akLeft, akBottom] - BorderSpacing.Bottom = 4 - BorderSpacing.Around = 4 - Color = clBtnFace - Enabled = False - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000003853BEFF3551BDFF304BBCFF2E4E - B8FF000000000000000000000000000000000000000000000000000000000000 - 000000000000000000004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178 - E4FF334DC1FF2B4AB7FF00000000000000000000000000000000000000000000 - 0000000000004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84 - EEFF9EA0F4FF515DD7FF2B4AB7FF000000000000000000000000000000000000 - 00005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56 - E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FF0000000000000000000000000000 - 00004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59 - E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF0000000000000000000000005C62 - D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59 - E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF00000000000000005F63 - DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF00000000000000006469 - DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF0000000000000000676A - DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F - ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF00000000000000000000 - 00007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84 - F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF0000000000000000000000000000 - 00006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92 - F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF0000000000000000000000000000 - 0000000000006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9 - FBFFBAC7FCFF707BE9FF4C5BCCFF000000000000000000000000000000000000 - 000000000000000000006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4 - F4FF6670E2FF535ED1FF00000000000000000000000000000000000000000000 - 000000000000000000000000000000000000686ADDFF6364DCFF6164DAFF5D63 - D9FF000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000 - } - NumGlyphs = 0 - OnClick = btnDeleteAreaClick - ShowHint = True - ParentShowHint = False - end - object btnClearArea: TSpeedButton - AnchorSideLeft.Control = btnDeleteArea - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = btnDeleteArea - Left = 95 - Height = 22 - Hint = 'Delete all areas' - Top = 307 - Width = 22 - Color = clBtnFace - Enabled = False - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000 - EFFF0000EDFF0000EDFF00000000000000000000000000000000000000000000 - 0000000000000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443 - F7FF3242F7FF141BF1FF0000EDFF000000000000000000000000000000000000 - 00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909 - F5FF161BF5FF3343F7FF141BF1FF0000EDFF0000000000000000000000000000 - F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333 - F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF00000000000000000000 - FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA - FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF00000000000000000000 - FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1 - FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00000000000000000000 - FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC - FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF00000000000000000000 - FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC - FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF00000000000000000000 - FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2 - FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FF00000000000000000000 - FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC - FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000000000000000 - FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B - FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000 - 00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D - FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000 - 0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663 - FEFF5461FEFF2227FCFF0000FBFF000000000000000000000000000000000000 - 000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000 - FDFF0000FDFF0000FDFF00000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000 - } - NumGlyphs = 0 - OnClick = btnClearAreaClick - ShowHint = True - ParentShowHint = False - end - object lblX: TLabel - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = seX1 - AnchorSideTop.Side = asrCenter - Left = 4 - Height = 14 - Top = 339 - Width = 8 - BorderSpacing.Left = 4 - Caption = 'X' - Enabled = False - ParentColor = False - end - object seX1: TSpinEdit - AnchorSideLeft.Control = seY1 - AnchorSideBottom.Control = seY1 - Left = 20 - Height = 19 - Top = 337 - Width = 50 - Anchors = [akLeft, akBottom] - BorderSpacing.Bottom = 8 - Enabled = False - OnChange = seX1Change - TabOrder = 6 - Value = 1 - end - object seX2: TSpinEdit - AnchorSideLeft.Control = seX1 - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = seX1 - Left = 78 - Height = 19 - Top = 337 - Width = 50 - BorderSpacing.Left = 8 - Enabled = False - OnChange = seX1Change - TabOrder = 7 - Value = 1 - end - object lblY: TLabel - AnchorSideLeft.Control = lblX - AnchorSideTop.Control = seY1 - AnchorSideTop.Side = asrCenter - Left = 4 - Height = 14 - Top = 366 - Width = 8 - Caption = 'Y' - Enabled = False - ParentColor = False - end - object seY1: TSpinEdit - AnchorSideLeft.Control = lblY - AnchorSideLeft.Side = asrBottom - AnchorSideRight.Control = seX1 - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = btnGrab1 - Left = 20 - Height = 19 - Top = 364 - Width = 50 - Anchors = [akLeft, akRight, akBottom] - BorderSpacing.Left = 8 - Enabled = False - OnChange = seX1Change - TabOrder = 8 - Value = 1 - end - object seY2: TSpinEdit - AnchorSideLeft.Control = seX2 - AnchorSideTop.Control = seX2 - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = seX2 - AnchorSideRight.Side = asrBottom - Left = 78 - Height = 19 - Top = 364 - Width = 50 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Top = 8 - Enabled = False - OnChange = seX1Change - TabOrder = 9 - Value = 1 - end - object btnGrab1: TSpeedButton - AnchorSideLeft.Control = seY1 - AnchorSideLeft.Side = asrCenter - AnchorSideBottom.Control = Owner - AnchorSideBottom.Side = asrBottom - Left = 34 - Height = 22 - Hint = 'Grab coordinates from the main window.' - Top = 387 - Width = 22 - Anchors = [akLeft, akBottom] - BorderSpacing.Around = 4 - Color = clBtnFace - Enabled = False - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F7F7F067C7C - 7CE6787878CC75757581FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383835DAAAA - AAFFDBDBDBFF797979F275757506FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF0097979709FFFFFF00FFFFFF00FFFFFF00888888E7DBDB - DBFFB7B7B7FF7D7D7D80FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF009C9C9CC99898981EFFFFFF0090909050ADADADFFF2F2 - F2FF848484FD8181810FFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00A0A0A0FF9C9C9CE798989836949494DFD9D9D9FFC1C1 - C1FF898989A0FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00A4A4A4FFD7D7D7FF9D9D9DF8D0D0D0FFEEEEEEFF9191 - 91FE8D8D8D18FFFFFF00FFFFFF00818181097E7E7E09FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00A9A9A9FFF2F2F2FFE5E5E5FFE2E2E2FFE3E3E3FF9595 - 95F4919191CC8D8D8DF9898989FF86868693FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00ADADADFFEEEEEEFFE1E1E1FFDFDFDFFFE0E0E0FFE7E7 - E7FFE4E4E4FFBBBBBBFF8E8E8E93FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00B1B1B1FFF0F0F0FFE4E4E4FFE2E2E2FFE2E2E2FFE7E7 - E7FFC1C1C1FF96969690FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00B5B5B5FFF2F2F2FFE8E8E8FFE7E7E7FFEAEAEAFFC6C6 - C6FF9E9E9E8DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00B9B9B9FFF4F4F4FFECECECFFEDEDEDFFCBCBCBFFA7A7 - A78AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00BDBDBDFFF7F7F7FFEFEFEFFFD0D0D0FFAFAFAF8AFFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00C1C1C1FFF7F7F7FFD5D5D5FFB6B6B687FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00C4C4C4FFD9D9D9FFBEBEBE84FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00C8C8C8FFC5C5C581FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00CBCBCB7EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - NumGlyphs = 0 - OnClick = btnGrab1Click - ShowHint = True - ParentShowHint = False - end - object btnGrab2: TSpeedButton - AnchorSideLeft.Control = seY2 - AnchorSideLeft.Side = asrCenter - AnchorSideBottom.Control = btnGrab1 - AnchorSideBottom.Side = asrBottom - Left = 92 - Height = 22 - Hint = 'Grab coordinates from the main window.' - Top = 387 - Width = 22 - Anchors = [akLeft, akBottom] - Color = clBtnFace - Enabled = False - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F7F7F067C7C - 7CE6787878CC75757581FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383835DAAAA - AAFFDBDBDBFF797979F275757506FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF0097979709FFFFFF00FFFFFF00FFFFFF00888888E7DBDB - DBFFB7B7B7FF7D7D7D80FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF009C9C9CC99898981EFFFFFF0090909050ADADADFFF2F2 - F2FF848484FD8181810FFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00A0A0A0FF9C9C9CE798989836949494DFD9D9D9FFC1C1 - C1FF898989A0FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00A4A4A4FFD7D7D7FF9D9D9DF8D0D0D0FFEEEEEEFF9191 - 91FE8D8D8D18FFFFFF00FFFFFF00818181097E7E7E09FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00A9A9A9FFF2F2F2FFE5E5E5FFE2E2E2FFE3E3E3FF9595 - 95F4919191CC8D8D8DF9898989FF86868693FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00ADADADFFEEEEEEFFE1E1E1FFDFDFDFFFE0E0E0FFE7E7 - E7FFE4E4E4FFBBBBBBFF8E8E8E93FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00B1B1B1FFF0F0F0FFE4E4E4FFE2E2E2FFE2E2E2FFE7E7 - E7FFC1C1C1FF96969690FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00B5B5B5FFF2F2F2FFE8E8E8FFE7E7E7FFEAEAEAFFC6C6 - C6FF9E9E9E8DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00B9B9B9FFF4F4F4FFECECECFFEDEDEDFFCBCBCBFFA7A7 - A78AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00BDBDBDFFF7F7F7FFEFEFEFFFD0D0D0FFAFAFAF8AFFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00C1C1C1FFF7F7F7FFD5D5D5FFB6B6B687FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00C4C4C4FFD9D9D9FFBEBEBE84FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00C8C8C8FFC5C5C581FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00CBCBCB7EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - NumGlyphs = 0 - OnClick = btnGrab1Click - ShowHint = True - ParentShowHint = False - end - object pmRegions: TPopupMenu - left = 48 - top = 43 - object mnuAddRegion: TMenuItem - Caption = 'Add' - OnClick = mnuAddRegionClick - end - object mnuDeleteRegion: TMenuItem - Caption = 'Delete' - Enabled = False - OnClick = mnuDeleteRegionClick - end - end -end +object frmRegionControl: TfrmRegionControl + Left = 247 + Height = 413 + Top = 139 + Width = 620 + ActiveControl = vstRegions + Caption = 'Region Control' + ClientHeight = 413 + ClientWidth = 620 + Font.Height = -11 + OnClose = FormClose + OnCreate = FormCreate + OnDestroy = FormDestroy + OnShow = FormShow + Position = poOwnerFormCenter + ShowInTaskBar = stAlways + LCLVersion = '0.9.29' + object sbArea: TScrollBox + AnchorSideLeft.Control = vstRegions + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = btnClose + Left = 160 + Height = 372 + Top = 0 + Width = 460 + Anchors = [akTop, akLeft, akRight, akBottom] + ClientHeight = 368 + ClientWidth = 456 + TabOrder = 0 + object pbArea: TPaintBox + Left = 0 + Height = 105 + Top = 0 + Width = 105 + OnMouseDown = pbAreaMouseDown + OnMouseMove = pbAreaMouseMove + OnPaint = pbAreaPaint + end + end + object btnClose: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 548 + Height = 25 + Top = 380 + Width = 64 + Anchors = [akRight, akBottom] + BorderSpacing.Around = 8 + Caption = 'Close' + OnClick = btnCloseClick + TabOrder = 1 + end + object btnSave: TButton + AnchorSideRight.Control = btnClose + AnchorSideBottom.Control = btnClose + AnchorSideBottom.Side = asrBottom + Left = 476 + Height = 25 + Top = 380 + Width = 64 + Anchors = [akRight, akBottom] + BorderSpacing.Right = 4 + Caption = 'Save' + Enabled = False + OnClick = btnSaveClick + TabOrder = 2 + end + object vstRegions: TVirtualStringTree + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideBottom.Control = btnAddRegion + Left = 0 + Height = 130 + Top = 0 + Width = 160 + Anchors = [akTop, akLeft, akBottom] + DefaultText = 'Node' + Header.AutoSizeIndex = 0 + Header.Columns = < + item + Position = 0 + Text = 'Regions' + Width = 156 + end> + Header.DefaultHeight = 17 + Header.Options = [hoAutoResize, hoVisible] + Header.ParentFont = True + Header.Style = hsFlatButtons + PopupMenu = pmRegions + TabOrder = 3 + TreeOptions.MiscOptions = [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning] + TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] + TreeOptions.SelectionOptions = [toFullRowSelect] + OnChange = vstRegionsChange + OnFreeNode = vstRegionsFreeNode + OnGetText = vstRegionsGetText + end + object btnAddRegion: TSpeedButton + AnchorSideLeft.Control = vstRegions + AnchorSideBottom.Control = spRegionsArea + Left = 4 + Height = 22 + Hint = 'Add region' + Top = 134 + Width = 22 + Anchors = [akLeft, akBottom] + BorderSpacing.Around = 4 + Color = clBtnFace + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000003A8C44FF368940FF32873CFF2F84 + 37FF000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000459653FF419950FF7DC28FFF96D0A6FF96CFA6FF78BE + 89FF368D42FF2C8134FF00000000000000000000000000000000000000000000 + 0000000000004D9C5DFF64B478FFA8DBB5FF87CC98FF66BC7DFF64BA7CFF86CB + 98FFA5D9B4FF58AA6BFF2C8134FF000000000000000000000000000000000000 + 000056A366FF6AB97DFFA8DBB2FF60BC77FF5CBA73FF59B870FF59B56FFF58B5 + 6FFF5BB774FFA5D9B3FF5AAA6CFF2C8234FF0000000000000000000000000000 + 000053AB68FFAADDB4FF64C179FF5FBE71FF60BC77FFFFFFFFFFFFFFFFFF59B8 + 70FF58B56EFF5CB774FFA6DAB4FF388F43FF00000000000000000000000061AC + 75FF8ACC98FF89D396FF6BC67AFF63C170FF55AB65FFFFFFFFFFFFFFFFFF59B8 + 70FF59B870FF5BB972FF85CC97FF7BBE8DFF308539FF000000000000000065AF + 7AFFA9DDB3FF7DCF8AFF75CC81FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF59B870FF67BE7DFF9CD4ABFF34883DFF000000000000000069B2 + 7EFFB6E2BEFF8BD597FF7AC986FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF59B870FF69C17EFF9DD4AAFF388B42FF00000000000000006DB5 + 83FFACDDB6FFA6DFAFFF81CB8CFF7CC986FF6EBD79FFFFFFFFFFFFFFFFFF5BAC + 6AFF60BC77FF5CBA73FF8BD199FF80C592FF3C8E47FF00000000000000000000 + 000085C797FFD2EED7FF95D9A0FF8AD394FF7FC889FFFFFFFFFFFFFFFFFF79CD + 85FF6BC37CFF6FC77EFFACDFB5FF459E57FF0000000000000000000000000000 + 000070B887FFAADAB7FFD8F1DCFF92D89DFF88CD93FF84CC8EFF8BD496FF8AD4 + 95FF83D28EFFAFE0B7FF6BB97DFF489856FF0000000000000000000000000000 + 00000000000070B887FFAFDCBBFFDCF2E0FFB6E4BDFF9BDBA5FF96D9A0FFA5DF + AFFFC0E8C5FF79C28AFF509E5FFF000000000000000000000000000000000000 + 0000000000000000000071B887FF94CEA4FFC3E6CBFFCFEBD4FFC9E9CEFFAFDD + B8FF6DB97FFF58A569FF00000000000000000000000000000000000000000000 + 0000000000000000000000000000000000006EB684FF6AB380FF67B17CFF63AE + 77FF000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000 + } + NumGlyphs = 0 + OnClick = mnuAddRegionClick + ShowHint = True + ParentShowHint = False + end + object btnDeleteRegion: TSpeedButton + AnchorSideLeft.Control = btnAddRegion + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = btnAddRegion + AnchorSideBottom.Side = asrBottom + Left = 30 + Height = 22 + Hint = 'Delete region' + Top = 134 + Width = 22 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 4 + Color = clBtnFace + Enabled = False + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000003853BEFF3551BDFF304BBCFF2E4E + B8FF000000000000000000000000000000000000000000000000000000000000 + 000000000000000000004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178 + E4FF334DC1FF2B4AB7FF00000000000000000000000000000000000000000000 + 0000000000004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84 + EEFF9EA0F4FF515DD7FF2B4AB7FF000000000000000000000000000000000000 + 00005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56 + E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FF0000000000000000000000000000 + 00004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59 + E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF0000000000000000000000005C62 + D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59 + E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF00000000000000005F63 + DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF00000000000000006469 + DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF0000000000000000676A + DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F + ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF00000000000000000000 + 00007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84 + F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF0000000000000000000000000000 + 00006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92 + F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF0000000000000000000000000000 + 0000000000006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9 + FBFFBAC7FCFF707BE9FF4C5BCCFF000000000000000000000000000000000000 + 000000000000000000006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4 + F4FF6670E2FF535ED1FF00000000000000000000000000000000000000000000 + 000000000000000000000000000000000000686ADDFF6364DCFF6164DAFF5D63 + D9FF000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000 + } + NumGlyphs = 0 + OnClick = mnuDeleteRegionClick + ShowHint = True + ParentShowHint = False + end + object vstArea: TVirtualStringTree + AnchorSideLeft.Control = spRegionsArea + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = spRegionsArea + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = btnDeleteArea + Left = 4 + Height = 124 + Top = 179 + Width = 152 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 4 + BorderSpacing.Right = 4 + BorderSpacing.Bottom = 4 + DefaultText = 'Node' + Header.AutoSizeIndex = 0 + Header.Columns = <> + Header.DefaultHeight = 17 + Header.MainColumn = -1 + Header.Options = [hoColumnResize, hoDrag] + TabOrder = 4 + TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] + TreeOptions.SelectionOptions = [toFullRowSelect] + OnChange = vstAreaChange + OnGetText = vstAreaGetText + end + object Label1: TLabel + AnchorSideLeft.Control = spRegionsArea + AnchorSideTop.Control = spRegionsArea + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = spRegionsArea + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 14 + Top = 165 + Width = 152 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 4 + BorderSpacing.Right = 4 + Caption = 'Area:' + ParentColor = False + end + object spRegionsArea: TSplitter + AnchorSideLeft.Control = vstRegions + AnchorSideRight.Control = vstRegions + AnchorSideRight.Side = asrBottom + Cursor = crVSplit + Left = 0 + Height = 5 + Top = 160 + Width = 160 + Align = alNone + Anchors = [akTop, akLeft, akRight] + AutoSnap = False + ResizeAnchor = akTop + end + object btnAddArea: TSpeedButton + AnchorSideTop.Control = btnDeleteArea + AnchorSideRight.Control = btnDeleteArea + Left = 43 + Height = 22 + Hint = 'Add area' + Top = 307 + Width = 22 + Anchors = [akTop, akRight] + Color = clBtnFace + Enabled = False + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000003A8C44FF368940FF32873CFF2F84 + 37FF000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000459653FF419950FF7DC28FFF96D0A6FF96CFA6FF78BE + 89FF368D42FF2C8134FF00000000000000000000000000000000000000000000 + 0000000000004D9C5DFF64B478FFA8DBB5FF87CC98FF66BC7DFF64BA7CFF86CB + 98FFA5D9B4FF58AA6BFF2C8134FF000000000000000000000000000000000000 + 000056A366FF6AB97DFFA8DBB2FF60BC77FF5CBA73FF59B870FF59B56FFF58B5 + 6FFF5BB774FFA5D9B3FF5AAA6CFF2C8234FF0000000000000000000000000000 + 000053AB68FFAADDB4FF64C179FF5FBE71FF60BC77FFFFFFFFFFFFFFFFFF59B8 + 70FF58B56EFF5CB774FFA6DAB4FF388F43FF00000000000000000000000061AC + 75FF8ACC98FF89D396FF6BC67AFF63C170FF55AB65FFFFFFFFFFFFFFFFFF59B8 + 70FF59B870FF5BB972FF85CC97FF7BBE8DFF308539FF000000000000000065AF + 7AFFA9DDB3FF7DCF8AFF75CC81FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF59B870FF67BE7DFF9CD4ABFF34883DFF000000000000000069B2 + 7EFFB6E2BEFF8BD597FF7AC986FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF59B870FF69C17EFF9DD4AAFF388B42FF00000000000000006DB5 + 83FFACDDB6FFA6DFAFFF81CB8CFF7CC986FF6EBD79FFFFFFFFFFFFFFFFFF5BAC + 6AFF60BC77FF5CBA73FF8BD199FF80C592FF3C8E47FF00000000000000000000 + 000085C797FFD2EED7FF95D9A0FF8AD394FF7FC889FFFFFFFFFFFFFFFFFF79CD + 85FF6BC37CFF6FC77EFFACDFB5FF459E57FF0000000000000000000000000000 + 000070B887FFAADAB7FFD8F1DCFF92D89DFF88CD93FF84CC8EFF8BD496FF8AD4 + 95FF83D28EFFAFE0B7FF6BB97DFF489856FF0000000000000000000000000000 + 00000000000070B887FFAFDCBBFFDCF2E0FFB6E4BDFF9BDBA5FF96D9A0FFA5DF + AFFFC0E8C5FF79C28AFF509E5FFF000000000000000000000000000000000000 + 0000000000000000000071B887FF94CEA4FFC3E6CBFFCFEBD4FFC9E9CEFFAFDD + B8FF6DB97FFF58A569FF00000000000000000000000000000000000000000000 + 0000000000000000000000000000000000006EB684FF6AB380FF67B17CFF63AE + 77FF000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000 + } + NumGlyphs = 0 + OnClick = btnAddAreaClick + ShowHint = True + ParentShowHint = False + end + object btnDeleteArea: TSpeedButton + AnchorSideLeft.Control = vstArea + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = seX1 + Left = 69 + Height = 22 + Hint = 'Delete area' + Top = 307 + Width = 22 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 4 + BorderSpacing.Around = 4 + Color = clBtnFace + Enabled = False + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000003853BEFF3551BDFF304BBCFF2E4E + B8FF000000000000000000000000000000000000000000000000000000000000 + 000000000000000000004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178 + E4FF334DC1FF2B4AB7FF00000000000000000000000000000000000000000000 + 0000000000004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84 + EEFF9EA0F4FF515DD7FF2B4AB7FF000000000000000000000000000000000000 + 00005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56 + E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FF0000000000000000000000000000 + 00004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59 + E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF0000000000000000000000005C62 + D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59 + E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF00000000000000005F63 + DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF00000000000000006469 + DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF0000000000000000676A + DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F + ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF00000000000000000000 + 00007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84 + F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF0000000000000000000000000000 + 00006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92 + F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF0000000000000000000000000000 + 0000000000006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9 + FBFFBAC7FCFF707BE9FF4C5BCCFF000000000000000000000000000000000000 + 000000000000000000006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4 + F4FF6670E2FF535ED1FF00000000000000000000000000000000000000000000 + 000000000000000000000000000000000000686ADDFF6364DCFF6164DAFF5D63 + D9FF000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000 + } + NumGlyphs = 0 + OnClick = btnDeleteAreaClick + ShowHint = True + ParentShowHint = False + end + object btnClearArea: TSpeedButton + AnchorSideLeft.Control = btnDeleteArea + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = btnDeleteArea + Left = 95 + Height = 22 + Hint = 'Delete all areas' + Top = 307 + Width = 22 + Color = clBtnFace + Enabled = False + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000 + EFFF0000EDFF0000EDFF00000000000000000000000000000000000000000000 + 0000000000000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443 + F7FF3242F7FF141BF1FF0000EDFF000000000000000000000000000000000000 + 00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909 + F5FF161BF5FF3343F7FF141BF1FF0000EDFF0000000000000000000000000000 + F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333 + F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF00000000000000000000 + FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA + FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF00000000000000000000 + FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1 + FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00000000000000000000 + FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC + FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF00000000000000000000 + FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC + FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF00000000000000000000 + FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2 + FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FF00000000000000000000 + FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC + FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000000000000000 + FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B + FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000 + 00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D + FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000 + 0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663 + FEFF5461FEFF2227FCFF0000FBFF000000000000000000000000000000000000 + 000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000 + FDFF0000FDFF0000FDFF00000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000 + } + NumGlyphs = 0 + OnClick = btnClearAreaClick + ShowHint = True + ParentShowHint = False + end + object lblX: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = seX1 + AnchorSideTop.Side = asrCenter + Left = 4 + Height = 14 + Top = 339 + Width = 8 + BorderSpacing.Left = 4 + Caption = 'X' + Enabled = False + ParentColor = False + end + object seX1: TSpinEdit + AnchorSideLeft.Control = seY1 + AnchorSideBottom.Control = seY1 + Left = 20 + Height = 19 + Top = 337 + Width = 50 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 8 + Enabled = False + OnChange = seX1Change + TabOrder = 6 + Value = 1 + end + object seX2: TSpinEdit + AnchorSideLeft.Control = seX1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = seX1 + Left = 78 + Height = 19 + Top = 337 + Width = 50 + BorderSpacing.Left = 8 + Enabled = False + OnChange = seX1Change + TabOrder = 7 + Value = 1 + end + object lblY: TLabel + AnchorSideLeft.Control = lblX + AnchorSideTop.Control = seY1 + AnchorSideTop.Side = asrCenter + Left = 4 + Height = 14 + Top = 366 + Width = 8 + Caption = 'Y' + Enabled = False + ParentColor = False + end + object seY1: TSpinEdit + AnchorSideLeft.Control = lblY + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = seX1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = btnGrab1 + Left = 20 + Height = 19 + Top = 364 + Width = 50 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + Enabled = False + OnChange = seX1Change + TabOrder = 8 + Value = 1 + end + object seY2: TSpinEdit + AnchorSideLeft.Control = seX2 + AnchorSideTop.Control = seX2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = seX2 + AnchorSideRight.Side = asrBottom + Left = 78 + Height = 19 + Top = 364 + Width = 50 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + Enabled = False + OnChange = seX1Change + TabOrder = 9 + Value = 1 + end + object btnGrab1: TSpeedButton + AnchorSideLeft.Control = seY1 + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 34 + Height = 22 + Hint = 'Grab coordinates from the main window.' + Top = 387 + Width = 22 + Anchors = [akLeft, akBottom] + BorderSpacing.Around = 4 + Color = clBtnFace + Enabled = False + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F7F7F067C7C + 7CE6787878CC75757581FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383835DAAAA + AAFFDBDBDBFF797979F275757506FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0097979709FFFFFF00FFFFFF00FFFFFF00888888E7DBDB + DBFFB7B7B7FF7D7D7D80FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF009C9C9CC99898981EFFFFFF0090909050ADADADFFF2F2 + F2FF848484FD8181810FFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00A0A0A0FF9C9C9CE798989836949494DFD9D9D9FFC1C1 + C1FF898989A0FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00A4A4A4FFD7D7D7FF9D9D9DF8D0D0D0FFEEEEEEFF9191 + 91FE8D8D8D18FFFFFF00FFFFFF00818181097E7E7E09FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00A9A9A9FFF2F2F2FFE5E5E5FFE2E2E2FFE3E3E3FF9595 + 95F4919191CC8D8D8DF9898989FF86868693FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00ADADADFFEEEEEEFFE1E1E1FFDFDFDFFFE0E0E0FFE7E7 + E7FFE4E4E4FFBBBBBBFF8E8E8E93FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00B1B1B1FFF0F0F0FFE4E4E4FFE2E2E2FFE2E2E2FFE7E7 + E7FFC1C1C1FF96969690FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00B5B5B5FFF2F2F2FFE8E8E8FFE7E7E7FFEAEAEAFFC6C6 + C6FF9E9E9E8DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00B9B9B9FFF4F4F4FFECECECFFEDEDEDFFCBCBCBFFA7A7 + A78AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00BDBDBDFFF7F7F7FFEFEFEFFFD0D0D0FFAFAFAF8AFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00C1C1C1FFF7F7F7FFD5D5D5FFB6B6B687FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00C4C4C4FFD9D9D9FFBEBEBE84FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00C8C8C8FFC5C5C581FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00CBCBCB7EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + NumGlyphs = 0 + OnClick = btnGrab1Click + ShowHint = True + ParentShowHint = False + end + object btnGrab2: TSpeedButton + AnchorSideLeft.Control = seY2 + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = btnGrab1 + AnchorSideBottom.Side = asrBottom + Left = 92 + Height = 22 + Hint = 'Grab coordinates from the main window.' + Top = 387 + Width = 22 + Anchors = [akLeft, akBottom] + Color = clBtnFace + Enabled = False + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F7F7F067C7C + 7CE6787878CC75757581FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383835DAAAA + AAFFDBDBDBFF797979F275757506FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0097979709FFFFFF00FFFFFF00FFFFFF00888888E7DBDB + DBFFB7B7B7FF7D7D7D80FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF009C9C9CC99898981EFFFFFF0090909050ADADADFFF2F2 + F2FF848484FD8181810FFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00A0A0A0FF9C9C9CE798989836949494DFD9D9D9FFC1C1 + C1FF898989A0FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00A4A4A4FFD7D7D7FF9D9D9DF8D0D0D0FFEEEEEEFF9191 + 91FE8D8D8D18FFFFFF00FFFFFF00818181097E7E7E09FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00A9A9A9FFF2F2F2FFE5E5E5FFE2E2E2FFE3E3E3FF9595 + 95F4919191CC8D8D8DF9898989FF86868693FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00ADADADFFEEEEEEFFE1E1E1FFDFDFDFFFE0E0E0FFE7E7 + E7FFE4E4E4FFBBBBBBFF8E8E8E93FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00B1B1B1FFF0F0F0FFE4E4E4FFE2E2E2FFE2E2E2FFE7E7 + E7FFC1C1C1FF96969690FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00B5B5B5FFF2F2F2FFE8E8E8FFE7E7E7FFEAEAEAFFC6C6 + C6FF9E9E9E8DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00B9B9B9FFF4F4F4FFECECECFFEDEDEDFFCBCBCBFFA7A7 + A78AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00BDBDBDFFF7F7F7FFEFEFEFFFD0D0D0FFAFAFAF8AFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00C1C1C1FFF7F7F7FFD5D5D5FFB6B6B687FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00C4C4C4FFD9D9D9FFBEBEBE84FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00C8C8C8FFC5C5C581FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00CBCBCB7EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + NumGlyphs = 0 + OnClick = btnGrab1Click + ShowHint = True + ParentShowHint = False + end + object pmRegions: TPopupMenu + left = 48 + top = 43 + object mnuAddRegion: TMenuItem + Caption = 'Add' + OnClick = mnuAddRegionClick + end + object mnuDeleteRegion: TMenuItem + Caption = 'Delete' + Enabled = False + OnClick = mnuDeleteRegionClick + end + end +end diff --git a/Client/UfrmRegionControl.pas b/Client/UfrmRegionControl.pas index 0bf464a..1f3c9f5 100644 --- a/Client/UfrmRegionControl.pas +++ b/Client/UfrmRegionControl.pas @@ -1,740 +1,740 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2009 Andreas Schneider - *) -unit UfrmRegionControl; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, math, LResources, Forms, Controls, Graphics, Dialogs, - VirtualTrees, ExtCtrls, ImagingComponents, StdCtrls, Buttons, Spin, LCLIntf, - UEnhancedMemoryStream, Menus, URectList, UEnums, UWorldItem; - -type - TAreaMoveType = (amLeft, amTop, amRight, amBottom); - TAreaMove = set of TAreaMoveType; - - PRegionInfo = ^TRegionInfo; - TRegionInfo = record - Name: string; - Areas: TRectList; - end; - - TRegionModifiedEvent = procedure(ARegionInfo: TRegionInfo) of object; - TRegionDeletedEvent = procedure(ARegionName: string) of object; - TRegionListEvent = procedure of object; - - { TfrmRegionControl } - - TfrmRegionControl = class(TForm) - btnAddArea: TSpeedButton; - btnAddRegion: TSpeedButton; - btnClearArea: TSpeedButton; - btnClose: TButton; - btnDeleteArea: TSpeedButton; - btnDeleteRegion: TSpeedButton; - btnSave: TButton; - Label1: TLabel; - lblX: TLabel; - lblY: TLabel; - mnuAddRegion: TMenuItem; - mnuDeleteRegion: TMenuItem; - pbArea: TPaintBox; - pmRegions: TPopupMenu; - sbArea: TScrollBox; - seX1: TSpinEdit; - seX2: TSpinEdit; - seY1: TSpinEdit; - seY2: TSpinEdit; - btnGrab1: TSpeedButton; - btnGrab2: TSpeedButton; - spRegionsArea: TSplitter; - vstArea: TVirtualStringTree; - vstRegions: TVirtualStringTree; - procedure btnGrab1Click(Sender: TObject); - procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); - procedure mnuAddRegionClick(Sender: TObject); - procedure mnuDeleteRegionClick(Sender: TObject); - procedure btnAddAreaClick(Sender: TObject); - procedure btnClearAreaClick(Sender: TObject); - procedure btnCloseClick(Sender: TObject); - procedure btnDeleteAreaClick(Sender: TObject); - procedure btnSaveClick(Sender: TObject); - procedure FormCreate(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure FormShow(Sender: TObject); - procedure pbAreaMouseDown(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); - procedure pbAreaMouseMove(Sender: TObject; Shift: TShiftState; X, - Y: Integer); - procedure pbAreaPaint(Sender: TObject); - procedure seX1Change(Sender: TObject); - procedure vstAreaChange(Sender: TBaseVirtualTree; Node: PVirtualNode); - procedure vstAreaGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; - Column: TColumnIndex; TextType: TVSTTextType; var CellText: UTF8String); - procedure vstRegionsChange(Sender: TBaseVirtualTree; Node: PVirtualNode); - procedure vstRegionsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); - procedure vstRegionsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; - Column: TColumnIndex; TextType: TVSTTextType; var CellText: UTF8String); - protected - FLastX: Integer; - FLastY: Integer; - FAreaMove: TAreaMove; - FTempRegionNode: PVirtualNode; - FOnRegionModified: TRegionModifiedEvent; - FOnRegionDeleted: TRegionDeletedEvent; - FOnRegionList: TRegionListEvent; - FSelectFirst: Boolean; - FOldWindowState: TWindowState; - function FindRegion(AName: string): PVirtualNode; - procedure CheckUnsaved; - procedure OnModifyRegionPacket(ABuffer: TEnhancedMemoryStream); - procedure OnDeleteRegionPacket(ABuffer: TEnhancedMemoryStream); - procedure OnListRegionsPacket(ABuffer: TEnhancedMemoryStream); - procedure OnAccessChanged(AAccessLevel: TAccessLevel); - procedure TileSelected(AWorldItem: TWorldItem); - public - property OnRegionModified: TRegionModifiedEvent read FOnRegionModified write FOnRegionModified; - property OnRegionDeleted: TRegionDeletedEvent read FOnRegionDeleted write FOnRegionDeleted; - property OnRegionList: TRegionListEvent read FOnRegionList write FOnRegionList; - end; - -var - frmRegionControl: TfrmRegionControl; - -implementation - -uses - UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UGUIPlatformUtils, - UAdminHandling, UPacketHandlers; - -type - { TModifyRegionPacket } - - TModifyRegionPacket = class(TPacket) - constructor Create(ARegionInfo: TRegionInfo); - end; - - { TDeleteRegionPacket } - - TDeleteRegionPacket = class(TPacket) - constructor Create(AName: string); - end; - - { TRequestRegionListPacket } - - TRequestRegionListPacket = class(TPacket) - constructor Create; - end; - -{ TModifyRegionPacket } - -constructor TModifyRegionPacket.Create(ARegionInfo: TRegionInfo); -var - i: Integer; - count: Byte; - area: TRect; -begin - inherited Create($03, 0); //Admin Packet - FStream.WriteByte($08); //Admin PacketID - FStream.WriteStringNull(ARegionInfo.Name); - count := Min(ARegionInfo.Areas.Count, 256); - FStream.WriteByte(count); - for i := 0 to count - 1 do - begin - area := ARegionInfo.Areas.Rects[i]; - FStream.WriteWord(area.Left); - FStream.WriteWord(area.Top); - FStream.WriteWord(area.Right); - FStream.WriteWord(area.Bottom); - end; -end; - -{ TDeleteRegionPacket } - -constructor TDeleteRegionPacket.Create(AName: string); -begin - inherited Create($03, 0); //Admin Packet - FStream.WriteByte($09); //Admin PacketID - FStream.WriteStringNull(AName); -end; - -{ TRequestRegionListPacket } - -constructor TRequestRegionListPacket.Create; -begin - inherited Create($03, 0); //Admin Packet - FStream.WriteByte($0A); //Admin PacketID -end; - -{ TfrmRegionControl } - -procedure TfrmRegionControl.FormCreate(Sender: TObject); -begin - pbArea.Width := frmRadarMap.Radar.Width; - pbArea.Height := frmRadarMap.Radar.Height; - seX1.MaxValue := ResMan.Landscape.CellWidth; - seX2.MaxValue := ResMan.Landscape.CellWidth; - seY1.MaxValue := ResMan.Landscape.CellHeight; - seY2.MaxValue := ResMan.Landscape.CellHeight; - - vstArea.NodeDataSize := SizeOf(TRect); - vstRegions.NodeDataSize := SizeOf(TRegionInfo); - - FTempRegionNode := nil; - - frmRadarMap.Dependencies.Add(pbArea); - frmMain.RegisterAccessChangedListener(@OnAccessChanged); - - AssignAdminPacketHandler($08, TPacketHandler.Create(0, @OnModifyRegionPacket)); - AssignAdminPacketHandler($09, TPacketHandler.Create(0, @OnDeleteRegionPacket)); - AssignAdminPacketHandler($0A, TPacketHandler.Create(0, @OnListRegionsPacket)); - - dmNetwork.Send(TRequestRegionListPacket.Create); -end; - -procedure TfrmRegionControl.FormDestroy(Sender: TObject); -begin - frmRadarMap.Dependencies.Remove(pbArea); - FreeAndNil(AdminPacketHandlers[$08]); - FreeAndNil(AdminPacketHandlers[$09]); - FreeAndNil(AdminPacketHandlers[$0A]); -end; - -procedure TfrmRegionControl.FormShow(Sender: TObject); -begin - SetWindowParent(Handle, frmMain.Handle); - btnSave.Enabled := False; //no changes yet -end; - -procedure TfrmRegionControl.btnSaveClick(Sender: TObject); -var - regionNode: PVirtualNode; - regionInfo: PRegionInfo; - areaNode: PVirtualNode; - areaInfo: PRect; -begin - btnSave.Enabled := False; - - //Refresh the current region - if FTempRegionNode <> nil then - regionNode := FTempRegionNode - else - regionNode := vstRegions.GetFirstSelected; - if regionNode <> nil then - begin - regionInfo := vstRegions.GetNodeData(regionNode); - regionInfo^.Areas.Clear; - areaNode := vstArea.GetFirst; - while areaNode <> nil do - begin - areaInfo := vstArea.GetNodeData(areaNode); - regionInfo^.Areas.Add(areaInfo^.Left, areaInfo^.Top, areaInfo^.Right, - areaInfo^.Bottom); - areaNode := vstArea.GetNext(areaNode); - end; - - //Send the modified values - dmNetwork.Send(TModifyRegionPacket.Create(regionInfo^)); - end; - - //Clear the selection - vstRegions.ClearSelection; - - FTempRegionNode := nil; -end; - -procedure TfrmRegionControl.mnuAddRegionClick(Sender: TObject); -var - regionName: string; - regionInfo: PRegionInfo; -begin - regionName := ''; - if InputQuery('New Region', 'Enter the name for the new region:', regionName) then - begin - CheckUnsaved; - - if FindRegion(regionName) = nil then - begin - FTempRegionNode := vstRegions.AddChild(nil); - regionInfo := vstRegions.GetNodeData(FTempRegionNode); - regionInfo^.Name := regionName; - regionInfo^.Areas := TRectList.Create; - vstRegions.ClearSelection; - vstRegions.Selected[FTempRegionNode] := True; - btnSave.Enabled := True; - end else - begin - MessageDlg('New Region', 'The region could not be added. A region with ' + - 'that name already exists.', mtError, [mbOK], 0); - end; - end; -end; - -procedure TfrmRegionControl.FormClose(Sender: TObject; - var CloseAction: TCloseAction); -begin - CheckUnsaved; -end; - -procedure TfrmRegionControl.btnGrab1Click(Sender: TObject); -begin - FSelectFirst := (Sender = btnGrab1); - frmMain.RegisterSelectionListener(@TileSelected); - FOldWindowState := WindowState; - WindowState := wsMinimized; - frmMain.SwitchToSelection; -end; - -procedure TfrmRegionControl.mnuDeleteRegionClick(Sender: TObject); -var - regionNode: PVirtualNode; - regionInfo: PRegionInfo; -begin - regionNode := vstRegions.GetFirstSelected; - if (regionNode <> nil) and (MessageDlg('Delete Region', 'Are you sure, you ' + - 'want to delete the selected region?', mtConfirmation, [mbYes, mbNo], 0) = mrYes) then - begin - regionInfo := vstRegions.GetNodeData(regionNode); - dmNetwork.Send(TDeleteRegionPacket.Create(regionInfo^.Name)); - vstRegions.Selected[regionNode] := False; - end; -end; - -procedure TfrmRegionControl.btnAddAreaClick(Sender: TObject); -var - node: PVirtualNode; - areaInfo: PRect; -begin - node := vstArea.AddChild(nil); - areaInfo := vstArea.GetNodeData(node); - areaInfo^.Left := 0; - areaInfo^.Top := 0; - areaInfo^.Right := 0; - areaInfo^.Bottom := 0; - vstArea.ClearSelection; - vstArea.Selected[node] := True; - vstArea.FocusedNode := node; - - btnSave.Enabled := True; //possible change to be saved -end; - -procedure TfrmRegionControl.btnClearAreaClick(Sender: TObject); -begin - vstArea.Clear; - vstAreaChange(vstArea, nil); -end; - -procedure TfrmRegionControl.btnCloseClick(Sender: TObject); -begin - Close; -end; - -procedure TfrmRegionControl.btnDeleteAreaClick(Sender: TObject); -begin - vstArea.DeleteSelectedNodes; - vstAreaChange(vstArea, nil); - - btnSave.Enabled := True; //possible change to be saved -end; - -procedure TfrmRegionControl.pbAreaMouseDown(Sender: TObject; - Button: TMouseButton; Shift: TShiftState; X, Y: Integer); -var - areaNode, match: PVirtualNode; - areaInfo: PRect; - p: TPoint; -begin - if vstRegions.GetFirstSelected = nil then Exit; - - FAreaMove := []; - p := Point(X * 8, Y * 8); - match := nil; - areaNode := vstArea.GetFirst; - while areaNode <> nil do //find the last matching area - begin - areaInfo := vstArea.GetNodeData(areaNode); - if PtInRect(areaInfo^, p) then - match := areaNode; - areaNode := vstArea.GetNext(areaNode); - end; - if match <> nil then - begin - areaInfo := vstArea.GetNodeData(match); - if p.x - areaInfo^.Left <= 64 then Include(FAreaMove, amLeft); - if p.y - areaInfo^.Top <= 64 then Include(FAreaMove, amTop); - if areaInfo^.Right - p.x <= 64 then Include(FAreaMove, amRight); - if areaInfo^.Bottom - p.y <= 64 then Include(FAreaMove, amBottom); - if FAreaMove = [] then - FAreaMove := [amLeft, amTop, amRight, amBottom]; - end else - begin - match := vstArea.AddChild(nil); - areaInfo := vstArea.GetNodeData(match); - areaInfo^.Left := p.x; - areaInfo^.Top := p.y; - areaInfo^.Right := p.x; - areaInfo^.Bottom := p.y; - pbArea.Repaint; - FAreaMove := [amRight, amBottom]; - end; - vstArea.ClearSelection; - vstArea.Selected[match] := True; - FLastX := X; - FLastY := Y; -end; - -procedure TfrmRegionControl.pbAreaMouseMove(Sender: TObject; - Shift: TShiftState; X, Y: Integer); -var - offsetX, offsetY: Integer; -begin - if (ssLeft in Shift) and (vstArea.GetFirstSelected <> nil) then - begin - offsetX := (X - FLastX) * 8; - offsetY := (Y - FLastY) * 8; - if amLeft in FAreaMove then seX1.Value := seX1.Value + offsetX; - if amRight in FAreaMove then seX2.Value := seX2.Value + offsetX; - if amTop in FAreaMove then seY1.Value := seY1.Value + offsetY; - if amBottom in FAreaMove then seY2.Value := seY2.Value + offsetY; - FLastX := X; - FLastY := Y; - seX1Change(nil); - end; -end; - -procedure TfrmRegionControl.pbAreaPaint(Sender: TObject); -var - node: PVirtualNode; - areaInfo: PRect; -begin - DisplayImage(pbArea.Canvas, 0, 0, frmRadarMap.Radar); - pbArea.Canvas.Pen.Color := clRed; - pbArea.Canvas.Brush.Color := clMaroon; - pbArea.Canvas.Brush.Style := bsFDiagonal; - node := vstArea.GetFirst; - while node <> nil do - begin - if vstArea.Selected[node] then - begin - pbArea.Canvas.Pen.Width := 2; - pbArea.Canvas.Pen.Style := psSolid; - end else - begin - pbArea.Canvas.Pen.Width := 1; - pbArea.Canvas.Pen.Style := psDot; - end; - areaInfo := vstArea.GetNodeData(node); - pbArea.Canvas.Rectangle(areaInfo^.Left div 8, areaInfo^.Top div 8, - areaInfo^.Right div 8 + 1, areaInfo^.Bottom div 8 + 1); - node := vstArea.GetNext(node); - end; -end; - -procedure TfrmRegionControl.seX1Change(Sender: TObject); -var - node: PVirtualNode; - areaInfo: PRect; -begin - node := vstArea.GetFirstSelected; - if node <> nil then - begin - areaInfo := vstArea.GetNodeData(node); - areaInfo^.Left := seX1.Value; - areaInfo^.Right := seX2.Value; - areaInfo^.Top := seY1.Value; - areaInfo^.Bottom := seY2.Value; - vstArea.InvalidateNode(node); - pbArea.Repaint; - - btnSave.Enabled := True; //possible change to be saved - end; -end; - -procedure TfrmRegionControl.vstAreaChange(Sender: TBaseVirtualTree; - Node: PVirtualNode); -var - areaInfo: PRect; - selected: Boolean; -begin - selected := (Node <> nil) and Sender.Selected[Node]; - btnDeleteArea.Enabled := selected; - lblX.Enabled := selected; - lblY.Enabled := selected; - seX1.Enabled := selected; - seX2.Enabled := selected; - seY1.Enabled := selected; - seY2.Enabled := selected; - btnGrab1.Enabled := selected; - btnGrab2.Enabled := selected; - if selected then - begin - areaInfo := Sender.GetNodeData(Node); - seX1.Value := areaInfo^.Left; - seX2.Value := areaInfo^.Right; - seY1.Value := areaInfo^.Top; - seY2.Value := areaInfo^.Bottom; - end; - pbArea.Repaint; -end; - -procedure TfrmRegionControl.vstAreaGetText(Sender: TBaseVirtualTree; - Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; - var CellText: UTF8String); -var - areaInfo: PRect; -begin - areaInfo := Sender.GetNodeData(Node); - CellText := Format('(%d, %d), (%d, %d)', [areaInfo^.Left, areaInfo^.Top, - areaInfo^.Right, areaInfo^.Bottom]); -end; - -procedure TfrmRegionControl.vstRegionsChange(Sender: TBaseVirtualTree; - Node: PVirtualNode); -var - i: Integer; - selected, areaNode: PVirtualNode; - regionInfo: PRegionInfo; - areaInfo: PRect; -begin - CheckUnsaved; - - vstArea.BeginUpdate; - vstArea.Clear; - selected := Sender.GetFirstSelected; - if selected <> nil then - begin - btnAddArea.Enabled := True; - btnClearArea.Enabled := True; - mnuDeleteRegion.Enabled := (selected <> FTempRegionNode); - btnDeleteRegion.Enabled := (selected <> FTempRegionNode); - - regionInfo := Sender.GetNodeData(selected); - for i := 0 to regionInfo^.Areas.Count - 1 do - begin - areaNode := vstArea.AddChild(nil); - areaInfo := vstArea.GetNodeData(areaNode); - with regionInfo^.Areas.Rects[i] do - begin - areaInfo^.Left := Left; - areaInfo^.Top := Top; - areaInfo^.Right := Right; - areaInfo^.Bottom := Bottom; - end; - end; - end else - begin - btnAddArea.Enabled := False; - btnDeleteArea.Enabled := False; - btnClearArea.Enabled := False; - mnuDeleteRegion.Enabled := False; - btnDeleteRegion.Enabled := False; - end; - vstArea.EndUpdate; - pbArea.Repaint; - - btnSave.Enabled := False; //no changes to be saved -end; - -procedure TfrmRegionControl.vstRegionsFreeNode(Sender: TBaseVirtualTree; - Node: PVirtualNode); -var - regionInfo: PRegionInfo; -begin - regionInfo := Sender.GetNodeData(Node); - regionInfo^.Name := ''; - if regionInfo^.Areas <> nil then FreeAndNil(regionInfo^.Areas); -end; - -procedure TfrmRegionControl.vstRegionsGetText(Sender: TBaseVirtualTree; - Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; - var CellText: UTF8String); -var - regionInfo: PRegionInfo; -begin - regionInfo := Sender.GetNodeData(Node); - CellText := UTF8Encode(regionInfo^.Name); -end; - -function TfrmRegionControl.FindRegion(AName: string): PVirtualNode; -var - regionInfo: PRegionInfo; - found: Boolean; -begin - found := False; - Result := vstRegions.GetFirst; - while (Result <> nil) and (not found) do - begin - regionInfo := vstRegions.GetNodeData(Result); - if regionInfo^.Name = AName then - found := True - else - Result := vstRegions.GetNext(Result); - end; -end; - -procedure TfrmRegionControl.CheckUnsaved; -begin - if btnSave.Enabled then - begin - if MessageDlg('Unsaved changes', 'There are unsaved ' + - 'changes.' + #13#10+#13#10+ 'Do you want to save them now?', - mtConfirmation, [mbYes, mbNo], 0) = mrYes then - begin - btnSaveClick(nil); - end else if FTempRegionNode <> nil then - begin - btnSave.Enabled := False; - vstRegions.DeleteNode(FTempRegionNode); - FTempRegionNode := nil; - end; - end; -end; - -procedure TfrmRegionControl.OnModifyRegionPacket(ABuffer: TEnhancedMemoryStream); -var - regionName: string; - regionNode: PVirtualNode; - regionInfo: PRegionInfo; - areaCount: Byte; - i: Integer; - x1, y1, x2, y2: Word; -begin - ABuffer.ReadByte; //status, not used yet - - //TODO : Ask user how to proceed, if the added/modified packet conflicts with the currently edited region - - regionName := ABuffer.ReadStringNull; - regionNode := FindRegion(regionName); - if regionNode = nil then - begin - regionNode := vstRegions.AddChild(nil); - regionInfo := vstRegions.GetNodeData(regionNode); - regionInfo^.Name := regionName; - regionInfo^.Areas := TRectList.Create; - end else - begin - regionInfo := vstRegions.GetNodeData(regionNode); - regionInfo^.Areas.Clear; - end; - - areaCount := ABuffer.ReadByte; - for i := 0 to areaCount - 1 do - begin - x1 := ABuffer.ReadWord; - y1 := ABuffer.ReadWord; - x2 := ABuffer.ReadWord; - y2 := ABuffer.ReadWord; - regionInfo^.Areas.Add(x1, y1, x2, y2); - end; - - if vstRegions.Selected[regionNode] then - begin - btnSave.Enabled := False; - vstRegionsChange(vstRegions, regionNode); - end; - - if Assigned(FOnRegionModified) then - FOnRegionModified(regionInfo^); -end; - -procedure TfrmRegionControl.OnDeleteRegionPacket(ABuffer: TEnhancedMemoryStream); -var - regionName: string; - regionNode: PVirtualNode; -begin - ABuffer.ReadByte; //status, not used yet - regionName := ABuffer.ReadStringNull; - regionNode := FindRegion(regionName); - - //TODO : Ask user how to proceed, if the deleted packet conflicts with the currently edited region - - if regionNode <> nil then - vstRegions.DeleteNode(regionNode); - - if Assigned(FOnRegionDeleted) then - FOnRegionDeleted(regionName); -end; - -procedure TfrmRegionControl.OnListRegionsPacket(ABuffer: TEnhancedMemoryStream); -var - regionCount, areaCount: Byte; - i, j, x1, x2, y1, y2: Integer; - node: PVirtualNode; - regionInfo: PRegionInfo; -begin - vstRegions.BeginUpdate; - vstRegions.Clear; - regionCount := ABuffer.ReadByte; - for i := 0 to regionCount - 1 do - begin - node := vstRegions.AddChild(nil); - regionInfo := vstRegions.GetNodeData(node); - regionInfo^.Name := ABuffer.ReadStringNull; - regionInfo^.Areas := TRectList.Create; - areaCount := ABuffer.ReadByte; - for j := 0 to areaCount - 1 do - begin - x1 := ABuffer.ReadWord; - y1 := ABuffer.ReadWord; - x2 := ABuffer.ReadWord; - y2 := ABuffer.ReadWord; - regionInfo^.Areas.Add(x1, y1, x2, y2); - end; - end; - vstRegions.EndUpdate; - - if Assigned(FOnRegionList) then - FOnRegionList; -end; - -procedure TfrmRegionControl.OnAccessChanged(AAccessLevel: TAccessLevel); -begin - if AAccessLevel >= alAdministrator then - dmNetwork.Send(TRequestRegionListPacket.Create); -end; - -procedure TfrmRegionControl.TileSelected(AWorldItem: TWorldItem); -begin - if FSelectFirst then - begin - seX1.Value := AWorldItem.X; - seY1.Value := AWorldItem.Y; - end else - begin - seX2.Value := AWorldItem.X; - seY2.Value := AWorldItem.Y; - end; - frmMain.UnregisterSelectionListener(@TileSelected); - WindowState := FOldWindowState; - seX1Change(nil); -end; - -initialization - {$I UfrmRegionControl.lrs} - -end. +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2009 Andreas Schneider + *) +unit UfrmRegionControl; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, math, LResources, Forms, Controls, Graphics, Dialogs, + VirtualTrees, ExtCtrls, ImagingComponents, StdCtrls, Buttons, Spin, LCLIntf, + UEnhancedMemoryStream, Menus, URectList, UEnums, UWorldItem; + +type + TAreaMoveType = (amLeft, amTop, amRight, amBottom); + TAreaMove = set of TAreaMoveType; + + PRegionInfo = ^TRegionInfo; + TRegionInfo = record + Name: string; + Areas: TRectList; + end; + + TRegionModifiedEvent = procedure(ARegionInfo: TRegionInfo) of object; + TRegionDeletedEvent = procedure(ARegionName: string) of object; + TRegionListEvent = procedure of object; + + { TfrmRegionControl } + + TfrmRegionControl = class(TForm) + btnAddArea: TSpeedButton; + btnAddRegion: TSpeedButton; + btnClearArea: TSpeedButton; + btnClose: TButton; + btnDeleteArea: TSpeedButton; + btnDeleteRegion: TSpeedButton; + btnSave: TButton; + Label1: TLabel; + lblX: TLabel; + lblY: TLabel; + mnuAddRegion: TMenuItem; + mnuDeleteRegion: TMenuItem; + pbArea: TPaintBox; + pmRegions: TPopupMenu; + sbArea: TScrollBox; + seX1: TSpinEdit; + seX2: TSpinEdit; + seY1: TSpinEdit; + seY2: TSpinEdit; + btnGrab1: TSpeedButton; + btnGrab2: TSpeedButton; + spRegionsArea: TSplitter; + vstArea: TVirtualStringTree; + vstRegions: TVirtualStringTree; + procedure btnGrab1Click(Sender: TObject); + procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); + procedure mnuAddRegionClick(Sender: TObject); + procedure mnuDeleteRegionClick(Sender: TObject); + procedure btnAddAreaClick(Sender: TObject); + procedure btnClearAreaClick(Sender: TObject); + procedure btnCloseClick(Sender: TObject); + procedure btnDeleteAreaClick(Sender: TObject); + procedure btnSaveClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure pbAreaMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure pbAreaMouseMove(Sender: TObject; Shift: TShiftState; X, + Y: Integer); + procedure pbAreaPaint(Sender: TObject); + procedure seX1Change(Sender: TObject); + procedure vstAreaChange(Sender: TBaseVirtualTree; Node: PVirtualNode); + procedure vstAreaGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex; TextType: TVSTTextType; var CellText: UTF8String); + procedure vstRegionsChange(Sender: TBaseVirtualTree; Node: PVirtualNode); + procedure vstRegionsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); + procedure vstRegionsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex; TextType: TVSTTextType; var CellText: UTF8String); + protected + FLastX: Integer; + FLastY: Integer; + FAreaMove: TAreaMove; + FTempRegionNode: PVirtualNode; + FOnRegionModified: TRegionModifiedEvent; + FOnRegionDeleted: TRegionDeletedEvent; + FOnRegionList: TRegionListEvent; + FSelectFirst: Boolean; + FOldWindowState: TWindowState; + function FindRegion(AName: string): PVirtualNode; + procedure CheckUnsaved; + procedure OnModifyRegionPacket(ABuffer: TEnhancedMemoryStream); + procedure OnDeleteRegionPacket(ABuffer: TEnhancedMemoryStream); + procedure OnListRegionsPacket(ABuffer: TEnhancedMemoryStream); + procedure OnAccessChanged(AAccessLevel: TAccessLevel); + procedure TileSelected(AWorldItem: TWorldItem); + public + property OnRegionModified: TRegionModifiedEvent read FOnRegionModified write FOnRegionModified; + property OnRegionDeleted: TRegionDeletedEvent read FOnRegionDeleted write FOnRegionDeleted; + property OnRegionList: TRegionListEvent read FOnRegionList write FOnRegionList; + end; + +var + frmRegionControl: TfrmRegionControl; + +implementation + +uses + UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UGUIPlatformUtils, + UAdminHandling, UPacketHandlers; + +type + { TModifyRegionPacket } + + TModifyRegionPacket = class(TPacket) + constructor Create(ARegionInfo: TRegionInfo); + end; + + { TDeleteRegionPacket } + + TDeleteRegionPacket = class(TPacket) + constructor Create(AName: string); + end; + + { TRequestRegionListPacket } + + TRequestRegionListPacket = class(TPacket) + constructor Create; + end; + +{ TModifyRegionPacket } + +constructor TModifyRegionPacket.Create(ARegionInfo: TRegionInfo); +var + i: Integer; + count: Byte; + area: TRect; +begin + inherited Create($03, 0); //Admin Packet + FStream.WriteByte($08); //Admin PacketID + FStream.WriteStringNull(ARegionInfo.Name); + count := Min(ARegionInfo.Areas.Count, 256); + FStream.WriteByte(count); + for i := 0 to count - 1 do + begin + area := ARegionInfo.Areas.Rects[i]; + FStream.WriteWord(area.Left); + FStream.WriteWord(area.Top); + FStream.WriteWord(area.Right); + FStream.WriteWord(area.Bottom); + end; +end; + +{ TDeleteRegionPacket } + +constructor TDeleteRegionPacket.Create(AName: string); +begin + inherited Create($03, 0); //Admin Packet + FStream.WriteByte($09); //Admin PacketID + FStream.WriteStringNull(AName); +end; + +{ TRequestRegionListPacket } + +constructor TRequestRegionListPacket.Create; +begin + inherited Create($03, 0); //Admin Packet + FStream.WriteByte($0A); //Admin PacketID +end; + +{ TfrmRegionControl } + +procedure TfrmRegionControl.FormCreate(Sender: TObject); +begin + pbArea.Width := frmRadarMap.Radar.Width; + pbArea.Height := frmRadarMap.Radar.Height; + seX1.MaxValue := ResMan.Landscape.CellWidth; + seX2.MaxValue := ResMan.Landscape.CellWidth; + seY1.MaxValue := ResMan.Landscape.CellHeight; + seY2.MaxValue := ResMan.Landscape.CellHeight; + + vstArea.NodeDataSize := SizeOf(TRect); + vstRegions.NodeDataSize := SizeOf(TRegionInfo); + + FTempRegionNode := nil; + + frmRadarMap.Dependencies.Add(pbArea); + frmMain.RegisterAccessChangedListener(@OnAccessChanged); + + AssignAdminPacketHandler($08, TPacketHandler.Create(0, @OnModifyRegionPacket)); + AssignAdminPacketHandler($09, TPacketHandler.Create(0, @OnDeleteRegionPacket)); + AssignAdminPacketHandler($0A, TPacketHandler.Create(0, @OnListRegionsPacket)); + + dmNetwork.Send(TRequestRegionListPacket.Create); +end; + +procedure TfrmRegionControl.FormDestroy(Sender: TObject); +begin + frmRadarMap.Dependencies.Remove(pbArea); + FreeAndNil(AdminPacketHandlers[$08]); + FreeAndNil(AdminPacketHandlers[$09]); + FreeAndNil(AdminPacketHandlers[$0A]); +end; + +procedure TfrmRegionControl.FormShow(Sender: TObject); +begin + SetWindowParent(Handle, frmMain.Handle); + btnSave.Enabled := False; //no changes yet +end; + +procedure TfrmRegionControl.btnSaveClick(Sender: TObject); +var + regionNode: PVirtualNode; + regionInfo: PRegionInfo; + areaNode: PVirtualNode; + areaInfo: PRect; +begin + btnSave.Enabled := False; + + //Refresh the current region + if FTempRegionNode <> nil then + regionNode := FTempRegionNode + else + regionNode := vstRegions.GetFirstSelected; + if regionNode <> nil then + begin + regionInfo := vstRegions.GetNodeData(regionNode); + regionInfo^.Areas.Clear; + areaNode := vstArea.GetFirst; + while areaNode <> nil do + begin + areaInfo := vstArea.GetNodeData(areaNode); + regionInfo^.Areas.Add(areaInfo^.Left, areaInfo^.Top, areaInfo^.Right, + areaInfo^.Bottom); + areaNode := vstArea.GetNext(areaNode); + end; + + //Send the modified values + dmNetwork.Send(TModifyRegionPacket.Create(regionInfo^)); + end; + + //Clear the selection + vstRegions.ClearSelection; + + FTempRegionNode := nil; +end; + +procedure TfrmRegionControl.mnuAddRegionClick(Sender: TObject); +var + regionName: string; + regionInfo: PRegionInfo; +begin + regionName := ''; + if InputQuery('New Region', 'Enter the name for the new region:', regionName) then + begin + CheckUnsaved; + + if FindRegion(regionName) = nil then + begin + FTempRegionNode := vstRegions.AddChild(nil); + regionInfo := vstRegions.GetNodeData(FTempRegionNode); + regionInfo^.Name := regionName; + regionInfo^.Areas := TRectList.Create; + vstRegions.ClearSelection; + vstRegions.Selected[FTempRegionNode] := True; + btnSave.Enabled := True; + end else + begin + MessageDlg('New Region', 'The region could not be added. A region with ' + + 'that name already exists.', mtError, [mbOK], 0); + end; + end; +end; + +procedure TfrmRegionControl.FormClose(Sender: TObject; + var CloseAction: TCloseAction); +begin + CheckUnsaved; +end; + +procedure TfrmRegionControl.btnGrab1Click(Sender: TObject); +begin + FSelectFirst := (Sender = btnGrab1); + frmMain.RegisterSelectionListener(@TileSelected); + FOldWindowState := WindowState; + WindowState := wsMinimized; + frmMain.SwitchToSelection; +end; + +procedure TfrmRegionControl.mnuDeleteRegionClick(Sender: TObject); +var + regionNode: PVirtualNode; + regionInfo: PRegionInfo; +begin + regionNode := vstRegions.GetFirstSelected; + if (regionNode <> nil) and (MessageDlg('Delete Region', 'Are you sure, you ' + + 'want to delete the selected region?', mtConfirmation, [mbYes, mbNo], 0) = mrYes) then + begin + regionInfo := vstRegions.GetNodeData(regionNode); + dmNetwork.Send(TDeleteRegionPacket.Create(regionInfo^.Name)); + vstRegions.Selected[regionNode] := False; + end; +end; + +procedure TfrmRegionControl.btnAddAreaClick(Sender: TObject); +var + node: PVirtualNode; + areaInfo: PRect; +begin + node := vstArea.AddChild(nil); + areaInfo := vstArea.GetNodeData(node); + areaInfo^.Left := 0; + areaInfo^.Top := 0; + areaInfo^.Right := 0; + areaInfo^.Bottom := 0; + vstArea.ClearSelection; + vstArea.Selected[node] := True; + vstArea.FocusedNode := node; + + btnSave.Enabled := True; //possible change to be saved +end; + +procedure TfrmRegionControl.btnClearAreaClick(Sender: TObject); +begin + vstArea.Clear; + vstAreaChange(vstArea, nil); +end; + +procedure TfrmRegionControl.btnCloseClick(Sender: TObject); +begin + Close; +end; + +procedure TfrmRegionControl.btnDeleteAreaClick(Sender: TObject); +begin + vstArea.DeleteSelectedNodes; + vstAreaChange(vstArea, nil); + + btnSave.Enabled := True; //possible change to be saved +end; + +procedure TfrmRegionControl.pbAreaMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var + areaNode, match: PVirtualNode; + areaInfo: PRect; + p: TPoint; +begin + if vstRegions.GetFirstSelected = nil then Exit; + + FAreaMove := []; + p := Point(X * 8, Y * 8); + match := nil; + areaNode := vstArea.GetFirst; + while areaNode <> nil do //find the last matching area + begin + areaInfo := vstArea.GetNodeData(areaNode); + if PtInRect(areaInfo^, p) then + match := areaNode; + areaNode := vstArea.GetNext(areaNode); + end; + if match <> nil then + begin + areaInfo := vstArea.GetNodeData(match); + if p.x - areaInfo^.Left <= 64 then Include(FAreaMove, amLeft); + if p.y - areaInfo^.Top <= 64 then Include(FAreaMove, amTop); + if areaInfo^.Right - p.x <= 64 then Include(FAreaMove, amRight); + if areaInfo^.Bottom - p.y <= 64 then Include(FAreaMove, amBottom); + if FAreaMove = [] then + FAreaMove := [amLeft, amTop, amRight, amBottom]; + end else + begin + match := vstArea.AddChild(nil); + areaInfo := vstArea.GetNodeData(match); + areaInfo^.Left := p.x; + areaInfo^.Top := p.y; + areaInfo^.Right := p.x; + areaInfo^.Bottom := p.y; + pbArea.Repaint; + FAreaMove := [amRight, amBottom]; + end; + vstArea.ClearSelection; + vstArea.Selected[match] := True; + FLastX := X; + FLastY := Y; +end; + +procedure TfrmRegionControl.pbAreaMouseMove(Sender: TObject; + Shift: TShiftState; X, Y: Integer); +var + offsetX, offsetY: Integer; +begin + if (ssLeft in Shift) and (vstArea.GetFirstSelected <> nil) then + begin + offsetX := (X - FLastX) * 8; + offsetY := (Y - FLastY) * 8; + if amLeft in FAreaMove then seX1.Value := seX1.Value + offsetX; + if amRight in FAreaMove then seX2.Value := seX2.Value + offsetX; + if amTop in FAreaMove then seY1.Value := seY1.Value + offsetY; + if amBottom in FAreaMove then seY2.Value := seY2.Value + offsetY; + FLastX := X; + FLastY := Y; + seX1Change(nil); + end; +end; + +procedure TfrmRegionControl.pbAreaPaint(Sender: TObject); +var + node: PVirtualNode; + areaInfo: PRect; +begin + DisplayImage(pbArea.Canvas, 0, 0, frmRadarMap.Radar); + pbArea.Canvas.Pen.Color := clRed; + pbArea.Canvas.Brush.Color := clMaroon; + pbArea.Canvas.Brush.Style := bsFDiagonal; + node := vstArea.GetFirst; + while node <> nil do + begin + if vstArea.Selected[node] then + begin + pbArea.Canvas.Pen.Width := 2; + pbArea.Canvas.Pen.Style := psSolid; + end else + begin + pbArea.Canvas.Pen.Width := 1; + pbArea.Canvas.Pen.Style := psDot; + end; + areaInfo := vstArea.GetNodeData(node); + pbArea.Canvas.Rectangle(areaInfo^.Left div 8, areaInfo^.Top div 8, + areaInfo^.Right div 8 + 1, areaInfo^.Bottom div 8 + 1); + node := vstArea.GetNext(node); + end; +end; + +procedure TfrmRegionControl.seX1Change(Sender: TObject); +var + node: PVirtualNode; + areaInfo: PRect; +begin + node := vstArea.GetFirstSelected; + if node <> nil then + begin + areaInfo := vstArea.GetNodeData(node); + areaInfo^.Left := seX1.Value; + areaInfo^.Right := seX2.Value; + areaInfo^.Top := seY1.Value; + areaInfo^.Bottom := seY2.Value; + vstArea.InvalidateNode(node); + pbArea.Repaint; + + btnSave.Enabled := True; //possible change to be saved + end; +end; + +procedure TfrmRegionControl.vstAreaChange(Sender: TBaseVirtualTree; + Node: PVirtualNode); +var + areaInfo: PRect; + selected: Boolean; +begin + selected := (Node <> nil) and Sender.Selected[Node]; + btnDeleteArea.Enabled := selected; + lblX.Enabled := selected; + lblY.Enabled := selected; + seX1.Enabled := selected; + seX2.Enabled := selected; + seY1.Enabled := selected; + seY2.Enabled := selected; + btnGrab1.Enabled := selected; + btnGrab2.Enabled := selected; + if selected then + begin + areaInfo := Sender.GetNodeData(Node); + seX1.Value := areaInfo^.Left; + seX2.Value := areaInfo^.Right; + seY1.Value := areaInfo^.Top; + seY2.Value := areaInfo^.Bottom; + end; + pbArea.Repaint; +end; + +procedure TfrmRegionControl.vstAreaGetText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: UTF8String); +var + areaInfo: PRect; +begin + areaInfo := Sender.GetNodeData(Node); + CellText := Format('(%d, %d), (%d, %d)', [areaInfo^.Left, areaInfo^.Top, + areaInfo^.Right, areaInfo^.Bottom]); +end; + +procedure TfrmRegionControl.vstRegionsChange(Sender: TBaseVirtualTree; + Node: PVirtualNode); +var + i: Integer; + selected, areaNode: PVirtualNode; + regionInfo: PRegionInfo; + areaInfo: PRect; +begin + CheckUnsaved; + + vstArea.BeginUpdate; + vstArea.Clear; + selected := Sender.GetFirstSelected; + if selected <> nil then + begin + btnAddArea.Enabled := True; + btnClearArea.Enabled := True; + mnuDeleteRegion.Enabled := (selected <> FTempRegionNode); + btnDeleteRegion.Enabled := (selected <> FTempRegionNode); + + regionInfo := Sender.GetNodeData(selected); + for i := 0 to regionInfo^.Areas.Count - 1 do + begin + areaNode := vstArea.AddChild(nil); + areaInfo := vstArea.GetNodeData(areaNode); + with regionInfo^.Areas.Rects[i] do + begin + areaInfo^.Left := Left; + areaInfo^.Top := Top; + areaInfo^.Right := Right; + areaInfo^.Bottom := Bottom; + end; + end; + end else + begin + btnAddArea.Enabled := False; + btnDeleteArea.Enabled := False; + btnClearArea.Enabled := False; + mnuDeleteRegion.Enabled := False; + btnDeleteRegion.Enabled := False; + end; + vstArea.EndUpdate; + pbArea.Repaint; + + btnSave.Enabled := False; //no changes to be saved +end; + +procedure TfrmRegionControl.vstRegionsFreeNode(Sender: TBaseVirtualTree; + Node: PVirtualNode); +var + regionInfo: PRegionInfo; +begin + regionInfo := Sender.GetNodeData(Node); + regionInfo^.Name := ''; + if regionInfo^.Areas <> nil then FreeAndNil(regionInfo^.Areas); +end; + +procedure TfrmRegionControl.vstRegionsGetText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: UTF8String); +var + regionInfo: PRegionInfo; +begin + regionInfo := Sender.GetNodeData(Node); + CellText := UTF8Encode(regionInfo^.Name); +end; + +function TfrmRegionControl.FindRegion(AName: string): PVirtualNode; +var + regionInfo: PRegionInfo; + found: Boolean; +begin + found := False; + Result := vstRegions.GetFirst; + while (Result <> nil) and (not found) do + begin + regionInfo := vstRegions.GetNodeData(Result); + if regionInfo^.Name = AName then + found := True + else + Result := vstRegions.GetNext(Result); + end; +end; + +procedure TfrmRegionControl.CheckUnsaved; +begin + if btnSave.Enabled then + begin + if MessageDlg('Unsaved changes', 'There are unsaved ' + + 'changes.' + #13#10+#13#10+ 'Do you want to save them now?', + mtConfirmation, [mbYes, mbNo], 0) = mrYes then + begin + btnSaveClick(nil); + end else if FTempRegionNode <> nil then + begin + btnSave.Enabled := False; + vstRegions.DeleteNode(FTempRegionNode); + FTempRegionNode := nil; + end; + end; +end; + +procedure TfrmRegionControl.OnModifyRegionPacket(ABuffer: TEnhancedMemoryStream); +var + regionName: string; + regionNode: PVirtualNode; + regionInfo: PRegionInfo; + areaCount: Byte; + i: Integer; + x1, y1, x2, y2: Word; +begin + ABuffer.ReadByte; //status, not used yet + + //TODO : Ask user how to proceed, if the added/modified packet conflicts with the currently edited region + + regionName := ABuffer.ReadStringNull; + regionNode := FindRegion(regionName); + if regionNode = nil then + begin + regionNode := vstRegions.AddChild(nil); + regionInfo := vstRegions.GetNodeData(regionNode); + regionInfo^.Name := regionName; + regionInfo^.Areas := TRectList.Create; + end else + begin + regionInfo := vstRegions.GetNodeData(regionNode); + regionInfo^.Areas.Clear; + end; + + areaCount := ABuffer.ReadByte; + for i := 0 to areaCount - 1 do + begin + x1 := ABuffer.ReadWord; + y1 := ABuffer.ReadWord; + x2 := ABuffer.ReadWord; + y2 := ABuffer.ReadWord; + regionInfo^.Areas.Add(x1, y1, x2, y2); + end; + + if vstRegions.Selected[regionNode] then + begin + btnSave.Enabled := False; + vstRegionsChange(vstRegions, regionNode); + end; + + if Assigned(FOnRegionModified) then + FOnRegionModified(regionInfo^); +end; + +procedure TfrmRegionControl.OnDeleteRegionPacket(ABuffer: TEnhancedMemoryStream); +var + regionName: string; + regionNode: PVirtualNode; +begin + ABuffer.ReadByte; //status, not used yet + regionName := ABuffer.ReadStringNull; + regionNode := FindRegion(regionName); + + //TODO : Ask user how to proceed, if the deleted packet conflicts with the currently edited region + + if regionNode <> nil then + vstRegions.DeleteNode(regionNode); + + if Assigned(FOnRegionDeleted) then + FOnRegionDeleted(regionName); +end; + +procedure TfrmRegionControl.OnListRegionsPacket(ABuffer: TEnhancedMemoryStream); +var + regionCount, areaCount: Byte; + i, j, x1, x2, y1, y2: Integer; + node: PVirtualNode; + regionInfo: PRegionInfo; +begin + vstRegions.BeginUpdate; + vstRegions.Clear; + regionCount := ABuffer.ReadByte; + for i := 0 to regionCount - 1 do + begin + node := vstRegions.AddChild(nil); + regionInfo := vstRegions.GetNodeData(node); + regionInfo^.Name := ABuffer.ReadStringNull; + regionInfo^.Areas := TRectList.Create; + areaCount := ABuffer.ReadByte; + for j := 0 to areaCount - 1 do + begin + x1 := ABuffer.ReadWord; + y1 := ABuffer.ReadWord; + x2 := ABuffer.ReadWord; + y2 := ABuffer.ReadWord; + regionInfo^.Areas.Add(x1, y1, x2, y2); + end; + end; + vstRegions.EndUpdate; + + if Assigned(FOnRegionList) then + FOnRegionList; +end; + +procedure TfrmRegionControl.OnAccessChanged(AAccessLevel: TAccessLevel); +begin + if AAccessLevel >= alAdministrator then + dmNetwork.Send(TRequestRegionListPacket.Create); +end; + +procedure TfrmRegionControl.TileSelected(AWorldItem: TWorldItem); +begin + if FSelectFirst then + begin + seX1.Value := AWorldItem.X; + seY1.Value := AWorldItem.Y; + end else + begin + seX2.Value := AWorldItem.X; + seY2.Value := AWorldItem.Y; + end; + frmMain.UnregisterSelectionListener(@TileSelected); + WindowState := FOldWindowState; + seX1Change(nil); +end; + +initialization + {$I UfrmRegionControl.lrs} + +end. diff --git a/Imaging/JpegLib/imjcapimin.pas b/Imaging/JpegLib/imjcapimin.pas index 1f06195..8a82075 100644 --- a/Imaging/JpegLib/imjcapimin.pas +++ b/Imaging/JpegLib/imjcapimin.pas @@ -1,401 +1,401 @@ -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; +{$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. diff --git a/Imaging/JpegLib/imjcapistd.pas b/Imaging/JpegLib/imjcapistd.pas index 7883c6e..f9ae613 100644 --- a/Imaging/JpegLib/imjcapistd.pas +++ b/Imaging/JpegLib/imjcapistd.pas @@ -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. diff --git a/Imaging/JpegLib/imjccoefct.pas b/Imaging/JpegLib/imjccoefct.pas index 9d4c620..7dd97e5 100644 --- a/Imaging/JpegLib/imjccoefct.pas +++ b/Imaging/JpegLib/imjccoefct.pas @@ -1,521 +1,521 @@ -unit imjccoefct; - -{ This file contains the coefficient buffer controller for compression. - This controller is the top level of the JPEG compressor proper. - The coefficient buffer lies between forward-DCT and entropy encoding steps.} - -{ Original: jccoefct.c; Copyright (C) 1994-1997, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjerror, - imjdeferr, - imjutils, - imjpeglib; - -{ We use a full-image coefficient buffer when doing Huffman optimization, - and also for writing multiple-scan JPEG files. In all cases, the DCT - step is run during the first pass, and subsequent passes need only read - the buffered coefficients. } -{$ifdef ENTROPY_OPT_SUPPORTED} - {$define FULL_COEF_BUFFER_SUPPORTED} -{$else} - {$ifdef C_MULTISCAN_FILES_SUPPORTED} - {$define FULL_COEF_BUFFER_SUPPORTED} - {$endif} -{$endif} - -{ Initialize coefficient buffer controller. } - -{GLOBAL} -procedure jinit_c_coef_controller (cinfo : j_compress_ptr; - need_full_buffer : boolean); - -implementation - -{ Private buffer controller object } - -type - my_coef_ptr = ^my_coef_controller; - my_coef_controller = record - pub : jpeg_c_coef_controller; { public fields } - - iMCU_row_num : JDIMENSION; { iMCU row # within image } - mcu_ctr : JDIMENSION; { counts MCUs processed in current row } - MCU_vert_offset : int; { counts MCU rows within iMCU row } - MCU_rows_per_iMCU_row : int; { number of such rows needed } - - { For single-pass compression, it's sufficient to buffer just one MCU - (although this may prove a bit slow in practice). We allocate a - workspace of C_MAX_BLOCKS_IN_MCU coefficient blocks, and reuse it for each - MCU constructed and sent. (On 80x86, the workspace is FAR even though - it's not really very big; this is to keep the module interfaces unchanged - when a large coefficient buffer is necessary.) - In multi-pass modes, this array points to the current MCU's blocks - within the virtual arrays. } - - MCU_buffer : array[0..C_MAX_BLOCKS_IN_MCU-1] of JBLOCKROW; - - { In multi-pass modes, we need a virtual block array for each component. } - whole_image : array[0..MAX_COMPONENTS-1] of jvirt_barray_ptr; - end; - - -{ Forward declarations } -{METHODDEF} -function compress_data(cinfo : j_compress_ptr; - input_buf : JSAMPIMAGE) : boolean; forward; -{$ifdef FULL_COEF_BUFFER_SUPPORTED} -{METHODDEF} -function compress_first_pass(cinfo : j_compress_ptr; - input_buf : JSAMPIMAGE) : boolean; forward; -{METHODDEF} -function compress_output(cinfo : j_compress_ptr; - input_buf : JSAMPIMAGE) : boolean; forward; -{$endif} - - -{LOCAL} -procedure start_iMCU_row (cinfo : j_compress_ptr); -{ Reset within-iMCU-row counters for a new row } -var - coef : my_coef_ptr; -begin - coef := my_coef_ptr (cinfo^.coef); - - { In an interleaved scan, an MCU row is the same as an iMCU row. - In a noninterleaved scan, an iMCU row has v_samp_factor MCU rows. - But at the bottom of the image, process only what's left. } - if (cinfo^.comps_in_scan > 1) then - begin - coef^.MCU_rows_per_iMCU_row := 1; - end - else - begin - if (coef^.iMCU_row_num < (cinfo^.total_iMCU_rows-1)) then - coef^.MCU_rows_per_iMCU_row := cinfo^.cur_comp_info[0]^.v_samp_factor - else - coef^.MCU_rows_per_iMCU_row := cinfo^.cur_comp_info[0]^.last_row_height; - end; - - coef^.mcu_ctr := 0; - coef^.MCU_vert_offset := 0; -end; - - -{ Initialize for a processing pass. } - -{METHODDEF} -procedure start_pass_coef (cinfo : j_compress_ptr; - pass_mode : J_BUF_MODE); -var - coef : my_coef_ptr; -begin - coef := my_coef_ptr (cinfo^.coef); - - coef^.iMCU_row_num := 0; - start_iMCU_row(cinfo); - - case (pass_mode) of - JBUF_PASS_THRU: - begin - if (coef^.whole_image[0] <> NIL) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); - coef^.pub.compress_data := compress_data; - end; -{$ifdef FULL_COEF_BUFFER_SUPPORTED} - JBUF_SAVE_AND_PASS: - begin - if (coef^.whole_image[0] = NIL) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); - coef^.pub.compress_data := compress_first_pass; - end; - JBUF_CRANK_DEST: - begin - if (coef^.whole_image[0] = NIL) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); - coef^.pub.compress_data := compress_output; - end; -{$endif} - else - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); - end; -end; - - -{ Process some data in the single-pass case. - We process the equivalent of one fully interleaved MCU row ("iMCU" row) - per call, ie, v_samp_factor block rows for each component in the image. - Returns TRUE if the iMCU row is completed, FALSE if suspended. - - NB: input_buf contains a plane for each component in image, - which we index according to the component's SOF position. } - - -{METHODDEF} -function compress_data (cinfo : j_compress_ptr; - input_buf : JSAMPIMAGE) : boolean; -var - coef : my_coef_ptr; - MCU_col_num : JDIMENSION; { index of current MCU within row } - last_MCU_col : JDIMENSION; - last_iMCU_row : JDIMENSION; - blkn, bi, ci, yindex, yoffset, blockcnt : int; - ypos, xpos : JDIMENSION; - compptr : jpeg_component_info_ptr; -begin - coef := my_coef_ptr (cinfo^.coef); - last_MCU_col := cinfo^.MCUs_per_row - 1; - last_iMCU_row := cinfo^.total_iMCU_rows - 1; - - { Loop to write as much as one whole iMCU row } - for yoffset := coef^.MCU_vert_offset to pred(coef^.MCU_rows_per_iMCU_row) do - begin - for MCU_col_num := coef^.mcu_ctr to last_MCU_col do - begin - { Determine where data comes from in input_buf and do the DCT thing. - Each call on forward_DCT processes a horizontal row of DCT blocks - as wide as an MCU; we rely on having allocated the MCU_buffer[] blocks - sequentially. Dummy blocks at the right or bottom edge are filled in - specially. The data in them does not matter for image reconstruction, - so we fill them with values that will encode to the smallest amount of - data, viz: all zeroes in the AC entries, DC entries equal to previous - block's DC value. (Thanks to Thomas Kinsman for this idea.) } - - blkn := 0; - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - if (MCU_col_num < last_MCU_col) then - blockcnt := compptr^.MCU_width - else - blockcnt := compptr^.last_col_width; - xpos := MCU_col_num * JDIMENSION(compptr^.MCU_sample_width); - ypos := yoffset * DCTSIZE; { ypos = (yoffset+yindex) * DCTSIZE } - for yindex := 0 to pred(compptr^.MCU_height) do - begin - if (coef^.iMCU_row_num < last_iMCU_row) or - (yoffset+yindex < compptr^.last_row_height) then - begin - cinfo^.fdct^.forward_DCT (cinfo, compptr, - input_buf^[compptr^.component_index], - coef^.MCU_buffer[blkn], - ypos, xpos, JDIMENSION (blockcnt)); - - if (blockcnt < compptr^.MCU_width) then - begin - { Create some dummy blocks at the right edge of the image. } - jzero_far({FAR}pointer(coef^.MCU_buffer[blkn + blockcnt]), - (compptr^.MCU_width - blockcnt) * SIZEOF(JBLOCK)); - for bi := blockcnt to pred(compptr^.MCU_width) do - begin - coef^.MCU_buffer[blkn+bi]^[0][0] := coef^.MCU_buffer[blkn+bi-1]^[0][0]; - end; - end; - end - else - begin - { Create a row of dummy blocks at the bottom of the image. } - jzero_far({FAR}pointer(coef^.MCU_buffer[blkn]), - compptr^.MCU_width * SIZEOF(JBLOCK)); - for bi := 0 to pred(compptr^.MCU_width) do - begin - coef^.MCU_buffer[blkn+bi]^[0][0] := coef^.MCU_buffer[blkn-1]^[0][0]; - end; - end; - Inc(blkn, compptr^.MCU_width); - Inc(ypos, DCTSIZE); - end; - end; - { Try to write the MCU. In event of a suspension failure, we will - re-DCT the MCU on restart (a bit inefficient, could be fixed...) } - - if (not cinfo^.entropy^.encode_mcu (cinfo, JBLOCKARRAY(@coef^.MCU_buffer)^)) then - begin - { Suspension forced; update state counters and exit } - coef^.MCU_vert_offset := yoffset; - coef^.mcu_ctr := MCU_col_num; - compress_data := FALSE; - exit; - end; - end; - { Completed an MCU row, but perhaps not an iMCU row } - coef^.mcu_ctr := 0; - end; - { Completed the iMCU row, advance counters for next one } - Inc(coef^.iMCU_row_num); - start_iMCU_row(cinfo); - compress_data := TRUE; -end; - - -{$ifdef FULL_COEF_BUFFER_SUPPORTED} - -{ Process some data in the first pass of a multi-pass case. - We process the equivalent of one fully interleaved MCU row ("iMCU" row) - per call, ie, v_samp_factor block rows for each component in the image. - This amount of data is read from the source buffer, DCT'd and quantized, - and saved into the virtual arrays. We also generate suitable dummy blocks - as needed at the right and lower edges. (The dummy blocks are constructed - in the virtual arrays, which have been padded appropriately.) This makes - it possible for subsequent passes not to worry about real vs. dummy blocks. - - We must also emit the data to the entropy encoder. This is conveniently - done by calling compress_output() after we've loaded the current strip - of the virtual arrays. - - NB: input_buf contains a plane for each component in image. All - components are DCT'd and loaded into the virtual arrays in this pass. - However, it may be that only a subset of the components are emitted to - the entropy encoder during this first pass; be careful about looking - at the scan-dependent variables (MCU dimensions, etc). } - -{METHODDEF} -function compress_first_pass (cinfo : j_compress_ptr; - input_buf : JSAMPIMAGE) : boolean; -var - coef : my_coef_ptr; - last_iMCU_row : JDIMENSION; - blocks_across, MCUs_across, MCUindex : JDIMENSION; - bi, ci, h_samp_factor, block_row, block_rows, ndummy : int; - lastDC : JCOEF; - compptr : jpeg_component_info_ptr; - buffer : JBLOCKARRAY; - thisblockrow, lastblockrow : JBLOCKROW; -begin - coef := my_coef_ptr (cinfo^.coef); - last_iMCU_row := cinfo^.total_iMCU_rows - 1; - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - { Align the virtual buffer for this component. } - buffer := cinfo^.mem^.access_virt_barray - (j_common_ptr(cinfo), coef^.whole_image[ci], - coef^.iMCU_row_num * JDIMENSION(compptr^.v_samp_factor), - JDIMENSION (compptr^.v_samp_factor), TRUE); - { Count non-dummy DCT block rows in this iMCU row. } - if (coef^.iMCU_row_num < last_iMCU_row) then - block_rows := compptr^.v_samp_factor - else - begin - { NB: can't use last_row_height here, since may not be set! } - block_rows := int (compptr^.height_in_blocks) mod compptr^.v_samp_factor; - if (block_rows = 0) then - block_rows := compptr^.v_samp_factor; - end; - blocks_across := compptr^.width_in_blocks; - h_samp_factor := compptr^.h_samp_factor; - { Count number of dummy blocks to be added at the right margin. } - ndummy := int (blocks_across) mod h_samp_factor; - if (ndummy > 0) then - ndummy := h_samp_factor - ndummy; - { Perform DCT for all non-dummy blocks in this iMCU row. Each call - on forward_DCT processes a complete horizontal row of DCT blocks. } - - for block_row := 0 to pred(block_rows) do - begin - thisblockrow := buffer^[block_row]; - cinfo^.fdct^.forward_DCT (cinfo, compptr, - input_buf^[ci], - thisblockrow, - JDIMENSION (block_row * DCTSIZE), - JDIMENSION (0), - blocks_across); - if (ndummy > 0) then - begin - { Create dummy blocks at the right edge of the image. } - Inc(JBLOCK_PTR(thisblockrow), blocks_across); { => first dummy block } - jzero_far({FAR}pointer(thisblockrow), ndummy * SIZEOF(JBLOCK)); - {lastDC := thisblockrow^[-1][0];} - { work around Range Checking } - Dec(JBLOCK_PTR(thisblockrow)); - lastDC := thisblockrow^[0][0]; - Inc(JBLOCK_PTR(thisblockrow)); - - for bi := 0 to pred(ndummy) do - begin - thisblockrow^[bi][0] := lastDC; - end; - end; - end; - { If at end of image, create dummy block rows as needed. - The tricky part here is that within each MCU, we want the DC values - of the dummy blocks to match the last real block's DC value. - This squeezes a few more bytes out of the resulting file... } - - if (coef^.iMCU_row_num = last_iMCU_row) then - begin - Inc(blocks_across, ndummy); { include lower right corner } - MCUs_across := blocks_across div JDIMENSION(h_samp_factor); - for block_row := block_rows to pred(compptr^.v_samp_factor) do - begin - thisblockrow := buffer^[block_row]; - lastblockrow := buffer^[block_row-1]; - jzero_far({FAR} pointer(thisblockrow), - size_t(blocks_across * SIZEOF(JBLOCK))); - for MCUindex := 0 to pred(MCUs_across) do - begin - lastDC := lastblockrow^[h_samp_factor-1][0]; - for bi := 0 to pred(h_samp_factor) do - begin - thisblockrow^[bi][0] := lastDC; - end; - Inc(JBLOCK_PTR(thisblockrow), h_samp_factor); { advance to next MCU in row } - Inc(JBLOCK_PTR(lastblockrow), h_samp_factor); - end; - end; - end; - Inc(compptr); - end; - { NB: compress_output will increment iMCU_row_num if successful. - A suspension return will result in redoing all the work above next time.} - - - { Emit data to the entropy encoder, sharing code with subsequent passes } - compress_first_pass := compress_output(cinfo, input_buf); -end; - - -{ Process some data in subsequent passes of a multi-pass case. - We process the equivalent of one fully interleaved MCU row ("iMCU" row) - per call, ie, v_samp_factor block rows for each component in the scan. - The data is obtained from the virtual arrays and fed to the entropy coder. - Returns TRUE if the iMCU row is completed, FALSE if suspended. - - NB: input_buf is ignored; it is likely to be a NIL pointer. } - -{METHODDEF} -function compress_output (cinfo : j_compress_ptr; - input_buf : JSAMPIMAGE) : boolean; -var - coef : my_coef_ptr; - MCU_col_num : JDIMENSION; { index of current MCU within row } - blkn, ci, xindex, yindex, yoffset : int; - start_col : JDIMENSION; - buffer : array[0..MAX_COMPS_IN_SCAN-1] of JBLOCKARRAY; - buffer_ptr : JBLOCKROW; - compptr : jpeg_component_info_ptr; -begin - coef := my_coef_ptr (cinfo^.coef); - - { Align the virtual buffers for the components used in this scan. - NB: during first pass, this is safe only because the buffers will - already be aligned properly, so jmemmgr.c won't need to do any I/O. } - - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - buffer[ci] := cinfo^.mem^.access_virt_barray ( - j_common_ptr(cinfo), coef^.whole_image[compptr^.component_index], - coef^.iMCU_row_num * JDIMENSION(compptr^.v_samp_factor), - JDIMENSION (compptr^.v_samp_factor), FALSE); - end; - - { Loop to process one whole iMCU row } - for yoffset := coef^.MCU_vert_offset to pred(coef^.MCU_rows_per_iMCU_row) do - begin - for MCU_col_num := coef^.mcu_ctr to pred(cinfo^.MCUs_per_row) do - begin - { Construct list of pointers to DCT blocks belonging to this MCU } - blkn := 0; { index of current DCT block within MCU } - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - start_col := MCU_col_num * JDIMENSION(compptr^.MCU_width); - for yindex := 0 to pred(compptr^.MCU_height) do - begin - buffer_ptr := JBLOCKROW(@ buffer[ci]^[yindex+yoffset]^[start_col]); - for xindex := 0 to pred(compptr^.MCU_width) do - begin - coef^.MCU_buffer[blkn] := buffer_ptr; - Inc(blkn); - Inc(JBLOCK_PTR(buffer_ptr)); - end; - end; - end; - { Try to write the MCU. } - if (not cinfo^.entropy^.encode_mcu (cinfo, coef^.MCU_buffer)) then - begin - { Suspension forced; update state counters and exit } - coef^.MCU_vert_offset := yoffset; - coef^.mcu_ctr := MCU_col_num; - compress_output := FALSE; - exit; - end; - end; - { Completed an MCU row, but perhaps not an iMCU row } - coef^.mcu_ctr := 0; - end; - { Completed the iMCU row, advance counters for next one } - Inc(coef^.iMCU_row_num); - start_iMCU_row(cinfo); - compress_output := TRUE; -end; - -{$endif} { FULL_COEF_BUFFER_SUPPORTED } - - -{ Initialize coefficient buffer controller. } - -{GLOBAL} -procedure jinit_c_coef_controller (cinfo : j_compress_ptr; - need_full_buffer : boolean); -var - coef : my_coef_ptr; -var - buffer : JBLOCKROW; - i : int; -var - ci : int; - compptr : jpeg_component_info_ptr; -begin - coef := my_coef_ptr ( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_coef_controller)) ); - cinfo^.coef := jpeg_c_coef_controller_ptr(coef); - coef^.pub.start_pass := start_pass_coef; - - { Create the coefficient buffer. } - if (need_full_buffer) then - begin -{$ifdef FULL_COEF_BUFFER_SUPPORTED} - { Allocate a full-image virtual array for each component, } - { padded to a multiple of samp_factor DCT blocks in each direction. } - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - coef^.whole_image[ci] := cinfo^.mem^.request_virt_barray - (j_common_ptr(cinfo), JPOOL_IMAGE, FALSE, - JDIMENSION (jround_up( long (compptr^.width_in_blocks), - long (compptr^.h_samp_factor) )), - JDIMENSION (jround_up(long (compptr^.height_in_blocks), - long (compptr^.v_samp_factor))), - JDIMENSION (compptr^.v_samp_factor)); - Inc(compptr); - end; -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); -{$endif} - end - else - begin - { We only need a single-MCU buffer. } - buffer := JBLOCKROW ( - cinfo^.mem^.alloc_large (j_common_ptr(cinfo), JPOOL_IMAGE, - C_MAX_BLOCKS_IN_MCU * SIZEOF(JBLOCK)) ); - for i := 0 to pred(C_MAX_BLOCKS_IN_MCU) do - begin - coef^.MCU_buffer[i] := JBLOCKROW(@ buffer^[i]); - end; - coef^.whole_image[0] := NIL; { flag for no virtual arrays } - end; -end; - -end. +unit imjccoefct; + +{ This file contains the coefficient buffer controller for compression. + This controller is the top level of the JPEG compressor proper. + The coefficient buffer lies between forward-DCT and entropy encoding steps.} + +{ Original: jccoefct.c; Copyright (C) 1994-1997, Thomas G. Lane. } + +interface + +{$I imjconfig.inc} + +uses + imjmorecfg, + imjinclude, + imjerror, + imjdeferr, + imjutils, + imjpeglib; + +{ We use a full-image coefficient buffer when doing Huffman optimization, + and also for writing multiple-scan JPEG files. In all cases, the DCT + step is run during the first pass, and subsequent passes need only read + the buffered coefficients. } +{$ifdef ENTROPY_OPT_SUPPORTED} + {$define FULL_COEF_BUFFER_SUPPORTED} +{$else} + {$ifdef C_MULTISCAN_FILES_SUPPORTED} + {$define FULL_COEF_BUFFER_SUPPORTED} + {$endif} +{$endif} + +{ Initialize coefficient buffer controller. } + +{GLOBAL} +procedure jinit_c_coef_controller (cinfo : j_compress_ptr; + need_full_buffer : boolean); + +implementation + +{ Private buffer controller object } + +type + my_coef_ptr = ^my_coef_controller; + my_coef_controller = record + pub : jpeg_c_coef_controller; { public fields } + + iMCU_row_num : JDIMENSION; { iMCU row # within image } + mcu_ctr : JDIMENSION; { counts MCUs processed in current row } + MCU_vert_offset : int; { counts MCU rows within iMCU row } + MCU_rows_per_iMCU_row : int; { number of such rows needed } + + { For single-pass compression, it's sufficient to buffer just one MCU + (although this may prove a bit slow in practice). We allocate a + workspace of C_MAX_BLOCKS_IN_MCU coefficient blocks, and reuse it for each + MCU constructed and sent. (On 80x86, the workspace is FAR even though + it's not really very big; this is to keep the module interfaces unchanged + when a large coefficient buffer is necessary.) + In multi-pass modes, this array points to the current MCU's blocks + within the virtual arrays. } + + MCU_buffer : array[0..C_MAX_BLOCKS_IN_MCU-1] of JBLOCKROW; + + { In multi-pass modes, we need a virtual block array for each component. } + whole_image : array[0..MAX_COMPONENTS-1] of jvirt_barray_ptr; + end; + + +{ Forward declarations } +{METHODDEF} +function compress_data(cinfo : j_compress_ptr; + input_buf : JSAMPIMAGE) : boolean; forward; +{$ifdef FULL_COEF_BUFFER_SUPPORTED} +{METHODDEF} +function compress_first_pass(cinfo : j_compress_ptr; + input_buf : JSAMPIMAGE) : boolean; forward; +{METHODDEF} +function compress_output(cinfo : j_compress_ptr; + input_buf : JSAMPIMAGE) : boolean; forward; +{$endif} + + +{LOCAL} +procedure start_iMCU_row (cinfo : j_compress_ptr); +{ Reset within-iMCU-row counters for a new row } +var + coef : my_coef_ptr; +begin + coef := my_coef_ptr (cinfo^.coef); + + { In an interleaved scan, an MCU row is the same as an iMCU row. + In a noninterleaved scan, an iMCU row has v_samp_factor MCU rows. + But at the bottom of the image, process only what's left. } + if (cinfo^.comps_in_scan > 1) then + begin + coef^.MCU_rows_per_iMCU_row := 1; + end + else + begin + if (coef^.iMCU_row_num < (cinfo^.total_iMCU_rows-1)) then + coef^.MCU_rows_per_iMCU_row := cinfo^.cur_comp_info[0]^.v_samp_factor + else + coef^.MCU_rows_per_iMCU_row := cinfo^.cur_comp_info[0]^.last_row_height; + end; + + coef^.mcu_ctr := 0; + coef^.MCU_vert_offset := 0; +end; + + +{ Initialize for a processing pass. } + +{METHODDEF} +procedure start_pass_coef (cinfo : j_compress_ptr; + pass_mode : J_BUF_MODE); +var + coef : my_coef_ptr; +begin + coef := my_coef_ptr (cinfo^.coef); + + coef^.iMCU_row_num := 0; + start_iMCU_row(cinfo); + + case (pass_mode) of + JBUF_PASS_THRU: + begin + if (coef^.whole_image[0] <> NIL) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); + coef^.pub.compress_data := compress_data; + end; +{$ifdef FULL_COEF_BUFFER_SUPPORTED} + JBUF_SAVE_AND_PASS: + begin + if (coef^.whole_image[0] = NIL) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); + coef^.pub.compress_data := compress_first_pass; + end; + JBUF_CRANK_DEST: + begin + if (coef^.whole_image[0] = NIL) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); + coef^.pub.compress_data := compress_output; + end; +{$endif} + else + ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); + end; +end; + + +{ Process some data in the single-pass case. + We process the equivalent of one fully interleaved MCU row ("iMCU" row) + per call, ie, v_samp_factor block rows for each component in the image. + Returns TRUE if the iMCU row is completed, FALSE if suspended. + + NB: input_buf contains a plane for each component in image, + which we index according to the component's SOF position. } + + +{METHODDEF} +function compress_data (cinfo : j_compress_ptr; + input_buf : JSAMPIMAGE) : boolean; +var + coef : my_coef_ptr; + MCU_col_num : JDIMENSION; { index of current MCU within row } + last_MCU_col : JDIMENSION; + last_iMCU_row : JDIMENSION; + blkn, bi, ci, yindex, yoffset, blockcnt : int; + ypos, xpos : JDIMENSION; + compptr : jpeg_component_info_ptr; +begin + coef := my_coef_ptr (cinfo^.coef); + last_MCU_col := cinfo^.MCUs_per_row - 1; + last_iMCU_row := cinfo^.total_iMCU_rows - 1; + + { Loop to write as much as one whole iMCU row } + for yoffset := coef^.MCU_vert_offset to pred(coef^.MCU_rows_per_iMCU_row) do + begin + for MCU_col_num := coef^.mcu_ctr to last_MCU_col do + begin + { Determine where data comes from in input_buf and do the DCT thing. + Each call on forward_DCT processes a horizontal row of DCT blocks + as wide as an MCU; we rely on having allocated the MCU_buffer[] blocks + sequentially. Dummy blocks at the right or bottom edge are filled in + specially. The data in them does not matter for image reconstruction, + so we fill them with values that will encode to the smallest amount of + data, viz: all zeroes in the AC entries, DC entries equal to previous + block's DC value. (Thanks to Thomas Kinsman for this idea.) } + + blkn := 0; + for ci := 0 to pred(cinfo^.comps_in_scan) do + begin + compptr := cinfo^.cur_comp_info[ci]; + if (MCU_col_num < last_MCU_col) then + blockcnt := compptr^.MCU_width + else + blockcnt := compptr^.last_col_width; + xpos := MCU_col_num * JDIMENSION(compptr^.MCU_sample_width); + ypos := yoffset * DCTSIZE; { ypos = (yoffset+yindex) * DCTSIZE } + for yindex := 0 to pred(compptr^.MCU_height) do + begin + if (coef^.iMCU_row_num < last_iMCU_row) or + (yoffset+yindex < compptr^.last_row_height) then + begin + cinfo^.fdct^.forward_DCT (cinfo, compptr, + input_buf^[compptr^.component_index], + coef^.MCU_buffer[blkn], + ypos, xpos, JDIMENSION (blockcnt)); + + if (blockcnt < compptr^.MCU_width) then + begin + { Create some dummy blocks at the right edge of the image. } + jzero_far({FAR}pointer(coef^.MCU_buffer[blkn + blockcnt]), + (compptr^.MCU_width - blockcnt) * SIZEOF(JBLOCK)); + for bi := blockcnt to pred(compptr^.MCU_width) do + begin + coef^.MCU_buffer[blkn+bi]^[0][0] := coef^.MCU_buffer[blkn+bi-1]^[0][0]; + end; + end; + end + else + begin + { Create a row of dummy blocks at the bottom of the image. } + jzero_far({FAR}pointer(coef^.MCU_buffer[blkn]), + compptr^.MCU_width * SIZEOF(JBLOCK)); + for bi := 0 to pred(compptr^.MCU_width) do + begin + coef^.MCU_buffer[blkn+bi]^[0][0] := coef^.MCU_buffer[blkn-1]^[0][0]; + end; + end; + Inc(blkn, compptr^.MCU_width); + Inc(ypos, DCTSIZE); + end; + end; + { Try to write the MCU. In event of a suspension failure, we will + re-DCT the MCU on restart (a bit inefficient, could be fixed...) } + + if (not cinfo^.entropy^.encode_mcu (cinfo, JBLOCKARRAY(@coef^.MCU_buffer)^)) then + begin + { Suspension forced; update state counters and exit } + coef^.MCU_vert_offset := yoffset; + coef^.mcu_ctr := MCU_col_num; + compress_data := FALSE; + exit; + end; + end; + { Completed an MCU row, but perhaps not an iMCU row } + coef^.mcu_ctr := 0; + end; + { Completed the iMCU row, advance counters for next one } + Inc(coef^.iMCU_row_num); + start_iMCU_row(cinfo); + compress_data := TRUE; +end; + + +{$ifdef FULL_COEF_BUFFER_SUPPORTED} + +{ Process some data in the first pass of a multi-pass case. + We process the equivalent of one fully interleaved MCU row ("iMCU" row) + per call, ie, v_samp_factor block rows for each component in the image. + This amount of data is read from the source buffer, DCT'd and quantized, + and saved into the virtual arrays. We also generate suitable dummy blocks + as needed at the right and lower edges. (The dummy blocks are constructed + in the virtual arrays, which have been padded appropriately.) This makes + it possible for subsequent passes not to worry about real vs. dummy blocks. + + We must also emit the data to the entropy encoder. This is conveniently + done by calling compress_output() after we've loaded the current strip + of the virtual arrays. + + NB: input_buf contains a plane for each component in image. All + components are DCT'd and loaded into the virtual arrays in this pass. + However, it may be that only a subset of the components are emitted to + the entropy encoder during this first pass; be careful about looking + at the scan-dependent variables (MCU dimensions, etc). } + +{METHODDEF} +function compress_first_pass (cinfo : j_compress_ptr; + input_buf : JSAMPIMAGE) : boolean; +var + coef : my_coef_ptr; + last_iMCU_row : JDIMENSION; + blocks_across, MCUs_across, MCUindex : JDIMENSION; + bi, ci, h_samp_factor, block_row, block_rows, ndummy : int; + lastDC : JCOEF; + compptr : jpeg_component_info_ptr; + buffer : JBLOCKARRAY; + thisblockrow, lastblockrow : JBLOCKROW; +begin + coef := my_coef_ptr (cinfo^.coef); + last_iMCU_row := cinfo^.total_iMCU_rows - 1; + + compptr := jpeg_component_info_ptr(cinfo^.comp_info); + for ci := 0 to pred(cinfo^.num_components) do + begin + { Align the virtual buffer for this component. } + buffer := cinfo^.mem^.access_virt_barray + (j_common_ptr(cinfo), coef^.whole_image[ci], + coef^.iMCU_row_num * JDIMENSION(compptr^.v_samp_factor), + JDIMENSION (compptr^.v_samp_factor), TRUE); + { Count non-dummy DCT block rows in this iMCU row. } + if (coef^.iMCU_row_num < last_iMCU_row) then + block_rows := compptr^.v_samp_factor + else + begin + { NB: can't use last_row_height here, since may not be set! } + block_rows := int (compptr^.height_in_blocks) mod compptr^.v_samp_factor; + if (block_rows = 0) then + block_rows := compptr^.v_samp_factor; + end; + blocks_across := compptr^.width_in_blocks; + h_samp_factor := compptr^.h_samp_factor; + { Count number of dummy blocks to be added at the right margin. } + ndummy := int (blocks_across) mod h_samp_factor; + if (ndummy > 0) then + ndummy := h_samp_factor - ndummy; + { Perform DCT for all non-dummy blocks in this iMCU row. Each call + on forward_DCT processes a complete horizontal row of DCT blocks. } + + for block_row := 0 to pred(block_rows) do + begin + thisblockrow := buffer^[block_row]; + cinfo^.fdct^.forward_DCT (cinfo, compptr, + input_buf^[ci], + thisblockrow, + JDIMENSION (block_row * DCTSIZE), + JDIMENSION (0), + blocks_across); + if (ndummy > 0) then + begin + { Create dummy blocks at the right edge of the image. } + Inc(JBLOCK_PTR(thisblockrow), blocks_across); { => first dummy block } + jzero_far({FAR}pointer(thisblockrow), ndummy * SIZEOF(JBLOCK)); + {lastDC := thisblockrow^[-1][0];} + { work around Range Checking } + Dec(JBLOCK_PTR(thisblockrow)); + lastDC := thisblockrow^[0][0]; + Inc(JBLOCK_PTR(thisblockrow)); + + for bi := 0 to pred(ndummy) do + begin + thisblockrow^[bi][0] := lastDC; + end; + end; + end; + { If at end of image, create dummy block rows as needed. + The tricky part here is that within each MCU, we want the DC values + of the dummy blocks to match the last real block's DC value. + This squeezes a few more bytes out of the resulting file... } + + if (coef^.iMCU_row_num = last_iMCU_row) then + begin + Inc(blocks_across, ndummy); { include lower right corner } + MCUs_across := blocks_across div JDIMENSION(h_samp_factor); + for block_row := block_rows to pred(compptr^.v_samp_factor) do + begin + thisblockrow := buffer^[block_row]; + lastblockrow := buffer^[block_row-1]; + jzero_far({FAR} pointer(thisblockrow), + size_t(blocks_across * SIZEOF(JBLOCK))); + for MCUindex := 0 to pred(MCUs_across) do + begin + lastDC := lastblockrow^[h_samp_factor-1][0]; + for bi := 0 to pred(h_samp_factor) do + begin + thisblockrow^[bi][0] := lastDC; + end; + Inc(JBLOCK_PTR(thisblockrow), h_samp_factor); { advance to next MCU in row } + Inc(JBLOCK_PTR(lastblockrow), h_samp_factor); + end; + end; + end; + Inc(compptr); + end; + { NB: compress_output will increment iMCU_row_num if successful. + A suspension return will result in redoing all the work above next time.} + + + { Emit data to the entropy encoder, sharing code with subsequent passes } + compress_first_pass := compress_output(cinfo, input_buf); +end; + + +{ Process some data in subsequent passes of a multi-pass case. + We process the equivalent of one fully interleaved MCU row ("iMCU" row) + per call, ie, v_samp_factor block rows for each component in the scan. + The data is obtained from the virtual arrays and fed to the entropy coder. + Returns TRUE if the iMCU row is completed, FALSE if suspended. + + NB: input_buf is ignored; it is likely to be a NIL pointer. } + +{METHODDEF} +function compress_output (cinfo : j_compress_ptr; + input_buf : JSAMPIMAGE) : boolean; +var + coef : my_coef_ptr; + MCU_col_num : JDIMENSION; { index of current MCU within row } + blkn, ci, xindex, yindex, yoffset : int; + start_col : JDIMENSION; + buffer : array[0..MAX_COMPS_IN_SCAN-1] of JBLOCKARRAY; + buffer_ptr : JBLOCKROW; + compptr : jpeg_component_info_ptr; +begin + coef := my_coef_ptr (cinfo^.coef); + + { Align the virtual buffers for the components used in this scan. + NB: during first pass, this is safe only because the buffers will + already be aligned properly, so jmemmgr.c won't need to do any I/O. } + + for ci := 0 to pred(cinfo^.comps_in_scan) do + begin + compptr := cinfo^.cur_comp_info[ci]; + buffer[ci] := cinfo^.mem^.access_virt_barray ( + j_common_ptr(cinfo), coef^.whole_image[compptr^.component_index], + coef^.iMCU_row_num * JDIMENSION(compptr^.v_samp_factor), + JDIMENSION (compptr^.v_samp_factor), FALSE); + end; + + { Loop to process one whole iMCU row } + for yoffset := coef^.MCU_vert_offset to pred(coef^.MCU_rows_per_iMCU_row) do + begin + for MCU_col_num := coef^.mcu_ctr to pred(cinfo^.MCUs_per_row) do + begin + { Construct list of pointers to DCT blocks belonging to this MCU } + blkn := 0; { index of current DCT block within MCU } + for ci := 0 to pred(cinfo^.comps_in_scan) do + begin + compptr := cinfo^.cur_comp_info[ci]; + start_col := MCU_col_num * JDIMENSION(compptr^.MCU_width); + for yindex := 0 to pred(compptr^.MCU_height) do + begin + buffer_ptr := JBLOCKROW(@ buffer[ci]^[yindex+yoffset]^[start_col]); + for xindex := 0 to pred(compptr^.MCU_width) do + begin + coef^.MCU_buffer[blkn] := buffer_ptr; + Inc(blkn); + Inc(JBLOCK_PTR(buffer_ptr)); + end; + end; + end; + { Try to write the MCU. } + if (not cinfo^.entropy^.encode_mcu (cinfo, coef^.MCU_buffer)) then + begin + { Suspension forced; update state counters and exit } + coef^.MCU_vert_offset := yoffset; + coef^.mcu_ctr := MCU_col_num; + compress_output := FALSE; + exit; + end; + end; + { Completed an MCU row, but perhaps not an iMCU row } + coef^.mcu_ctr := 0; + end; + { Completed the iMCU row, advance counters for next one } + Inc(coef^.iMCU_row_num); + start_iMCU_row(cinfo); + compress_output := TRUE; +end; + +{$endif} { FULL_COEF_BUFFER_SUPPORTED } + + +{ Initialize coefficient buffer controller. } + +{GLOBAL} +procedure jinit_c_coef_controller (cinfo : j_compress_ptr; + need_full_buffer : boolean); +var + coef : my_coef_ptr; +var + buffer : JBLOCKROW; + i : int; +var + ci : int; + compptr : jpeg_component_info_ptr; +begin + coef := my_coef_ptr ( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + SIZEOF(my_coef_controller)) ); + cinfo^.coef := jpeg_c_coef_controller_ptr(coef); + coef^.pub.start_pass := start_pass_coef; + + { Create the coefficient buffer. } + if (need_full_buffer) then + begin +{$ifdef FULL_COEF_BUFFER_SUPPORTED} + { Allocate a full-image virtual array for each component, } + { padded to a multiple of samp_factor DCT blocks in each direction. } + + compptr := jpeg_component_info_ptr(cinfo^.comp_info); + for ci := 0 to pred(cinfo^.num_components) do + begin + coef^.whole_image[ci] := cinfo^.mem^.request_virt_barray + (j_common_ptr(cinfo), JPOOL_IMAGE, FALSE, + JDIMENSION (jround_up( long (compptr^.width_in_blocks), + long (compptr^.h_samp_factor) )), + JDIMENSION (jround_up(long (compptr^.height_in_blocks), + long (compptr^.v_samp_factor))), + JDIMENSION (compptr^.v_samp_factor)); + Inc(compptr); + end; +{$else} + ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); +{$endif} + end + else + begin + { We only need a single-MCU buffer. } + buffer := JBLOCKROW ( + cinfo^.mem^.alloc_large (j_common_ptr(cinfo), JPOOL_IMAGE, + C_MAX_BLOCKS_IN_MCU * SIZEOF(JBLOCK)) ); + for i := 0 to pred(C_MAX_BLOCKS_IN_MCU) do + begin + coef^.MCU_buffer[i] := JBLOCKROW(@ buffer^[i]); + end; + coef^.whole_image[0] := NIL; { flag for no virtual arrays } + end; +end; + +end. diff --git a/Imaging/JpegLib/imjccolor.pas b/Imaging/JpegLib/imjccolor.pas index 518f367..d29c876 100644 --- a/Imaging/JpegLib/imjccolor.pas +++ b/Imaging/JpegLib/imjccolor.pas @@ -1,533 +1,533 @@ -unit imjccolor; - -{ This file contains input colorspace conversion routines. } - -{ Original : jccolor.c ; Copyright (C) 1991-1996, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjdeferr, - imjerror, - imjpeglib; - -{ Module initialization routine for input colorspace conversion. } - -{GLOBAL} -procedure jinit_color_converter (cinfo : j_compress_ptr); - -implementation - -{ Private subobject } -type - jTInt32 = 0..Pred(MaxInt div SizeOf(INT32)); - INT32_FIELD = array[jTInt32] of INT32; - INT32_FIELD_PTR = ^INT32_FIELD; - -type - my_cconvert_ptr = ^my_color_converter; - my_color_converter = record - pub : jpeg_color_converter; { public fields } - - { Private state for RGB -> YCC conversion } - rgb_ycc_tab : INT32_FIELD_PTR; { => table for RGB to YCbCr conversion } - end; {my_color_converter;} - - -{*************** RGB -> YCbCr conversion: most common case *************} - -{ - YCbCr is defined per CCIR 601-1, except that Cb and Cr are - normalized to the range 0..MAXJSAMPLE rather than -0.5 .. 0.5. - The conversion equations to be implemented are therefore - Y = 0.29900 * R + 0.58700 * G + 0.11400 * B - Cb = -0.16874 * R - 0.33126 * G + 0.50000 * B + CENTERJSAMPLE - Cr = 0.50000 * R - 0.41869 * G - 0.08131 * B + CENTERJSAMPLE - (These numbers are derived from TIFF 6.0 section 21, dated 3-June-92.) - Note: older versions of the IJG code used a zero offset of MAXJSAMPLE/2, - rather than CENTERJSAMPLE, for Cb and Cr. This gave equal positive and - negative swings for Cb/Cr, but meant that grayscale values (Cb=Cr=0) - were not represented exactly. Now we sacrifice exact representation of - maximum red and maximum blue in order to get exact grayscales. - - To avoid floating-point arithmetic, we represent the fractional constants - as integers scaled up by 2^16 (about 4 digits precision); we have to divide - the products by 2^16, with appropriate rounding, to get the correct answer. - - For even more speed, we avoid doing any multiplications in the inner loop - by precalculating the constants times R,G,B for all possible values. - For 8-bit JSAMPLEs this is very reasonable (only 256 entries per table); - for 12-bit samples it is still acceptable. It's not very reasonable for - 16-bit samples, but if you want lossless storage you shouldn't be changing - colorspace anyway. - The CENTERJSAMPLE offsets and the rounding fudge-factor of 0.5 are included - in the tables to save adding them separately in the inner loop. } -const - SCALEBITS = 16; { speediest right-shift on some machines } - CBCR_OFFSET = INT32(CENTERJSAMPLE shl SCALEBITS); - ONE_HALF = INT32(1) shl (SCALEBITS-1); - - -{ We allocate one big table and divide it up into eight parts, instead of - doing eight alloc_small requests. This lets us use a single table base - address, which can be held in a register in the inner loops on many - machines (more than can hold all eight addresses, anyway). } - - R_Y_OFF = 0; { offset to R => Y section } - G_Y_OFF = 1*(MAXJSAMPLE+1); { offset to G => Y section } - B_Y_OFF = 2*(MAXJSAMPLE+1); { etc. } - R_CB_OFF = 3*(MAXJSAMPLE+1); - G_CB_OFF = 4*(MAXJSAMPLE+1); - B_CB_OFF = 5*(MAXJSAMPLE+1); - R_CR_OFF = B_CB_OFF; { B=>Cb, R=>Cr are the same } - G_CR_OFF = 6*(MAXJSAMPLE+1); - B_CR_OFF = 7*(MAXJSAMPLE+1); - TABLE_SIZE = 8*(MAXJSAMPLE+1); - - -{ Initialize for RGB->YCC colorspace conversion. } - -{METHODDEF} -procedure rgb_ycc_start (cinfo : j_compress_ptr); -const - FIX_0_29900 = INT32(Round (0.29900 * (1 shl SCALEBITS)) ); - FIX_0_58700 = INT32(Round (0.58700 * (1 shl SCALEBITS)) ); - FIX_0_11400 = INT32(Round (0.11400 * (1 shl SCALEBITS)) ); - FIX_0_16874 = INT32(Round (0.16874 * (1 shl SCALEBITS)) ); - FIX_0_33126 = INT32(Round (0.33126 * (1 shl SCALEBITS)) ); - FIX_0_50000 = INT32(Round (0.50000 * (1 shl SCALEBITS)) ); - FIX_0_41869 = INT32(Round (0.41869 * (1 shl SCALEBITS)) ); - FIX_0_08131 = INT32(Round (0.08131 * (1 shl SCALEBITS)) ); -var - cconvert : my_cconvert_ptr; - rgb_ycc_tab : INT32_FIELD_PTR; - i : INT32; -begin - cconvert := my_cconvert_ptr (cinfo^.cconvert); - - { Allocate and fill in the conversion tables. } - rgb_ycc_tab := INT32_FIELD_PTR( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - (TABLE_SIZE * SIZEOF(INT32))) ); - cconvert^.rgb_ycc_tab := rgb_ycc_tab; - - for i := 0 to MAXJSAMPLE do - begin - rgb_ycc_tab^[i+R_Y_OFF] := FIX_0_29900 * i; - rgb_ycc_tab^[i+G_Y_OFF] := FIX_0_58700 * i; - rgb_ycc_tab^[i+B_Y_OFF] := FIX_0_11400 * i + ONE_HALF; - rgb_ycc_tab^[i+R_CB_OFF] := (-FIX_0_16874) * i; - rgb_ycc_tab^[i+G_CB_OFF] := (-FIX_0_33126) * i; - { We use a rounding fudge-factor of 0.5-epsilon for Cb and Cr. - This ensures that the maximum output will round to MAXJSAMPLE - not MAXJSAMPLE+1, and thus that we don't have to range-limit. } - - rgb_ycc_tab^[i+B_CB_OFF] := FIX_0_50000 * i + CBCR_OFFSET + ONE_HALF-1; -{ B=>Cb and R=>Cr tables are the same - rgb_ycc_tab^[i+R_CR_OFF] := FIX_0_50000 * i + CBCR_OFFSET + ONE_HALF-1; -} - rgb_ycc_tab^[i+G_CR_OFF] := (-FIX_0_41869) * i; - rgb_ycc_tab^[i+B_CR_OFF] := (-FIX_0_08131) * i; - end; -end; - - -{ Convert some rows of samples to the JPEG colorspace. - - Note that we change from the application's interleaved-pixel format - to our internal noninterleaved, one-plane-per-component format. - The input buffer is therefore three times as wide as the output buffer. - - A starting row offset is provided only for the output buffer. The caller - can easily adjust the passed input_buf value to accommodate any row - offset required on that side. } - -{METHODDEF} -procedure rgb_ycc_convert (cinfo : j_compress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPIMAGE; - output_row : JDIMENSION; - num_rows : int); -var - cconvert : my_cconvert_ptr; - {register} r, g, b : int; - {register} ctab : INT32_FIELD_PTR; - {register} inptr : JSAMPROW; - {register} outptr0, outptr1, outptr2 : JSAMPROW; - {register} col : JDIMENSION; - num_cols : JDIMENSION; -begin - cconvert := my_cconvert_ptr (cinfo^.cconvert); - ctab := cconvert^.rgb_ycc_tab; - num_cols := cinfo^.image_width; - - while (num_rows > 0) do - begin - Dec(num_rows); - inptr := input_buf^[0]; - Inc(JSAMPROW_PTR(input_buf)); - outptr0 := output_buf^[0]^[output_row]; - outptr1 := output_buf^[1]^[output_row]; - outptr2 := output_buf^[2]^[output_row]; - Inc(output_row); - for col := 0 to pred(num_cols) do - begin - r := GETJSAMPLE(inptr^[RGB_RED]); - g := GETJSAMPLE(inptr^[RGB_GREEN]); - b := GETJSAMPLE(inptr^[RGB_BLUE]); - Inc(JSAMPLE_PTR(inptr), RGB_PIXELSIZE); - { If the inputs are 0..MAXJSAMPLE, the outputs of these equations - must be too; we do not need an explicit range-limiting operation. - Hence the value being shifted is never negative, and we don't - need the general RIGHT_SHIFT macro. } - - { Y } - outptr0^[col] := JSAMPLE( - ((ctab^[r+R_Y_OFF] + ctab^[g+G_Y_OFF] + ctab^[b+B_Y_OFF]) - shr SCALEBITS) ); - { Cb } - outptr1^[col] := JSAMPLE( - ((ctab^[r+R_CB_OFF] + ctab^[g+G_CB_OFF] + ctab^[b+B_CB_OFF]) - shr SCALEBITS) ); - { Cr } - outptr2^[col] := JSAMPLE( - ((ctab^[r+R_CR_OFF] + ctab^[g+G_CR_OFF] + ctab^[b+B_CR_OFF]) - shr SCALEBITS) ); - end; - end; -end; - - -{*************** Cases other than RGB -> YCbCr *************} - - -{ Convert some rows of samples to the JPEG colorspace. - This version handles RGB -> grayscale conversion, which is the same - as the RGB -> Y portion of RGB -> YCbCr. - We assume rgb_ycc_start has been called (we only use the Y tables). } - -{METHODDEF} -procedure rgb_gray_convert (cinfo : j_compress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPIMAGE; - output_row : JDIMENSION; - num_rows : int); -var - cconvert : my_cconvert_ptr; - {register} r, g, b : int; - {register} ctab :INT32_FIELD_PTR; - {register} inptr : JSAMPROW; - {register} outptr : JSAMPROW; - {register} col : JDIMENSION; - num_cols : JDIMENSION; -begin - cconvert := my_cconvert_ptr (cinfo^.cconvert); - ctab := cconvert^.rgb_ycc_tab; - num_cols := cinfo^.image_width; - - while (num_rows > 0) do - begin - Dec(num_rows); - inptr := input_buf^[0]; - Inc(JSAMPROW_PTR(input_buf)); - outptr := output_buf^[0]^[output_row]; - Inc(output_row); - for col := 0 to pred(num_cols) do - begin - r := GETJSAMPLE(inptr^[RGB_RED]); - g := GETJSAMPLE(inptr^[RGB_GREEN]); - b := GETJSAMPLE(inptr^[RGB_BLUE]); - Inc(JSAMPLE_PTR(inptr), RGB_PIXELSIZE); - (* Y *) - // kylix 3 compiler crashes on this - {$IF (not Defined(LINUX)) or Defined(FPC)} - outptr^[col] := JSAMPLE ( - ((ctab^[r+R_Y_OFF] + ctab^[g+G_Y_OFF] + ctab^[b+B_Y_OFF]) - shr SCALEBITS) ); - {$IFEND} - end; - end; - -end; - - -{ Convert some rows of samples to the JPEG colorspace. - This version handles Adobe-style CMYK -> YCCK conversion, - where we convert R=1-C, G=1-M, and B=1-Y to YCbCr using the same - conversion as above, while passing K (black) unchanged. - We assume rgb_ycc_start has been called. } - -{METHODDEF} -procedure cmyk_ycck_convert (cinfo : j_compress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPIMAGE; - output_row : JDIMENSION; - num_rows : int); -var - cconvert : my_cconvert_ptr; - {register} r, g, b : int; - {register} ctab : INT32_FIELD_PTR; - {register} inptr : JSAMPROW; - {register} outptr0, outptr1, outptr2, outptr3 : JSAMPROW; - {register} col : JDIMENSION; - num_cols : JDIMENSION; -begin - cconvert := my_cconvert_ptr (cinfo^.cconvert); - ctab := cconvert^.rgb_ycc_tab; - num_cols := cinfo^.image_width; - - while (num_rows > 0) do - begin - Dec(num_rows); - inptr := input_buf^[0]; - Inc(JSAMPROW_PTR(input_buf)); - outptr0 := output_buf^[0]^[output_row]; - outptr1 := output_buf^[1]^[output_row]; - outptr2 := output_buf^[2]^[output_row]; - outptr3 := output_buf^[3]^[output_row]; - Inc(output_row); - for col := 0 to pred(num_cols) do - begin - r := MAXJSAMPLE - GETJSAMPLE(inptr^[0]); - g := MAXJSAMPLE - GETJSAMPLE(inptr^[1]); - b := MAXJSAMPLE - GETJSAMPLE(inptr^[2]); - { K passes through as-is } - outptr3^[col] := inptr^[3]; { don't need GETJSAMPLE here } - Inc(JSAMPLE_PTR(inptr), 4); - { If the inputs are 0..MAXJSAMPLE, the outputs of these equations - must be too; we do not need an explicit range-limiting operation. - Hence the value being shifted is never negative, and we don't - need the general RIGHT_SHIFT macro. } - - { Y } - outptr0^[col] := JSAMPLE ( - ((ctab^[r+R_Y_OFF] + ctab^[g+G_Y_OFF] + ctab^[b+B_Y_OFF]) - shr SCALEBITS) ); - { Cb } - outptr1^[col] := JSAMPLE( - ((ctab^[r+R_CB_OFF] + ctab^[g+G_CB_OFF] + ctab^[b+B_CB_OFF]) - shr SCALEBITS) ); - { Cr } - outptr2^[col] := JSAMPLE ( - ((ctab^[r+R_CR_OFF] + ctab^[g+G_CR_OFF] + ctab^[b+B_CR_OFF]) - shr SCALEBITS) ); - end; - end; -end; - - -{ Convert some rows of samples to the JPEG colorspace. - This version handles grayscale output with no conversion. - The source can be either plain grayscale or YCbCr (since Y = gray). } - -{METHODDEF} -procedure grayscale_convert (cinfo : j_compress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPIMAGE; - output_row : JDIMENSION; - num_rows: int); -var - {register} inptr : JSAMPROW; - {register} outptr : JSAMPROW; - {register} col : JDIMENSION; - num_cols :JDIMENSION; - instride : int; -begin - num_cols := cinfo^.image_width; - instride := cinfo^.input_components; - - while (num_rows > 0) do - begin - Dec(num_rows); - inptr := input_buf^[0]; - Inc(JSAMPROW_PTR(input_buf)); - outptr := output_buf^[0]^[output_row]; - Inc(output_row); - for col := 0 to pred(num_cols) do - begin - outptr^[col] := inptr^[0]; { don't need GETJSAMPLE() here } - Inc(JSAMPLE_PTR(inptr), instride); - end; - end; -end; - - -{ Convert some rows of samples to the JPEG colorspace. - This version handles multi-component colorspaces without conversion. - We assume input_components = num_components. } - -{METHODDEF} -procedure null_convert (cinfo : j_compress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPIMAGE; - output_row : JDIMENSION; - num_rows : int); -var - {register} inptr : JSAMPROW; - {register} outptr : JSAMPROW; - {register} col : JDIMENSION; - {register} ci : int; - nc : int; - num_cols : JDIMENSION; -begin - nc := cinfo^.num_components; - num_cols := cinfo^.image_width; - - while (num_rows > 0) do - begin - Dec(num_rows); - { It seems fastest to make a separate pass for each component. } - for ci := 0 to pred(nc) do - begin - inptr := input_buf^[0]; - outptr := output_buf^[ci]^[output_row]; - for col := 0 to pred(num_cols) do - begin - outptr^[col] := inptr^[ci]; { don't need GETJSAMPLE() here } - Inc(JSAMPLE_PTR(inptr), nc); - end; - end; - Inc(JSAMPROW_PTR(input_buf)); - Inc(output_row); - end; -end; - - -{ Empty method for start_pass. } - -{METHODDEF} -procedure null_method (cinfo : j_compress_ptr); -begin - { no work needed } -end; - - -{ Module initialization routine for input colorspace conversion. } - -{GLOBAL} -procedure jinit_color_converter (cinfo : j_compress_ptr); -var - cconvert : my_cconvert_ptr; -begin - cconvert := my_cconvert_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_color_converter)) ); - cinfo^.cconvert := jpeg_color_converter_ptr(cconvert); - { set start_pass to null method until we find out differently } - cconvert^.pub.start_pass := null_method; - - { Make sure input_components agrees with in_color_space } - case (cinfo^.in_color_space) of - JCS_GRAYSCALE: - if (cinfo^.input_components <> 1) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE); - -{$ifdef RGB_PIXELSIZE <> 3} - JCS_RGB: - if (cinfo^.input_components <> RGB_PIXELSIZE) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE); -{$else} { share code with YCbCr } - JCS_RGB, -{$endif} - JCS_YCbCr: - if (cinfo^.input_components <> 3) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE); - - JCS_CMYK, - JCS_YCCK: - if (cinfo^.input_components <> 4) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE); - - else { JCS_UNKNOWN can be anything } - if (cinfo^.input_components < 1) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE); - end; - - { Check num_components, set conversion method based on requested space } - case (cinfo^.jpeg_color_space) of - JCS_GRAYSCALE: - begin - if (cinfo^.num_components <> 1) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); - if (cinfo^.in_color_space = JCS_GRAYSCALE) then - cconvert^.pub.color_convert := grayscale_convert - else - if (cinfo^.in_color_space = JCS_RGB) then - begin - cconvert^.pub.start_pass := rgb_ycc_start; - cconvert^.pub.color_convert := rgb_gray_convert; - end - else - if (cinfo^.in_color_space = JCS_YCbCr) then - cconvert^.pub.color_convert := grayscale_convert - else - ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); - end; - - JCS_RGB: - begin - if (cinfo^.num_components <> 3) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); - if (cinfo^.in_color_space = JCS_RGB) and (RGB_PIXELSIZE = 3) then - cconvert^.pub.color_convert := null_convert - else - ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); - end; - - JCS_YCbCr: - begin - if (cinfo^.num_components <> 3) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); - if (cinfo^.in_color_space = JCS_RGB) then - begin - cconvert^.pub.start_pass := rgb_ycc_start; - cconvert^.pub.color_convert := rgb_ycc_convert; - end - else - if (cinfo^.in_color_space = JCS_YCbCr) then - cconvert^.pub.color_convert := null_convert - else - ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); - end; - - JCS_CMYK: - begin - if (cinfo^.num_components <> 4) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); - if (cinfo^.in_color_space = JCS_CMYK) then - cconvert^.pub.color_convert := null_convert - else - ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); - end; - - JCS_YCCK: - begin - if (cinfo^.num_components <> 4) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); - if (cinfo^.in_color_space = JCS_CMYK) then - begin - cconvert^.pub.start_pass := rgb_ycc_start; - cconvert^.pub.color_convert := cmyk_ycck_convert; - end - else - if (cinfo^.in_color_space = JCS_YCCK) then - cconvert^.pub.color_convert := null_convert - else - ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); - end; - - else { allow null conversion of JCS_UNKNOWN } - begin - if (cinfo^.jpeg_color_space <> cinfo^.in_color_space) or - (cinfo^.num_components <> cinfo^.input_components) then - ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); - cconvert^.pub.color_convert := null_convert; - end; - end; -end; - -end. +unit imjccolor; + +{ This file contains input colorspace conversion routines. } + +{ Original : jccolor.c ; Copyright (C) 1991-1996, Thomas G. Lane. } + +interface + +{$I imjconfig.inc} + +uses + imjmorecfg, + imjinclude, + imjdeferr, + imjerror, + imjpeglib; + +{ Module initialization routine for input colorspace conversion. } + +{GLOBAL} +procedure jinit_color_converter (cinfo : j_compress_ptr); + +implementation + +{ Private subobject } +type + jTInt32 = 0..Pred(MaxInt div SizeOf(INT32)); + INT32_FIELD = array[jTInt32] of INT32; + INT32_FIELD_PTR = ^INT32_FIELD; + +type + my_cconvert_ptr = ^my_color_converter; + my_color_converter = record + pub : jpeg_color_converter; { public fields } + + { Private state for RGB -> YCC conversion } + rgb_ycc_tab : INT32_FIELD_PTR; { => table for RGB to YCbCr conversion } + end; {my_color_converter;} + + +{*************** RGB -> YCbCr conversion: most common case *************} + +{ + YCbCr is defined per CCIR 601-1, except that Cb and Cr are + normalized to the range 0..MAXJSAMPLE rather than -0.5 .. 0.5. + The conversion equations to be implemented are therefore + Y = 0.29900 * R + 0.58700 * G + 0.11400 * B + Cb = -0.16874 * R - 0.33126 * G + 0.50000 * B + CENTERJSAMPLE + Cr = 0.50000 * R - 0.41869 * G - 0.08131 * B + CENTERJSAMPLE + (These numbers are derived from TIFF 6.0 section 21, dated 3-June-92.) + Note: older versions of the IJG code used a zero offset of MAXJSAMPLE/2, + rather than CENTERJSAMPLE, for Cb and Cr. This gave equal positive and + negative swings for Cb/Cr, but meant that grayscale values (Cb=Cr=0) + were not represented exactly. Now we sacrifice exact representation of + maximum red and maximum blue in order to get exact grayscales. + + To avoid floating-point arithmetic, we represent the fractional constants + as integers scaled up by 2^16 (about 4 digits precision); we have to divide + the products by 2^16, with appropriate rounding, to get the correct answer. + + For even more speed, we avoid doing any multiplications in the inner loop + by precalculating the constants times R,G,B for all possible values. + For 8-bit JSAMPLEs this is very reasonable (only 256 entries per table); + for 12-bit samples it is still acceptable. It's not very reasonable for + 16-bit samples, but if you want lossless storage you shouldn't be changing + colorspace anyway. + The CENTERJSAMPLE offsets and the rounding fudge-factor of 0.5 are included + in the tables to save adding them separately in the inner loop. } +const + SCALEBITS = 16; { speediest right-shift on some machines } + CBCR_OFFSET = INT32(CENTERJSAMPLE shl SCALEBITS); + ONE_HALF = INT32(1) shl (SCALEBITS-1); + + +{ We allocate one big table and divide it up into eight parts, instead of + doing eight alloc_small requests. This lets us use a single table base + address, which can be held in a register in the inner loops on many + machines (more than can hold all eight addresses, anyway). } + + R_Y_OFF = 0; { offset to R => Y section } + G_Y_OFF = 1*(MAXJSAMPLE+1); { offset to G => Y section } + B_Y_OFF = 2*(MAXJSAMPLE+1); { etc. } + R_CB_OFF = 3*(MAXJSAMPLE+1); + G_CB_OFF = 4*(MAXJSAMPLE+1); + B_CB_OFF = 5*(MAXJSAMPLE+1); + R_CR_OFF = B_CB_OFF; { B=>Cb, R=>Cr are the same } + G_CR_OFF = 6*(MAXJSAMPLE+1); + B_CR_OFF = 7*(MAXJSAMPLE+1); + TABLE_SIZE = 8*(MAXJSAMPLE+1); + + +{ Initialize for RGB->YCC colorspace conversion. } + +{METHODDEF} +procedure rgb_ycc_start (cinfo : j_compress_ptr); +const + FIX_0_29900 = INT32(Round (0.29900 * (1 shl SCALEBITS)) ); + FIX_0_58700 = INT32(Round (0.58700 * (1 shl SCALEBITS)) ); + FIX_0_11400 = INT32(Round (0.11400 * (1 shl SCALEBITS)) ); + FIX_0_16874 = INT32(Round (0.16874 * (1 shl SCALEBITS)) ); + FIX_0_33126 = INT32(Round (0.33126 * (1 shl SCALEBITS)) ); + FIX_0_50000 = INT32(Round (0.50000 * (1 shl SCALEBITS)) ); + FIX_0_41869 = INT32(Round (0.41869 * (1 shl SCALEBITS)) ); + FIX_0_08131 = INT32(Round (0.08131 * (1 shl SCALEBITS)) ); +var + cconvert : my_cconvert_ptr; + rgb_ycc_tab : INT32_FIELD_PTR; + i : INT32; +begin + cconvert := my_cconvert_ptr (cinfo^.cconvert); + + { Allocate and fill in the conversion tables. } + rgb_ycc_tab := INT32_FIELD_PTR( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + (TABLE_SIZE * SIZEOF(INT32))) ); + cconvert^.rgb_ycc_tab := rgb_ycc_tab; + + for i := 0 to MAXJSAMPLE do + begin + rgb_ycc_tab^[i+R_Y_OFF] := FIX_0_29900 * i; + rgb_ycc_tab^[i+G_Y_OFF] := FIX_0_58700 * i; + rgb_ycc_tab^[i+B_Y_OFF] := FIX_0_11400 * i + ONE_HALF; + rgb_ycc_tab^[i+R_CB_OFF] := (-FIX_0_16874) * i; + rgb_ycc_tab^[i+G_CB_OFF] := (-FIX_0_33126) * i; + { We use a rounding fudge-factor of 0.5-epsilon for Cb and Cr. + This ensures that the maximum output will round to MAXJSAMPLE + not MAXJSAMPLE+1, and thus that we don't have to range-limit. } + + rgb_ycc_tab^[i+B_CB_OFF] := FIX_0_50000 * i + CBCR_OFFSET + ONE_HALF-1; +{ B=>Cb and R=>Cr tables are the same + rgb_ycc_tab^[i+R_CR_OFF] := FIX_0_50000 * i + CBCR_OFFSET + ONE_HALF-1; +} + rgb_ycc_tab^[i+G_CR_OFF] := (-FIX_0_41869) * i; + rgb_ycc_tab^[i+B_CR_OFF] := (-FIX_0_08131) * i; + end; +end; + + +{ Convert some rows of samples to the JPEG colorspace. + + Note that we change from the application's interleaved-pixel format + to our internal noninterleaved, one-plane-per-component format. + The input buffer is therefore three times as wide as the output buffer. + + A starting row offset is provided only for the output buffer. The caller + can easily adjust the passed input_buf value to accommodate any row + offset required on that side. } + +{METHODDEF} +procedure rgb_ycc_convert (cinfo : j_compress_ptr; + input_buf : JSAMPARRAY; + output_buf : JSAMPIMAGE; + output_row : JDIMENSION; + num_rows : int); +var + cconvert : my_cconvert_ptr; + {register} r, g, b : int; + {register} ctab : INT32_FIELD_PTR; + {register} inptr : JSAMPROW; + {register} outptr0, outptr1, outptr2 : JSAMPROW; + {register} col : JDIMENSION; + num_cols : JDIMENSION; +begin + cconvert := my_cconvert_ptr (cinfo^.cconvert); + ctab := cconvert^.rgb_ycc_tab; + num_cols := cinfo^.image_width; + + while (num_rows > 0) do + begin + Dec(num_rows); + inptr := input_buf^[0]; + Inc(JSAMPROW_PTR(input_buf)); + outptr0 := output_buf^[0]^[output_row]; + outptr1 := output_buf^[1]^[output_row]; + outptr2 := output_buf^[2]^[output_row]; + Inc(output_row); + for col := 0 to pred(num_cols) do + begin + r := GETJSAMPLE(inptr^[RGB_RED]); + g := GETJSAMPLE(inptr^[RGB_GREEN]); + b := GETJSAMPLE(inptr^[RGB_BLUE]); + Inc(JSAMPLE_PTR(inptr), RGB_PIXELSIZE); + { If the inputs are 0..MAXJSAMPLE, the outputs of these equations + must be too; we do not need an explicit range-limiting operation. + Hence the value being shifted is never negative, and we don't + need the general RIGHT_SHIFT macro. } + + { Y } + outptr0^[col] := JSAMPLE( + ((ctab^[r+R_Y_OFF] + ctab^[g+G_Y_OFF] + ctab^[b+B_Y_OFF]) + shr SCALEBITS) ); + { Cb } + outptr1^[col] := JSAMPLE( + ((ctab^[r+R_CB_OFF] + ctab^[g+G_CB_OFF] + ctab^[b+B_CB_OFF]) + shr SCALEBITS) ); + { Cr } + outptr2^[col] := JSAMPLE( + ((ctab^[r+R_CR_OFF] + ctab^[g+G_CR_OFF] + ctab^[b+B_CR_OFF]) + shr SCALEBITS) ); + end; + end; +end; + + +{*************** Cases other than RGB -> YCbCr *************} + + +{ Convert some rows of samples to the JPEG colorspace. + This version handles RGB -> grayscale conversion, which is the same + as the RGB -> Y portion of RGB -> YCbCr. + We assume rgb_ycc_start has been called (we only use the Y tables). } + +{METHODDEF} +procedure rgb_gray_convert (cinfo : j_compress_ptr; + input_buf : JSAMPARRAY; + output_buf : JSAMPIMAGE; + output_row : JDIMENSION; + num_rows : int); +var + cconvert : my_cconvert_ptr; + {register} r, g, b : int; + {register} ctab :INT32_FIELD_PTR; + {register} inptr : JSAMPROW; + {register} outptr : JSAMPROW; + {register} col : JDIMENSION; + num_cols : JDIMENSION; +begin + cconvert := my_cconvert_ptr (cinfo^.cconvert); + ctab := cconvert^.rgb_ycc_tab; + num_cols := cinfo^.image_width; + + while (num_rows > 0) do + begin + Dec(num_rows); + inptr := input_buf^[0]; + Inc(JSAMPROW_PTR(input_buf)); + outptr := output_buf^[0]^[output_row]; + Inc(output_row); + for col := 0 to pred(num_cols) do + begin + r := GETJSAMPLE(inptr^[RGB_RED]); + g := GETJSAMPLE(inptr^[RGB_GREEN]); + b := GETJSAMPLE(inptr^[RGB_BLUE]); + Inc(JSAMPLE_PTR(inptr), RGB_PIXELSIZE); + (* Y *) + // kylix 3 compiler crashes on this + {$IF (not Defined(LINUX)) or Defined(FPC)} + outptr^[col] := JSAMPLE ( + ((ctab^[r+R_Y_OFF] + ctab^[g+G_Y_OFF] + ctab^[b+B_Y_OFF]) + shr SCALEBITS) ); + {$IFEND} + end; + end; + +end; + + +{ Convert some rows of samples to the JPEG colorspace. + This version handles Adobe-style CMYK -> YCCK conversion, + where we convert R=1-C, G=1-M, and B=1-Y to YCbCr using the same + conversion as above, while passing K (black) unchanged. + We assume rgb_ycc_start has been called. } + +{METHODDEF} +procedure cmyk_ycck_convert (cinfo : j_compress_ptr; + input_buf : JSAMPARRAY; + output_buf : JSAMPIMAGE; + output_row : JDIMENSION; + num_rows : int); +var + cconvert : my_cconvert_ptr; + {register} r, g, b : int; + {register} ctab : INT32_FIELD_PTR; + {register} inptr : JSAMPROW; + {register} outptr0, outptr1, outptr2, outptr3 : JSAMPROW; + {register} col : JDIMENSION; + num_cols : JDIMENSION; +begin + cconvert := my_cconvert_ptr (cinfo^.cconvert); + ctab := cconvert^.rgb_ycc_tab; + num_cols := cinfo^.image_width; + + while (num_rows > 0) do + begin + Dec(num_rows); + inptr := input_buf^[0]; + Inc(JSAMPROW_PTR(input_buf)); + outptr0 := output_buf^[0]^[output_row]; + outptr1 := output_buf^[1]^[output_row]; + outptr2 := output_buf^[2]^[output_row]; + outptr3 := output_buf^[3]^[output_row]; + Inc(output_row); + for col := 0 to pred(num_cols) do + begin + r := MAXJSAMPLE - GETJSAMPLE(inptr^[0]); + g := MAXJSAMPLE - GETJSAMPLE(inptr^[1]); + b := MAXJSAMPLE - GETJSAMPLE(inptr^[2]); + { K passes through as-is } + outptr3^[col] := inptr^[3]; { don't need GETJSAMPLE here } + Inc(JSAMPLE_PTR(inptr), 4); + { If the inputs are 0..MAXJSAMPLE, the outputs of these equations + must be too; we do not need an explicit range-limiting operation. + Hence the value being shifted is never negative, and we don't + need the general RIGHT_SHIFT macro. } + + { Y } + outptr0^[col] := JSAMPLE ( + ((ctab^[r+R_Y_OFF] + ctab^[g+G_Y_OFF] + ctab^[b+B_Y_OFF]) + shr SCALEBITS) ); + { Cb } + outptr1^[col] := JSAMPLE( + ((ctab^[r+R_CB_OFF] + ctab^[g+G_CB_OFF] + ctab^[b+B_CB_OFF]) + shr SCALEBITS) ); + { Cr } + outptr2^[col] := JSAMPLE ( + ((ctab^[r+R_CR_OFF] + ctab^[g+G_CR_OFF] + ctab^[b+B_CR_OFF]) + shr SCALEBITS) ); + end; + end; +end; + + +{ Convert some rows of samples to the JPEG colorspace. + This version handles grayscale output with no conversion. + The source can be either plain grayscale or YCbCr (since Y = gray). } + +{METHODDEF} +procedure grayscale_convert (cinfo : j_compress_ptr; + input_buf : JSAMPARRAY; + output_buf : JSAMPIMAGE; + output_row : JDIMENSION; + num_rows: int); +var + {register} inptr : JSAMPROW; + {register} outptr : JSAMPROW; + {register} col : JDIMENSION; + num_cols :JDIMENSION; + instride : int; +begin + num_cols := cinfo^.image_width; + instride := cinfo^.input_components; + + while (num_rows > 0) do + begin + Dec(num_rows); + inptr := input_buf^[0]; + Inc(JSAMPROW_PTR(input_buf)); + outptr := output_buf^[0]^[output_row]; + Inc(output_row); + for col := 0 to pred(num_cols) do + begin + outptr^[col] := inptr^[0]; { don't need GETJSAMPLE() here } + Inc(JSAMPLE_PTR(inptr), instride); + end; + end; +end; + + +{ Convert some rows of samples to the JPEG colorspace. + This version handles multi-component colorspaces without conversion. + We assume input_components = num_components. } + +{METHODDEF} +procedure null_convert (cinfo : j_compress_ptr; + input_buf : JSAMPARRAY; + output_buf : JSAMPIMAGE; + output_row : JDIMENSION; + num_rows : int); +var + {register} inptr : JSAMPROW; + {register} outptr : JSAMPROW; + {register} col : JDIMENSION; + {register} ci : int; + nc : int; + num_cols : JDIMENSION; +begin + nc := cinfo^.num_components; + num_cols := cinfo^.image_width; + + while (num_rows > 0) do + begin + Dec(num_rows); + { It seems fastest to make a separate pass for each component. } + for ci := 0 to pred(nc) do + begin + inptr := input_buf^[0]; + outptr := output_buf^[ci]^[output_row]; + for col := 0 to pred(num_cols) do + begin + outptr^[col] := inptr^[ci]; { don't need GETJSAMPLE() here } + Inc(JSAMPLE_PTR(inptr), nc); + end; + end; + Inc(JSAMPROW_PTR(input_buf)); + Inc(output_row); + end; +end; + + +{ Empty method for start_pass. } + +{METHODDEF} +procedure null_method (cinfo : j_compress_ptr); +begin + { no work needed } +end; + + +{ Module initialization routine for input colorspace conversion. } + +{GLOBAL} +procedure jinit_color_converter (cinfo : j_compress_ptr); +var + cconvert : my_cconvert_ptr; +begin + cconvert := my_cconvert_ptr( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + SIZEOF(my_color_converter)) ); + cinfo^.cconvert := jpeg_color_converter_ptr(cconvert); + { set start_pass to null method until we find out differently } + cconvert^.pub.start_pass := null_method; + + { Make sure input_components agrees with in_color_space } + case (cinfo^.in_color_space) of + JCS_GRAYSCALE: + if (cinfo^.input_components <> 1) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE); + +{$ifdef RGB_PIXELSIZE <> 3} + JCS_RGB: + if (cinfo^.input_components <> RGB_PIXELSIZE) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE); +{$else} { share code with YCbCr } + JCS_RGB, +{$endif} + JCS_YCbCr: + if (cinfo^.input_components <> 3) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE); + + JCS_CMYK, + JCS_YCCK: + if (cinfo^.input_components <> 4) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE); + + else { JCS_UNKNOWN can be anything } + if (cinfo^.input_components < 1) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE); + end; + + { Check num_components, set conversion method based on requested space } + case (cinfo^.jpeg_color_space) of + JCS_GRAYSCALE: + begin + if (cinfo^.num_components <> 1) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); + if (cinfo^.in_color_space = JCS_GRAYSCALE) then + cconvert^.pub.color_convert := grayscale_convert + else + if (cinfo^.in_color_space = JCS_RGB) then + begin + cconvert^.pub.start_pass := rgb_ycc_start; + cconvert^.pub.color_convert := rgb_gray_convert; + end + else + if (cinfo^.in_color_space = JCS_YCbCr) then + cconvert^.pub.color_convert := grayscale_convert + else + ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); + end; + + JCS_RGB: + begin + if (cinfo^.num_components <> 3) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); + if (cinfo^.in_color_space = JCS_RGB) and (RGB_PIXELSIZE = 3) then + cconvert^.pub.color_convert := null_convert + else + ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); + end; + + JCS_YCbCr: + begin + if (cinfo^.num_components <> 3) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); + if (cinfo^.in_color_space = JCS_RGB) then + begin + cconvert^.pub.start_pass := rgb_ycc_start; + cconvert^.pub.color_convert := rgb_ycc_convert; + end + else + if (cinfo^.in_color_space = JCS_YCbCr) then + cconvert^.pub.color_convert := null_convert + else + ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); + end; + + JCS_CMYK: + begin + if (cinfo^.num_components <> 4) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); + if (cinfo^.in_color_space = JCS_CMYK) then + cconvert^.pub.color_convert := null_convert + else + ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); + end; + + JCS_YCCK: + begin + if (cinfo^.num_components <> 4) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); + if (cinfo^.in_color_space = JCS_CMYK) then + begin + cconvert^.pub.start_pass := rgb_ycc_start; + cconvert^.pub.color_convert := cmyk_ycck_convert; + end + else + if (cinfo^.in_color_space = JCS_YCCK) then + cconvert^.pub.color_convert := null_convert + else + ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); + end; + + else { allow null conversion of JCS_UNKNOWN } + begin + if (cinfo^.jpeg_color_space <> cinfo^.in_color_space) or + (cinfo^.num_components <> cinfo^.input_components) then + ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); + cconvert^.pub.color_convert := null_convert; + end; + end; +end; + +end. diff --git a/Imaging/JpegLib/imjcdctmgr.pas b/Imaging/JpegLib/imjcdctmgr.pas index 324285f..29c1dda 100644 --- a/Imaging/JpegLib/imjcdctmgr.pas +++ b/Imaging/JpegLib/imjcdctmgr.pas @@ -1,514 +1,514 @@ -unit imjcdctmgr; - -{ Original : jcdctmgr.c ; Copyright (C) 1994-1996, Thomas G. Lane. } - -{ This file is part of the Independent JPEG Group's software. - For conditions of distribution and use, see the accompanying README file. - - This file contains the forward-DCT management logic. - This code selects a particular DCT implementation to be used, - and it performs related housekeeping chores including coefficient - quantization. } - -interface - -{$N+} -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjdeferr, - imjerror, - imjpeglib, - imjdct, { Private declarations for DCT subsystem } - imjfdctint, imjfdctfst, imjfdctflt; - -{ Initialize FDCT manager. } - -{GLOBAL} -procedure jinit_forward_dct (cinfo : j_compress_ptr); - -implementation - - -{ Private subobject for this module } - -type - my_fdct_ptr = ^my_fdct_controller; - my_fdct_controller = record - pub : jpeg_forward_dct; { public fields } - - { Pointer to the DCT routine actually in use } - do_dct : forward_DCT_method_ptr; - - { The actual post-DCT divisors --- not identical to the quant table - entries, because of scaling (especially for an unnormalized DCT). - Each table is given in normal array order. } - - divisors : array[0..NUM_QUANT_TBLS-1] of DCTELEM_FIELD_PTR; - - {$ifdef DCT_FLOAT_SUPPORTED} - { Same as above for the floating-point case. } - do_float_dct : float_DCT_method_ptr; - float_divisors : array[0..NUM_QUANT_TBLS-1] of FAST_FLOAT_FIELD_PTR; - {$endif} - end; - - -{ Initialize for a processing pass. - Verify that all referenced Q-tables are present, and set up - the divisor table for each one. - In the current implementation, DCT of all components is done during - the first pass, even if only some components will be output in the - first scan. Hence all components should be examined here. } - -{METHODDEF} -procedure start_pass_fdctmgr (cinfo : j_compress_ptr); -var - fdct : my_fdct_ptr; - ci, qtblno, i : int; - compptr : jpeg_component_info_ptr; - qtbl : JQUANT_TBL_PTR; - dtbl : DCTELEM_FIELD_PTR; -{$ifdef DCT_IFAST_SUPPORTED} -const - CONST_BITS = 14; - aanscales : array[0..DCTSIZE2-1] of INT16 = - ({ precomputed values scaled up by 14 bits } - 16384, 22725, 21407, 19266, 16384, 12873, 8867, 4520, - 22725, 31521, 29692, 26722, 22725, 17855, 12299, 6270, - 21407, 29692, 27969, 25172, 21407, 16819, 11585, 5906, - 19266, 26722, 25172, 22654, 19266, 15137, 10426, 5315, - 16384, 22725, 21407, 19266, 16384, 12873, 8867, 4520, - 12873, 17855, 16819, 15137, 12873, 10114, 6967, 3552, - 8867, 12299, 11585, 10426, 8867, 6967, 4799, 2446, - 4520, 6270, 5906, 5315, 4520, 3552, 2446, 1247); - {SHIFT_TEMPS} - - { Descale and correctly round an INT32 value that's scaled by N bits. - We assume RIGHT_SHIFT rounds towards minus infinity, so adding - the fudge factor is correct for either sign of X. } - - function DESCALE(x : INT32; n : int) : INT32; - var - shift_temp : INT32; - begin - shift_temp := x + (INT32(1) shl (n-1)); - {$ifdef RIGHT_SHIFT_IS_UNSIGNED} - if shift_temp < 0 then - Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n)) - else - {$endif} - Descale := (shift_temp shr n); - end; - -{$endif} -{$ifdef DCT_FLOAT_SUPPORTED} -var - fdtbl : FAST_FLOAT_FIELD_PTR; - row, col : int; -const - aanscalefactor : array[0..DCTSIZE-1] of double = - (1.0, 1.387039845, 1.306562965, 1.175875602, - 1.0, 0.785694958, 0.541196100, 0.275899379); -{$endif} -begin - fdct := my_fdct_ptr (cinfo^.fdct); - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - qtblno := compptr^.quant_tbl_no; - { Make sure specified quantization table is present } - if (qtblno < 0) or (qtblno >= NUM_QUANT_TBLS) or - (cinfo^.quant_tbl_ptrs[qtblno] = NIL) then - ERREXIT1(j_common_ptr(cinfo), JERR_NO_QUANT_TABLE, qtblno); - qtbl := cinfo^.quant_tbl_ptrs[qtblno]; - { Compute divisors for this quant table } - { We may do this more than once for same table, but it's not a big deal } - case (cinfo^.dct_method) of -{$ifdef DCT_ISLOW_SUPPORTED} - JDCT_ISLOW: - begin - { For LL&M IDCT method, divisors are equal to raw quantization - coefficients multiplied by 8 (to counteract scaling). } - - if (fdct^.divisors[qtblno] = NIL) then - begin - fdct^.divisors[qtblno] := DCTELEM_FIELD_PTR( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - DCTSIZE2 * SIZEOF(DCTELEM)) ); - end; - dtbl := fdct^.divisors[qtblno]; - for i := 0 to pred(DCTSIZE2) do - begin - dtbl^[i] := (DCTELEM(qtbl^.quantval[i])) shl 3; - end; - end; -{$endif} -{$ifdef DCT_IFAST_SUPPORTED} - JDCT_IFAST: - begin - { For AA&N IDCT method, divisors are equal to quantization - coefficients scaled by scalefactor[row]*scalefactor[col], where - scalefactor[0] := 1 - scalefactor[k] := cos(k*PI/16) * sqrt(2) for k=1..7 - We apply a further scale factor of 8. } - - - if (fdct^.divisors[qtblno] = NIL) then - begin - fdct^.divisors[qtblno] := DCTELEM_FIELD_PTR( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - DCTSIZE2 * SIZEOF(DCTELEM)) ); - end; - dtbl := fdct^.divisors[qtblno]; - for i := 0 to pred(DCTSIZE2) do - begin - dtbl^[i] := DCTELEM( - {MULTIPLY16V16} - DESCALE( INT32(qtbl^.quantval[i]) * INT32 (aanscales[i]), - CONST_BITS-3) ); - end; - end; -{$endif} -{$ifdef DCT_FLOAT_SUPPORTED} - - JDCT_FLOAT: - begin - { For float AA&N IDCT method, divisors are equal to quantization - coefficients scaled by scalefactor[row]*scalefactor[col], where - scalefactor[0] := 1 - scalefactor[k] := cos(k*PI/16) * sqrt(2) for k=1..7 - We apply a further scale factor of 8. - What's actually stored is 1/divisor so that the inner loop can - use a multiplication rather than a division. } - - if (fdct^.float_divisors[qtblno] = NIL) then - begin - fdct^.float_divisors[qtblno] := FAST_FLOAT_FIELD_PTR( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - DCTSIZE2 * SIZEOF(FAST_FLOAT)) ); - end; - fdtbl := fdct^.float_divisors[qtblno]; - i := 0; - for row := 0 to pred(DCTSIZE) do - begin - for col := 0 to pred(DCTSIZE) do - begin - fdtbl^[i] := {FAST_FLOAT} - (1.0 / (( {double}(qtbl^.quantval[i]) * - aanscalefactor[row] * aanscalefactor[col] * 8.0))); - Inc(i); - end; - end; - end; -{$endif} - else - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); - end; - Inc(compptr); - end; -end; - - -{ Perform forward DCT on one or more blocks of a component. - - The input samples are taken from the sample_data[] array starting at - position start_row/start_col, and moving to the right for any additional - blocks. The quantized coefficients are returned in coef_blocks[]. } - -{METHODDEF} -procedure forward_DCT (cinfo : j_compress_ptr; - compptr : jpeg_component_info_ptr; - sample_data : JSAMPARRAY; - coef_blocks : JBLOCKROW; - start_row : JDIMENSION; - start_col : JDIMENSION; - num_blocks : JDIMENSION); -{ This version is used for integer DCT implementations. } -var - { This routine is heavily used, so it's worth coding it tightly. } - fdct : my_fdct_ptr; - do_dct : forward_DCT_method_ptr; - divisors : DCTELEM_FIELD_PTR; - workspace : array[0..DCTSIZE2-1] of DCTELEM; { work area for FDCT subroutine } - bi : JDIMENSION; -var - {register} workspaceptr : DCTELEMPTR; - {register} elemptr : JSAMPLE_PTR; - {register} elemr : int; -{$ifndef DCTSIZE_IS_8} -var - {register} elemc : int; -{$endif} -var - {register} temp, qval : DCTELEM; - {register} i : int; - {register} output_ptr : JCOEFPTR; -begin - fdct := my_fdct_ptr (cinfo^.fdct); - do_dct := fdct^.do_dct; - divisors := fdct^.divisors[compptr^.quant_tbl_no]; - - Inc(JSAMPROW_PTR(sample_data), start_row); { fold in the vertical offset once } - - for bi := 0 to pred(num_blocks) do - begin - - { Load data into workspace, applying unsigned->signed conversion } - - workspaceptr := @workspace[0]; - for elemr := 0 to pred(DCTSIZE) do - begin - elemptr := @sample_data^[elemr]^[start_col]; -{$ifdef DCTSIZE_IS_8} { unroll the inner loop } - workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; - Inc(workspaceptr); - {Inc(elemptr); - Value never used } -{$else} - for elemc := pred(DCTSIZE) downto 0 do - begin - workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; - Inc(workspaceptr); - Inc(elemptr); - end; -{$endif} - end; - - { Perform the DCT } - do_dct (workspace); - - { Quantize/descale the coefficients, and store into coef_blocks[] } - - output_ptr := JCOEFPTR(@coef_blocks^[bi]); - for i := 0 to pred(DCTSIZE2) do - begin - qval := divisors^[i]; - temp := workspace[i]; - { Divide the coefficient value by qval, ensuring proper rounding. - Since C does not specify the direction of rounding for negative - quotients, we have to force the dividend positive for portability. - - In most files, at least half of the output values will be zero - (at default quantization settings, more like three-quarters...) - so we should ensure that this case is fast. On many machines, - a comparison is enough cheaper than a divide to make a special test - a win. Since both inputs will be nonnegative, we need only test - for a < b to discover whether a/b is 0. - If your machine's division is fast enough, define FAST_DIVIDE. } - - if (temp < 0) then - begin - temp := -temp; - Inc(temp, qval shr 1); { for rounding } - {DIVIDE_BY(temp, qval);} - {$ifdef FAST_DIVIDE} - temp := temp div qval; - {$else} - if (temp >= qval) then - temp := temp div qval - else - temp := 0; - {$endif} - temp := -temp; - end - else - begin - Inc(temp, qval shr 1); { for rounding } - {DIVIDE_BY(temp, qval);} - {$ifdef FAST_DIVIDE} - temp := temp div qval; - {$else} - if (temp >= qval) then - temp := temp div qval - else - temp := 0; - {$endif} - end; - output_ptr^[i] := JCOEF (temp); - end; - Inc(start_col, DCTSIZE); - end; -end; - - -{$ifdef DCT_FLOAT_SUPPORTED} - -{METHODDEF} -procedure forward_DCT_float (cinfo : j_compress_ptr; - compptr : jpeg_component_info_ptr; - sample_data : JSAMPARRAY; - coef_blocks : JBLOCKROW; - start_row : JDIMENSION; - start_col : JDIMENSION; - num_blocks : JDIMENSION); -{ This version is used for floating-point DCT implementations. } -var - { This routine is heavily used, so it's worth coding it tightly. } - fdct : my_fdct_ptr; - do_dct : float_DCT_method_ptr; - divisors : FAST_FLOAT_FIELD_PTR; - workspace : array[0..DCTSIZE2-1] of FAST_FLOAT; { work area for FDCT subroutine } - bi : JDIMENSION; -var - {register} workspaceptr : FAST_FLOAT_PTR; - {register} elemptr : JSAMPLE_PTR; - {register} elemr : int; -{$ifndef DCTSIZE_IS_8} -var - {register} elemc : int; -{$endif} -var - {register} temp : FAST_FLOAT; - {register} i : int; - {register} output_ptr : JCOEFPTR; -begin - fdct := my_fdct_ptr (cinfo^.fdct); - do_dct := fdct^.do_float_dct; - divisors := fdct^.float_divisors[compptr^.quant_tbl_no]; - - Inc(JSAMPROW_PTR(sample_data), start_row); { fold in the vertical offset once } - - for bi := 0 to pred(num_blocks) do - begin - { Load data into workspace, applying unsigned->signed conversion } - - workspaceptr := @workspace[0]; - for elemr := 0 to pred(DCTSIZE) do - begin - elemptr := @(sample_data^[elemr]^[start_col]); -{$ifdef DCTSIZE_IS_8} { unroll the inner loop } - workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); - Inc(workspaceptr); - {Inc(elemptr); - value never used } -{$else} - for elemc := pred(DCTSIZE) downto 0 do - begin - workspaceptr^ := {FAST_FLOAT}( - (GETJSAMPLE(elemptr^) - CENTERJSAMPLE) ); - Inc(workspaceptr); - Inc(elemptr); - end; -{$endif} - end; - - - { Perform the DCT } - do_dct (workspace); - - { Quantize/descale the coefficients, and store into coef_blocks[] } - - output_ptr := JCOEFPTR(@(coef_blocks^[bi])); - - for i := 0 to pred(DCTSIZE2) do - begin - { Apply the quantization and scaling factor } - temp := workspace[i] * divisors^[i]; - { Round to nearest integer. - Since C does not specify the direction of rounding for negative - quotients, we have to force the dividend positive for portability. - The maximum coefficient size is +-16K (for 12-bit data), so this - code should work for either 16-bit or 32-bit ints. } - output_ptr^[i] := JCOEF ( int(Trunc (temp + {FAST_FLOAT}(16384.5))) - 16384); - end; - Inc(start_col, DCTSIZE); - end; -end; - -{$endif} { DCT_FLOAT_SUPPORTED } - - -{ Initialize FDCT manager. } - -{GLOBAL} -procedure jinit_forward_dct (cinfo : j_compress_ptr); -var - fdct : my_fdct_ptr; - i : int; -begin - fdct := my_fdct_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_fdct_controller)) ); - cinfo^.fdct := jpeg_forward_dct_ptr (fdct); - fdct^.pub.start_pass := start_pass_fdctmgr; - - case (cinfo^.dct_method) of -{$ifdef DCT_ISLOW_SUPPORTED} - JDCT_ISLOW: - begin - fdct^.pub.forward_DCT := forward_DCT; - fdct^.do_dct := jpeg_fdct_islow; - end; -{$endif} -{$ifdef DCT_IFAST_SUPPORTED} - JDCT_IFAST: - begin - fdct^.pub.forward_DCT := forward_DCT; - fdct^.do_dct := jpeg_fdct_ifast; - end; -{$endif} -{$ifdef DCT_FLOAT_SUPPORTED} - JDCT_FLOAT: - begin - fdct^.pub.forward_DCT := forward_DCT_float; - fdct^.do_float_dct := jpeg_fdct_float; - end; -{$endif} - else - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); - end; - - { Mark divisor tables unallocated } - for i := 0 to pred(NUM_QUANT_TBLS) do - begin - fdct^.divisors[i] := NIL; -{$ifdef DCT_FLOAT_SUPPORTED} - fdct^.float_divisors[i] := NIL; -{$endif} - end; -end; - -end. +unit imjcdctmgr; + +{ Original : jcdctmgr.c ; Copyright (C) 1994-1996, Thomas G. Lane. } + +{ This file is part of the Independent JPEG Group's software. + For conditions of distribution and use, see the accompanying README file. + + This file contains the forward-DCT management logic. + This code selects a particular DCT implementation to be used, + and it performs related housekeeping chores including coefficient + quantization. } + +interface + +{$N+} +{$I imjconfig.inc} + +uses + imjmorecfg, + imjinclude, + imjdeferr, + imjerror, + imjpeglib, + imjdct, { Private declarations for DCT subsystem } + imjfdctint, imjfdctfst, imjfdctflt; + +{ Initialize FDCT manager. } + +{GLOBAL} +procedure jinit_forward_dct (cinfo : j_compress_ptr); + +implementation + + +{ Private subobject for this module } + +type + my_fdct_ptr = ^my_fdct_controller; + my_fdct_controller = record + pub : jpeg_forward_dct; { public fields } + + { Pointer to the DCT routine actually in use } + do_dct : forward_DCT_method_ptr; + + { The actual post-DCT divisors --- not identical to the quant table + entries, because of scaling (especially for an unnormalized DCT). + Each table is given in normal array order. } + + divisors : array[0..NUM_QUANT_TBLS-1] of DCTELEM_FIELD_PTR; + + {$ifdef DCT_FLOAT_SUPPORTED} + { Same as above for the floating-point case. } + do_float_dct : float_DCT_method_ptr; + float_divisors : array[0..NUM_QUANT_TBLS-1] of FAST_FLOAT_FIELD_PTR; + {$endif} + end; + + +{ Initialize for a processing pass. + Verify that all referenced Q-tables are present, and set up + the divisor table for each one. + In the current implementation, DCT of all components is done during + the first pass, even if only some components will be output in the + first scan. Hence all components should be examined here. } + +{METHODDEF} +procedure start_pass_fdctmgr (cinfo : j_compress_ptr); +var + fdct : my_fdct_ptr; + ci, qtblno, i : int; + compptr : jpeg_component_info_ptr; + qtbl : JQUANT_TBL_PTR; + dtbl : DCTELEM_FIELD_PTR; +{$ifdef DCT_IFAST_SUPPORTED} +const + CONST_BITS = 14; + aanscales : array[0..DCTSIZE2-1] of INT16 = + ({ precomputed values scaled up by 14 bits } + 16384, 22725, 21407, 19266, 16384, 12873, 8867, 4520, + 22725, 31521, 29692, 26722, 22725, 17855, 12299, 6270, + 21407, 29692, 27969, 25172, 21407, 16819, 11585, 5906, + 19266, 26722, 25172, 22654, 19266, 15137, 10426, 5315, + 16384, 22725, 21407, 19266, 16384, 12873, 8867, 4520, + 12873, 17855, 16819, 15137, 12873, 10114, 6967, 3552, + 8867, 12299, 11585, 10426, 8867, 6967, 4799, 2446, + 4520, 6270, 5906, 5315, 4520, 3552, 2446, 1247); + {SHIFT_TEMPS} + + { Descale and correctly round an INT32 value that's scaled by N bits. + We assume RIGHT_SHIFT rounds towards minus infinity, so adding + the fudge factor is correct for either sign of X. } + + function DESCALE(x : INT32; n : int) : INT32; + var + shift_temp : INT32; + begin + shift_temp := x + (INT32(1) shl (n-1)); + {$ifdef RIGHT_SHIFT_IS_UNSIGNED} + if shift_temp < 0 then + Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n)) + else + {$endif} + Descale := (shift_temp shr n); + end; + +{$endif} +{$ifdef DCT_FLOAT_SUPPORTED} +var + fdtbl : FAST_FLOAT_FIELD_PTR; + row, col : int; +const + aanscalefactor : array[0..DCTSIZE-1] of double = + (1.0, 1.387039845, 1.306562965, 1.175875602, + 1.0, 0.785694958, 0.541196100, 0.275899379); +{$endif} +begin + fdct := my_fdct_ptr (cinfo^.fdct); + compptr := jpeg_component_info_ptr(cinfo^.comp_info); + for ci := 0 to pred(cinfo^.num_components) do + begin + qtblno := compptr^.quant_tbl_no; + { Make sure specified quantization table is present } + if (qtblno < 0) or (qtblno >= NUM_QUANT_TBLS) or + (cinfo^.quant_tbl_ptrs[qtblno] = NIL) then + ERREXIT1(j_common_ptr(cinfo), JERR_NO_QUANT_TABLE, qtblno); + qtbl := cinfo^.quant_tbl_ptrs[qtblno]; + { Compute divisors for this quant table } + { We may do this more than once for same table, but it's not a big deal } + case (cinfo^.dct_method) of +{$ifdef DCT_ISLOW_SUPPORTED} + JDCT_ISLOW: + begin + { For LL&M IDCT method, divisors are equal to raw quantization + coefficients multiplied by 8 (to counteract scaling). } + + if (fdct^.divisors[qtblno] = NIL) then + begin + fdct^.divisors[qtblno] := DCTELEM_FIELD_PTR( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + DCTSIZE2 * SIZEOF(DCTELEM)) ); + end; + dtbl := fdct^.divisors[qtblno]; + for i := 0 to pred(DCTSIZE2) do + begin + dtbl^[i] := (DCTELEM(qtbl^.quantval[i])) shl 3; + end; + end; +{$endif} +{$ifdef DCT_IFAST_SUPPORTED} + JDCT_IFAST: + begin + { For AA&N IDCT method, divisors are equal to quantization + coefficients scaled by scalefactor[row]*scalefactor[col], where + scalefactor[0] := 1 + scalefactor[k] := cos(k*PI/16) * sqrt(2) for k=1..7 + We apply a further scale factor of 8. } + + + if (fdct^.divisors[qtblno] = NIL) then + begin + fdct^.divisors[qtblno] := DCTELEM_FIELD_PTR( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + DCTSIZE2 * SIZEOF(DCTELEM)) ); + end; + dtbl := fdct^.divisors[qtblno]; + for i := 0 to pred(DCTSIZE2) do + begin + dtbl^[i] := DCTELEM( + {MULTIPLY16V16} + DESCALE( INT32(qtbl^.quantval[i]) * INT32 (aanscales[i]), + CONST_BITS-3) ); + end; + end; +{$endif} +{$ifdef DCT_FLOAT_SUPPORTED} + + JDCT_FLOAT: + begin + { For float AA&N IDCT method, divisors are equal to quantization + coefficients scaled by scalefactor[row]*scalefactor[col], where + scalefactor[0] := 1 + scalefactor[k] := cos(k*PI/16) * sqrt(2) for k=1..7 + We apply a further scale factor of 8. + What's actually stored is 1/divisor so that the inner loop can + use a multiplication rather than a division. } + + if (fdct^.float_divisors[qtblno] = NIL) then + begin + fdct^.float_divisors[qtblno] := FAST_FLOAT_FIELD_PTR( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + DCTSIZE2 * SIZEOF(FAST_FLOAT)) ); + end; + fdtbl := fdct^.float_divisors[qtblno]; + i := 0; + for row := 0 to pred(DCTSIZE) do + begin + for col := 0 to pred(DCTSIZE) do + begin + fdtbl^[i] := {FAST_FLOAT} + (1.0 / (( {double}(qtbl^.quantval[i]) * + aanscalefactor[row] * aanscalefactor[col] * 8.0))); + Inc(i); + end; + end; + end; +{$endif} + else + ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); + end; + Inc(compptr); + end; +end; + + +{ Perform forward DCT on one or more blocks of a component. + + The input samples are taken from the sample_data[] array starting at + position start_row/start_col, and moving to the right for any additional + blocks. The quantized coefficients are returned in coef_blocks[]. } + +{METHODDEF} +procedure forward_DCT (cinfo : j_compress_ptr; + compptr : jpeg_component_info_ptr; + sample_data : JSAMPARRAY; + coef_blocks : JBLOCKROW; + start_row : JDIMENSION; + start_col : JDIMENSION; + num_blocks : JDIMENSION); +{ This version is used for integer DCT implementations. } +var + { This routine is heavily used, so it's worth coding it tightly. } + fdct : my_fdct_ptr; + do_dct : forward_DCT_method_ptr; + divisors : DCTELEM_FIELD_PTR; + workspace : array[0..DCTSIZE2-1] of DCTELEM; { work area for FDCT subroutine } + bi : JDIMENSION; +var + {register} workspaceptr : DCTELEMPTR; + {register} elemptr : JSAMPLE_PTR; + {register} elemr : int; +{$ifndef DCTSIZE_IS_8} +var + {register} elemc : int; +{$endif} +var + {register} temp, qval : DCTELEM; + {register} i : int; + {register} output_ptr : JCOEFPTR; +begin + fdct := my_fdct_ptr (cinfo^.fdct); + do_dct := fdct^.do_dct; + divisors := fdct^.divisors[compptr^.quant_tbl_no]; + + Inc(JSAMPROW_PTR(sample_data), start_row); { fold in the vertical offset once } + + for bi := 0 to pred(num_blocks) do + begin + + { Load data into workspace, applying unsigned->signed conversion } + + workspaceptr := @workspace[0]; + for elemr := 0 to pred(DCTSIZE) do + begin + elemptr := @sample_data^[elemr]^[start_col]; +{$ifdef DCTSIZE_IS_8} { unroll the inner loop } + workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; + Inc(workspaceptr); + Inc(elemptr); + workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; + Inc(workspaceptr); + Inc(elemptr); + workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; + Inc(workspaceptr); + Inc(elemptr); + workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; + Inc(workspaceptr); + Inc(elemptr); + workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; + Inc(workspaceptr); + Inc(elemptr); + workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; + Inc(workspaceptr); + Inc(elemptr); + workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; + Inc(workspaceptr); + Inc(elemptr); + workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; + Inc(workspaceptr); + {Inc(elemptr); - Value never used } +{$else} + for elemc := pred(DCTSIZE) downto 0 do + begin + workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; + Inc(workspaceptr); + Inc(elemptr); + end; +{$endif} + end; + + { Perform the DCT } + do_dct (workspace); + + { Quantize/descale the coefficients, and store into coef_blocks[] } + + output_ptr := JCOEFPTR(@coef_blocks^[bi]); + for i := 0 to pred(DCTSIZE2) do + begin + qval := divisors^[i]; + temp := workspace[i]; + { Divide the coefficient value by qval, ensuring proper rounding. + Since C does not specify the direction of rounding for negative + quotients, we have to force the dividend positive for portability. + + In most files, at least half of the output values will be zero + (at default quantization settings, more like three-quarters...) + so we should ensure that this case is fast. On many machines, + a comparison is enough cheaper than a divide to make a special test + a win. Since both inputs will be nonnegative, we need only test + for a < b to discover whether a/b is 0. + If your machine's division is fast enough, define FAST_DIVIDE. } + + if (temp < 0) then + begin + temp := -temp; + Inc(temp, qval shr 1); { for rounding } + {DIVIDE_BY(temp, qval);} + {$ifdef FAST_DIVIDE} + temp := temp div qval; + {$else} + if (temp >= qval) then + temp := temp div qval + else + temp := 0; + {$endif} + temp := -temp; + end + else + begin + Inc(temp, qval shr 1); { for rounding } + {DIVIDE_BY(temp, qval);} + {$ifdef FAST_DIVIDE} + temp := temp div qval; + {$else} + if (temp >= qval) then + temp := temp div qval + else + temp := 0; + {$endif} + end; + output_ptr^[i] := JCOEF (temp); + end; + Inc(start_col, DCTSIZE); + end; +end; + + +{$ifdef DCT_FLOAT_SUPPORTED} + +{METHODDEF} +procedure forward_DCT_float (cinfo : j_compress_ptr; + compptr : jpeg_component_info_ptr; + sample_data : JSAMPARRAY; + coef_blocks : JBLOCKROW; + start_row : JDIMENSION; + start_col : JDIMENSION; + num_blocks : JDIMENSION); +{ This version is used for floating-point DCT implementations. } +var + { This routine is heavily used, so it's worth coding it tightly. } + fdct : my_fdct_ptr; + do_dct : float_DCT_method_ptr; + divisors : FAST_FLOAT_FIELD_PTR; + workspace : array[0..DCTSIZE2-1] of FAST_FLOAT; { work area for FDCT subroutine } + bi : JDIMENSION; +var + {register} workspaceptr : FAST_FLOAT_PTR; + {register} elemptr : JSAMPLE_PTR; + {register} elemr : int; +{$ifndef DCTSIZE_IS_8} +var + {register} elemc : int; +{$endif} +var + {register} temp : FAST_FLOAT; + {register} i : int; + {register} output_ptr : JCOEFPTR; +begin + fdct := my_fdct_ptr (cinfo^.fdct); + do_dct := fdct^.do_float_dct; + divisors := fdct^.float_divisors[compptr^.quant_tbl_no]; + + Inc(JSAMPROW_PTR(sample_data), start_row); { fold in the vertical offset once } + + for bi := 0 to pred(num_blocks) do + begin + { Load data into workspace, applying unsigned->signed conversion } + + workspaceptr := @workspace[0]; + for elemr := 0 to pred(DCTSIZE) do + begin + elemptr := @(sample_data^[elemr]^[start_col]); +{$ifdef DCTSIZE_IS_8} { unroll the inner loop } + workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); + Inc(workspaceptr); + Inc(elemptr); + workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); + Inc(workspaceptr); + Inc(elemptr); + workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); + Inc(workspaceptr); + Inc(elemptr); + workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); + Inc(workspaceptr); + Inc(elemptr); + workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); + Inc(workspaceptr); + Inc(elemptr); + workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); + Inc(workspaceptr); + Inc(elemptr); + workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); + Inc(workspaceptr); + Inc(elemptr); + workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); + Inc(workspaceptr); + {Inc(elemptr); - value never used } +{$else} + for elemc := pred(DCTSIZE) downto 0 do + begin + workspaceptr^ := {FAST_FLOAT}( + (GETJSAMPLE(elemptr^) - CENTERJSAMPLE) ); + Inc(workspaceptr); + Inc(elemptr); + end; +{$endif} + end; + + + { Perform the DCT } + do_dct (workspace); + + { Quantize/descale the coefficients, and store into coef_blocks[] } + + output_ptr := JCOEFPTR(@(coef_blocks^[bi])); + + for i := 0 to pred(DCTSIZE2) do + begin + { Apply the quantization and scaling factor } + temp := workspace[i] * divisors^[i]; + { Round to nearest integer. + Since C does not specify the direction of rounding for negative + quotients, we have to force the dividend positive for portability. + The maximum coefficient size is +-16K (for 12-bit data), so this + code should work for either 16-bit or 32-bit ints. } + output_ptr^[i] := JCOEF ( int(Trunc (temp + {FAST_FLOAT}(16384.5))) - 16384); + end; + Inc(start_col, DCTSIZE); + end; +end; + +{$endif} { DCT_FLOAT_SUPPORTED } + + +{ Initialize FDCT manager. } + +{GLOBAL} +procedure jinit_forward_dct (cinfo : j_compress_ptr); +var + fdct : my_fdct_ptr; + i : int; +begin + fdct := my_fdct_ptr( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + SIZEOF(my_fdct_controller)) ); + cinfo^.fdct := jpeg_forward_dct_ptr (fdct); + fdct^.pub.start_pass := start_pass_fdctmgr; + + case (cinfo^.dct_method) of +{$ifdef DCT_ISLOW_SUPPORTED} + JDCT_ISLOW: + begin + fdct^.pub.forward_DCT := forward_DCT; + fdct^.do_dct := jpeg_fdct_islow; + end; +{$endif} +{$ifdef DCT_IFAST_SUPPORTED} + JDCT_IFAST: + begin + fdct^.pub.forward_DCT := forward_DCT; + fdct^.do_dct := jpeg_fdct_ifast; + end; +{$endif} +{$ifdef DCT_FLOAT_SUPPORTED} + JDCT_FLOAT: + begin + fdct^.pub.forward_DCT := forward_DCT_float; + fdct^.do_float_dct := jpeg_fdct_float; + end; +{$endif} + else + ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); + end; + + { Mark divisor tables unallocated } + for i := 0 to pred(NUM_QUANT_TBLS) do + begin + fdct^.divisors[i] := NIL; +{$ifdef DCT_FLOAT_SUPPORTED} + fdct^.float_divisors[i] := NIL; +{$endif} + end; +end; + +end. diff --git a/Imaging/JpegLib/imjchuff.pas b/Imaging/JpegLib/imjchuff.pas index 5691aa4..ff004a4 100644 --- a/Imaging/JpegLib/imjchuff.pas +++ b/Imaging/JpegLib/imjchuff.pas @@ -1,1116 +1,1116 @@ -unit imjchuff; - -{ This file contains Huffman entropy encoding routines. - - Much of the complexity here has to do with supporting output suspension. - If the data destination module demands suspension, we want to be able to - back up to the start of the current MCU. To do this, we copy state - variables into local working storage, and update them back to the - permanent JPEG objects only upon successful completion of an MCU. } - -{ Original: jchuff.c; Copyright (C) 1991-1997, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, { longptr definition missing } - imjpeglib, - imjdeferr, - imjerror, - imjutils, - imjinclude, - imjcomapi; - -{ The legal range of a DCT coefficient is - -1024 .. +1023 for 8-bit data; - -16384 .. +16383 for 12-bit data. - Hence the magnitude should always fit in 10 or 14 bits respectively. } - - -{$ifdef BITS_IN_JSAMPLE_IS_8} -const - MAX_COEF_BITS = 10; -{$else} -const - MAX_COEF_BITS = 14; -{$endif} - -{ Derived data constructed for each Huffman table } -{ Declarations shared with jcphuff.c } -type - c_derived_tbl_ptr = ^c_derived_tbl; - c_derived_tbl = record - ehufco : array[0..256-1] of uInt; { code for each symbol } - ehufsi : array[0..256-1] of byte; { length of code for each symbol } - { If no code has been allocated for a symbol S, ehufsi[S] contains 0 } - end; -{ for JCHUFF und JCPHUFF } -type - TLongTable = array[0..256] of long; - TLongTablePtr = ^TLongTable; - -{ Compute the derived values for a Huffman table. - Note this is also used by jcphuff.c. } - -{GLOBAL} -procedure jpeg_make_c_derived_tbl (cinfo : j_compress_ptr; - isDC : boolean; - tblno : int; - var pdtbl : c_derived_tbl_ptr); - -{ Generate the optimal coding for the given counts, fill htbl. - Note this is also used by jcphuff.c. } - -{GLOBAL} -procedure jpeg_gen_optimal_table (cinfo : j_compress_ptr; - htbl : JHUFF_TBL_PTR; - var freq : TLongTable); { Nomssi } - -{ Module initialization routine for Huffman entropy encoding. } - -{GLOBAL} -procedure jinit_huff_encoder (cinfo : j_compress_ptr); - -implementation - -{ Expanded entropy encoder object for Huffman encoding. - - The savable_state subrecord contains fields that change within an MCU, - but must not be updated permanently until we complete the MCU. } - -type - savable_state = record - put_buffer : INT32; { current bit-accumulation buffer } - put_bits : int; { # of bits now in it } - last_dc_val : array[0..MAX_COMPS_IN_SCAN-1] of int; - { last DC coef for each component } - end; - - -type - huff_entropy_ptr = ^huff_entropy_encoder; - huff_entropy_encoder = record - pub : jpeg_entropy_encoder; { public fields } - - saved : savable_state; { Bit buffer & DC state at start of MCU } - - { These fields are NOT loaded into local working state. } - restarts_to_go : uInt; { MCUs left in this restart interval } - next_restart_num : int; { next restart number to write (0-7) } - - { Pointers to derived tables (these workspaces have image lifespan) } - dc_derived_tbls : array[0..NUM_HUFF_TBLS-1] of c_derived_tbl_ptr; - ac_derived_tbls : array[0..NUM_HUFF_TBLS-1] of c_derived_tbl_ptr; - - {$ifdef ENTROPY_OPT_SUPPORTED} { Statistics tables for optimization } - dc_count_ptrs : array[0..NUM_HUFF_TBLS-1] of TLongTablePtr; - ac_count_ptrs : array[0..NUM_HUFF_TBLS-1] of TLongTablePtr; - {$endif} - end; - - - -{ Working state while writing an MCU. - This struct contains all the fields that are needed by subroutines. } - -type - working_state = record - next_output_byte : JOCTETptr; { => next byte to write in buffer } - free_in_buffer : size_t; { # of byte spaces remaining in buffer } - cur : savable_state; { Current bit buffer & DC state } - cinfo : j_compress_ptr; { dump_buffer needs access to this } - end; - - -{ Forward declarations } -{METHODDEF} -function encode_mcu_huff (cinfo : j_compress_ptr; - const MCU_data : array of JBLOCKROW) : boolean; - forward; -{METHODDEF} -procedure finish_pass_huff (cinfo : j_compress_ptr); forward; -{$ifdef ENTROPY_OPT_SUPPORTED} -{METHODDEF} -function encode_mcu_gather (cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; - forward; - -{METHODDEF} -procedure finish_pass_gather (cinfo : j_compress_ptr); forward; -{$endif} - - -{ Initialize for a Huffman-compressed scan. - If gather_statistics is TRUE, we do not output anything during the scan, - just count the Huffman symbols used and generate Huffman code tables. } - -{METHODDEF} -procedure start_pass_huff (cinfo : j_compress_ptr; - gather_statistics : boolean); -var - entropy : huff_entropy_ptr; - ci, dctbl, actbl : int; - compptr : jpeg_component_info_ptr; -begin - entropy := huff_entropy_ptr (cinfo^.entropy); - - if (gather_statistics) then - begin -{$ifdef ENTROPY_OPT_SUPPORTED} - entropy^.pub.encode_mcu := encode_mcu_gather; - entropy^.pub.finish_pass := finish_pass_gather; -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); -{$endif} - end - else - begin - entropy^.pub.encode_mcu := encode_mcu_huff; - entropy^.pub.finish_pass := finish_pass_huff; - end; - - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - dctbl := compptr^.dc_tbl_no; - actbl := compptr^.ac_tbl_no; - if (gather_statistics) then - begin -{$ifdef ENTROPY_OPT_SUPPORTED} - { Check for invalid table indexes } - { (make_c_derived_tbl does this in the other path) } - if (dctbl < 0) or (dctbl >= NUM_HUFF_TBLS) then - ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, dctbl); - if (actbl < 0) or (actbl >= NUM_HUFF_TBLS) then - ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, actbl); - { Allocate and zero the statistics tables } - { Note that jpeg_gen_optimal_table expects 257 entries in each table! } - if (entropy^.dc_count_ptrs[dctbl] = NIL) then - entropy^.dc_count_ptrs[dctbl] := TLongTablePtr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - 257 * SIZEOF(long)) ); - MEMZERO(entropy^.dc_count_ptrs[dctbl], 257 * SIZEOF(long)); - if (entropy^.ac_count_ptrs[actbl] = NIL) then - entropy^.ac_count_ptrs[actbl] := TLongTablePtr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - 257 * SIZEOF(long)) ); - MEMZERO(entropy^.ac_count_ptrs[actbl], 257 * SIZEOF(long)); -{$endif} - end - else - begin - { Compute derived values for Huffman tables } - { We may do this more than once for a table, but it's not expensive } - jpeg_make_c_derived_tbl(cinfo, TRUE, dctbl, - entropy^.dc_derived_tbls[dctbl]); - jpeg_make_c_derived_tbl(cinfo, FALSE, actbl, - entropy^.ac_derived_tbls[actbl]); - end; - { Initialize DC predictions to 0 } - entropy^.saved.last_dc_val[ci] := 0; - end; - - { Initialize bit buffer to empty } - entropy^.saved.put_buffer := 0; - entropy^.saved.put_bits := 0; - - { Initialize restart stuff } - entropy^.restarts_to_go := cinfo^.restart_interval; - entropy^.next_restart_num := 0; -end; - - -{ Compute the derived values for a Huffman table. - This routine also performs some validation checks on the table. - - Note this is also used by jcphuff.c. } - -{GLOBAL} -procedure jpeg_make_c_derived_tbl (cinfo : j_compress_ptr; - isDC : boolean; - tblno : int; - var pdtbl : c_derived_tbl_ptr); -var - htbl : JHUFF_TBL_PTR; - dtbl : c_derived_tbl_ptr; - p, i, l, lastp, si, maxsymbol : int; - huffsize : array[0..257-1] of byte; - huffcode : array[0..257-1] of uInt; - code : uInt; -begin - { Note that huffsize[] and huffcode[] are filled in code-length order, - paralleling the order of the symbols themselves in htbl->huffval[]. } - - { Find the input Huffman table } - if (tblno < 0) or (tblno >= NUM_HUFF_TBLS) then - ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, tblno); - if isDC then - htbl := cinfo^.dc_huff_tbl_ptrs[tblno] - else - htbl := cinfo^.ac_huff_tbl_ptrs[tblno]; - if (htbl = NIL) then - ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, tblno); - - { Allocate a workspace if we haven't already done so. } - if (pdtbl = NIL) then - pdtbl := c_derived_tbl_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(c_derived_tbl)) ); - dtbl := pdtbl; - - { Figure C.1: make table of Huffman code length for each symbol } - - p := 0; - for l := 1 to 16 do - begin - i := int(htbl^.bits[l]); - if (i < 0) and (p + i > 256) then { protect against table overrun } - ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE); - while (i > 0) do - begin - huffsize[p] := byte(l); - Inc(p); - Dec(i); - end; - end; - huffsize[p] := 0; - lastp := p; - - { Figure C.2: generate the codes themselves } - { We also validate that the counts represent a legal Huffman code tree. } - - code := 0; - si := huffsize[0]; - p := 0; - while (huffsize[p] <> 0) do - begin - while (( int(huffsize[p]) ) = si) do - begin - huffcode[p] := code; - Inc(p); - Inc(code); - end; - { code is now 1 more than the last code used for codelength si; but - it must still fit in si bits, since no code is allowed to be all ones. } - - if (INT32(code) >= (INT32(1) shl si)) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE); - code := code shl 1; - Inc(si); - end; - - { Figure C.3: generate encoding tables } - { These are code and size indexed by symbol value } - - { Set all codeless symbols to have code length 0; - this lets us detect duplicate VAL entries here, and later - allows emit_bits to detect any attempt to emit such symbols. } - - MEMZERO(@dtbl^.ehufsi, SIZEOF(dtbl^.ehufsi)); - - { This is also a convenient place to check for out-of-range - and duplicated VAL entries. We allow 0..255 for AC symbols - but only 0..15 for DC. (We could constrain them further - based on data depth and mode, but this seems enough.) } - - if isDC then - maxsymbol := 15 - else - maxsymbol := 255; - - for p := 0 to pred(lastp) do - begin - i := htbl^.huffval[p]; - if (i < 0) or (i > maxsymbol) or (dtbl^.ehufsi[i] <> 0) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE); - dtbl^.ehufco[i] := huffcode[p]; - dtbl^.ehufsi[i] := huffsize[p]; - end; -end; - - -{ Outputting bytes to the file } - - -{LOCAL} -function dump_buffer (var state : working_state) : boolean; -{ Empty the output buffer; return TRUE if successful, FALSE if must suspend } -var - dest : jpeg_destination_mgr_ptr; -begin - dest := state.cinfo^.dest; - - if (not dest^.empty_output_buffer (state.cinfo)) then - begin - dump_buffer := FALSE; - exit; - end; - { After a successful buffer dump, must reset buffer pointers } - state.next_output_byte := dest^.next_output_byte; - state.free_in_buffer := dest^.free_in_buffer; - dump_buffer := TRUE; -end; - - -{ Outputting bits to the file } - -{ Only the right 24 bits of put_buffer are used; the valid bits are - left-justified in this part. At most 16 bits can be passed to emit_bits - in one call, and we never retain more than 7 bits in put_buffer - between calls, so 24 bits are sufficient. } - - -{LOCAL} -function emit_bits (var state : working_state; - code : uInt; - size : int) : boolean; {INLINE} -{ Emit some bits; return TRUE if successful, FALSE if must suspend } -var - { This routine is heavily used, so it's worth coding tightly. } - {register} put_buffer : INT32; - {register} put_bits : int; -var - c : int; -begin - put_buffer := INT32 (code); - put_bits := state.cur.put_bits; - - { if size is 0, caller used an invalid Huffman table entry } - if (size = 0) then - ERREXIT(j_common_ptr(state.cinfo), JERR_HUFF_MISSING_CODE); - - put_buffer := put_buffer and pred(INT32(1) shl size); - { mask off any extra bits in code } - - Inc(put_bits, size); { new number of bits in buffer } - - put_buffer := put_buffer shl (24 - put_bits); - { align incoming bits } - put_buffer := put_buffer or state.cur.put_buffer; - { and merge with old buffer contents } - while (put_bits >= 8) do - begin - c := int ((put_buffer shr 16) and $FF); - - {emit_byte(state, c, return FALSE);} - { Emit a byte, return FALSE if must suspend. } - state.next_output_byte^ := JOCTET (c); - Inc(state.next_output_byte); - Dec(state.free_in_buffer); - if (state.free_in_buffer = 0) then - if not dump_buffer(state) then - begin - emit_bits := FALSE; - exit; - end; - - if (c = $FF) then { need to stuff a zero byte? } - begin - {emit_byte(state, 0, return FALSE);} - state.next_output_byte^ := JOCTET (0); - Inc(state.next_output_byte); - Dec(state.free_in_buffer); - if (state.free_in_buffer = 0) then - if not dump_buffer(state) then - begin - emit_bits := FALSE; - exit; - end; - - end; - put_buffer := put_buffer shl 8; - Dec(put_bits, 8); - end; - - state.cur.put_buffer := put_buffer; { update state variables } - state.cur.put_bits := put_bits; - - emit_bits := TRUE; -end; - - -{LOCAL} -function flush_bits (var state : working_state) : boolean; -begin - if (not emit_bits(state, $7F, 7)) then { fill any partial byte with ones } - begin - flush_bits := FALSE; - exit; - end; - state.cur.put_buffer := 0; { and reset bit-buffer to empty } - state.cur.put_bits := 0; - flush_bits := TRUE; -end; - - -{ Encode a single block's worth of coefficients } - -{LOCAL} -function encode_one_block (var state : working_state; - const block : JBLOCK; - last_dc_val : int; - dctbl : c_derived_tbl_ptr; - actbl : c_derived_tbl_ptr) : boolean; -var - {register} temp, temp2 : int; - {register} nbits : int; - {register} k, r, i : int; -begin - { Encode the DC coefficient difference per section F.1.2.1 } - - temp2 := block[0] - last_dc_val; - temp := temp2; - - if (temp < 0) then - begin - temp := -temp; { temp is abs value of input } - { For a negative input, want temp2 := bitwise complement of abs(input) } - { This code assumes we are on a two's complement machine } - Dec(temp2); - end; - - { Find the number of bits needed for the magnitude of the coefficient } - nbits := 0; - while (temp <> 0) do - begin - Inc(nbits); - temp := temp shr 1; - end; - - { Check for out-of-range coefficient values. - Since we're encoding a difference, the range limit is twice as much. } - - if (nbits > MAX_COEF_BITS+1) then - ERREXIT(j_common_ptr(state.cinfo), JERR_BAD_DCT_COEF); - - { Emit the Huffman-coded symbol for the number of bits } - if not emit_bits(state, dctbl^.ehufco[nbits], dctbl^.ehufsi[nbits]) then - begin - encode_one_block := FALSE; - exit; - end; - - { Emit that number of bits of the value, if positive, } - { or the complement of its magnitude, if negative. } - if (nbits <> 0) then { emit_bits rejects calls with size 0 } - if not emit_bits(state, uInt(temp2), nbits) then - begin - encode_one_block := FALSE; - exit; - end; - - { Encode the AC coefficients per section F.1.2.2 } - - r := 0; { r := run length of zeros } - - for k := 1 to pred(DCTSIZE2) do - begin - temp := block[jpeg_natural_order[k]]; - if (temp = 0) then - begin - Inc(r); - end - else - begin - { if run length > 15, must emit special run-length-16 codes ($F0) } - while (r > 15) do - begin - if not emit_bits(state, actbl^.ehufco[$F0], actbl^.ehufsi[$F0]) then - begin - encode_one_block := FALSE; - exit; - end; - Dec(r, 16); - end; - - temp2 := temp; - if (temp < 0) then - begin - temp := -temp; { temp is abs value of input } - { This code assumes we are on a two's complement machine } - Dec(temp2); - end; - - { Find the number of bits needed for the magnitude of the coefficient } - nbits := 0; { there must be at least one 1 bit } - repeat - Inc(nbits); - temp := temp shr 1; - until (temp = 0); - - { Check for out-of-range coefficient values } - if (nbits > MAX_COEF_BITS) then - ERREXIT(j_common_ptr(state.cinfo), JERR_BAD_DCT_COEF); - - { Emit Huffman symbol for run length / number of bits } - i := (r shl 4) + nbits; - if not emit_bits(state, actbl^.ehufco[i], actbl^.ehufsi[i]) then - begin - encode_one_block := FALSE; - exit; - end; - - { Emit that number of bits of the value, if positive, } - { or the complement of its magnitude, if negative. } - if not emit_bits(state, uInt(temp2), nbits) then - begin - encode_one_block := FALSE; - exit; - end; - - r := 0; - end; - end; - - { If the last coef(s) were zero, emit an end-of-block code } - if (r > 0) then - if not emit_bits(state, actbl^.ehufco[0], actbl^.ehufsi[0]) then - begin - encode_one_block := FALSE; - exit; - end; - - encode_one_block := TRUE; -end; - - -{ Emit a restart marker & resynchronize predictions. } - -{LOCAL} -function emit_restart (var state : working_state; - restart_num : int) : boolean; -var - ci : int; -begin - if (not flush_bits(state)) then - begin - emit_restart := FALSE; - exit; - end; - - {emit_byte(state, $FF, return FALSE);} - { Emit a byte, return FALSE if must suspend. } - state.next_output_byte^ := JOCTET ($FF); - Inc(state.next_output_byte); - Dec(state.free_in_buffer); - if (state.free_in_buffer = 0) then - if not dump_buffer(state) then - begin - emit_restart := FALSE; - exit; - end; - - {emit_byte(state, JPEG_RST0 + restart_num, return FALSE);} - { Emit a byte, return FALSE if must suspend. } - state.next_output_byte^ := JOCTET (JPEG_RST0 + restart_num); - Inc(state.next_output_byte); - Dec(state.free_in_buffer); - if (state.free_in_buffer = 0) then - if not dump_buffer(state) then - begin - emit_restart := FALSE; - exit; - end; - - { Re-initialize DC predictions to 0 } - for ci := 0 to pred(state.cinfo^.comps_in_scan) do - state.cur.last_dc_val[ci] := 0; - - { The restart counter is not updated until we successfully write the MCU. } - - emit_restart := TRUE; -end; - - -{ Encode and output one MCU's worth of Huffman-compressed coefficients. } - -{METHODDEF} -function encode_mcu_huff (cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; -var - entropy : huff_entropy_ptr; - state : working_state; - blkn, ci : int; - compptr : jpeg_component_info_ptr; -begin - entropy := huff_entropy_ptr (cinfo^.entropy); - { Load up working state } - state.next_output_byte := cinfo^.dest^.next_output_byte; - state.free_in_buffer := cinfo^.dest^.free_in_buffer; - {ASSIGN_STATE(state.cur, entropy^.saved);} - state.cur := entropy^.saved; - state.cinfo := cinfo; - - { Emit restart marker if needed } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - if not emit_restart(state, entropy^.next_restart_num) then - begin - encode_mcu_huff := FALSE; - exit; - end; - end; - - { Encode the MCU data blocks } - for blkn := 0 to pred(cinfo^.blocks_in_MCU) do - begin - ci := cinfo^.MCU_membership[blkn]; - compptr := cinfo^.cur_comp_info[ci]; - if not encode_one_block(state, - MCU_data[blkn]^[0], - state.cur.last_dc_val[ci], - entropy^.dc_derived_tbls[compptr^.dc_tbl_no], - entropy^.ac_derived_tbls[compptr^.ac_tbl_no]) then - begin - encode_mcu_huff := FALSE; - exit; - end; - { Update last_dc_val } - state.cur.last_dc_val[ci] := MCU_data[blkn]^[0][0]; - end; - - { Completed MCU, so update state } - cinfo^.dest^.next_output_byte := state.next_output_byte; - cinfo^.dest^.free_in_buffer := state.free_in_buffer; - {ASSIGN_STATE(entropy^.saved, state.cur);} - entropy^.saved := state.cur; - - { Update restart-interval state too } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - begin - entropy^.restarts_to_go := cinfo^.restart_interval; - Inc(entropy^.next_restart_num); - with entropy^ do - next_restart_num := next_restart_num and 7; - end; - Dec(entropy^.restarts_to_go); - end; - - encode_mcu_huff := TRUE; -end; - - -{ Finish up at the end of a Huffman-compressed scan. } - -{METHODDEF} -procedure finish_pass_huff (cinfo : j_compress_ptr); -var - entropy : huff_entropy_ptr; - state : working_state; -begin - entropy := huff_entropy_ptr (cinfo^.entropy); - - { Load up working state ... flush_bits needs it } - state.next_output_byte := cinfo^.dest^.next_output_byte; - state.free_in_buffer := cinfo^.dest^.free_in_buffer; - {ASSIGN_STATE(state.cur, entropy^.saved);} - state.cur := entropy^.saved; - state.cinfo := cinfo; - - { Flush out the last data } - if not flush_bits(state) then - ERREXIT(j_common_ptr(cinfo), JERR_CANT_SUSPEND); - - { Update state } - cinfo^.dest^.next_output_byte := state.next_output_byte; - cinfo^.dest^.free_in_buffer := state.free_in_buffer; - {ASSIGN_STATE(entropy^.saved, state.cur);} - entropy^.saved := state.cur; -end; - - -{ Huffman coding optimization. - - We first scan the supplied data and count the number of uses of each symbol - that is to be Huffman-coded. (This process MUST agree with the code above.) - Then we build a Huffman coding tree for the observed counts. - Symbols which are not needed at all for the particular image are not - assigned any code, which saves space in the DHT marker as well as in - the compressed data. } - -{$ifdef ENTROPY_OPT_SUPPORTED} - - -{ Process a single block's worth of coefficients } - -{LOCAL} -procedure htest_one_block (cinfo : j_compress_ptr; - const block : JBLOCK; - last_dc_val : int; - dc_counts : TLongTablePtr; - ac_counts : TLongTablePtr); - -var - {register} temp : int; - {register} nbits : int; - {register} k, r : int; -begin - { Encode the DC coefficient difference per section F.1.2.1 } - temp := block[0] - last_dc_val; - if (temp < 0) then - temp := -temp; - - { Find the number of bits needed for the magnitude of the coefficient } - nbits := 0; - while (temp <> 0) do - begin - Inc(nbits); - temp := temp shr 1; - end; - - { Check for out-of-range coefficient values. - Since we're encoding a difference, the range limit is twice as much. } - - if (nbits > MAX_COEF_BITS+1) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_DCT_COEF); - - { Count the Huffman symbol for the number of bits } - Inc(dc_counts^[nbits]); - - { Encode the AC coefficients per section F.1.2.2 } - - r := 0; { r := run length of zeros } - - for k := 1 to pred(DCTSIZE2) do - begin - temp := block[jpeg_natural_order[k]]; - if (temp = 0) then - begin - Inc(r); - end - else - begin - { if run length > 15, must emit special run-length-16 codes ($F0) } - while (r > 15) do - begin - Inc(ac_counts^[$F0]); - Dec(r, 16); - end; - - { Find the number of bits needed for the magnitude of the coefficient } - if (temp < 0) then - temp := -temp; - - { Find the number of bits needed for the magnitude of the coefficient } - nbits := 0; { there must be at least one 1 bit } - repeat - Inc(nbits); - temp := temp shr 1; - until (temp = 0); - - - { Count Huffman symbol for run length / number of bits } - Inc(ac_counts^[(r shl 4) + nbits]); - - r := 0; - end; - end; - - { If the last coef(s) were zero, emit an end-of-block code } - if (r > 0) then - Inc(ac_counts^[0]); -end; - - -{ Trial-encode one MCU's worth of Huffman-compressed coefficients. - No data is actually output, so no suspension return is possible. } - -{METHODDEF} -function encode_mcu_gather (cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; -var - entropy : huff_entropy_ptr; - blkn, ci : int; - compptr : jpeg_component_info_ptr; -begin - entropy := huff_entropy_ptr (cinfo^.entropy); - { Take care of restart intervals if needed } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - begin - { Re-initialize DC predictions to 0 } - for ci := 0 to pred(cinfo^.comps_in_scan) do - entropy^.saved.last_dc_val[ci] := 0; - { Update restart state } - entropy^.restarts_to_go := cinfo^.restart_interval; - end; - Dec(entropy^.restarts_to_go); - end; - - for blkn := 0 to pred(cinfo^.blocks_in_MCU) do - begin - ci := cinfo^.MCU_membership[blkn]; - compptr := cinfo^.cur_comp_info[ci]; - htest_one_block(cinfo, MCU_data[blkn]^[0], - entropy^.saved.last_dc_val[ci], - entropy^.dc_count_ptrs[compptr^.dc_tbl_no], - entropy^.ac_count_ptrs[compptr^.ac_tbl_no]); - entropy^.saved.last_dc_val[ci] := MCU_data[blkn]^[0][0]; - end; - - encode_mcu_gather := TRUE; -end; - - -{ Generate the best Huffman code table for the given counts, fill htbl. - Note this is also used by jcphuff.c. - - The JPEG standard requires that no symbol be assigned a codeword of all - one bits (so that padding bits added at the end of a compressed segment - can't look like a valid code). Because of the canonical ordering of - codewords, this just means that there must be an unused slot in the - longest codeword length category. Section K.2 of the JPEG spec suggests - reserving such a slot by pretending that symbol 256 is a valid symbol - with count 1. In theory that's not optimal; giving it count zero but - including it in the symbol set anyway should give a better Huffman code. - But the theoretically better code actually seems to come out worse in - practice, because it produces more all-ones bytes (which incur stuffed - zero bytes in the final file). In any case the difference is tiny. - - The JPEG standard requires Huffman codes to be no more than 16 bits long. - If some symbols have a very small but nonzero probability, the Huffman tree - must be adjusted to meet the code length restriction. We currently use - the adjustment method suggested in JPEG section K.2. This method is *not* - optimal; it may not choose the best possible limited-length code. But - typically only very-low-frequency symbols will be given less-than-optimal - lengths, so the code is almost optimal. Experimental comparisons against - an optimal limited-length-code algorithm indicate that the difference is - microscopic --- usually less than a hundredth of a percent of total size. - So the extra complexity of an optimal algorithm doesn't seem worthwhile. } - - -{GLOBAL} -procedure jpeg_gen_optimal_table (cinfo : j_compress_ptr; - htbl : JHUFF_TBL_PTR; - var freq : TLongTable); -const - MAX_CLEN = 32; { assumed maximum initial code length } -var - bits : array[0..MAX_CLEN+1-1] of UINT8; { bits[k] := # of symbols with code length k } - codesize : array[0..257-1] of int; { codesize[k] := code length of symbol k } - others : array[0..257-1] of int; { next symbol in current branch of tree } - c1, c2 : int; - p, i, j : int; - v : long; -begin - { This algorithm is explained in section K.2 of the JPEG standard } - - MEMZERO(@bits, SIZEOF(bits)); - MEMZERO(@codesize, SIZEOF(codesize)); - for i := 0 to 256 do - others[i] := -1; { init links to empty } - - freq[256] := 1; { make sure 256 has a nonzero count } - { Including the pseudo-symbol 256 in the Huffman procedure guarantees - that no real symbol is given code-value of all ones, because 256 - will be placed last in the largest codeword category. } - - { Huffman's basic algorithm to assign optimal code lengths to symbols } - - while TRUE do - begin - { Find the smallest nonzero frequency, set c1 := its symbol } - { In case of ties, take the larger symbol number } - c1 := -1; - v := long(1000000000); - for i := 0 to 256 do - begin - if (freq[i] <> 0) and (freq[i] <= v) then - begin - v := freq[i]; - c1 := i; - end; - end; - - { Find the next smallest nonzero frequency, set c2 := its symbol } - { In case of ties, take the larger symbol number } - c2 := -1; - v := long(1000000000); - for i := 0 to 256 do - begin - if (freq[i] <> 0) and (freq[i] <= v) and (i <> c1) then - begin - v := freq[i]; - c2 := i; - end; - end; - - { Done if we've merged everything into one frequency } - if (c2 < 0) then - break; - - { Else merge the two counts/trees } - Inc(freq[c1], freq[c2]); - freq[c2] := 0; - - { Increment the codesize of everything in c1's tree branch } - Inc(codesize[c1]); - while (others[c1] >= 0) do - begin - c1 := others[c1]; - Inc(codesize[c1]); - end; - - others[c1] := c2; { chain c2 onto c1's tree branch } - - { Increment the codesize of everything in c2's tree branch } - Inc(codesize[c2]); - while (others[c2] >= 0) do - begin - c2 := others[c2]; - Inc(codesize[c2]); - end; - end; - - { Now count the number of symbols of each code length } - for i := 0 to 256 do - begin - if (codesize[i]<>0) then - begin - { The JPEG standard seems to think that this can't happen, } - { but I'm paranoid... } - if (codesize[i] > MAX_CLEN) then - ERREXIT(j_common_ptr(cinfo), JERR_HUFF_CLEN_OVERFLOW); - - Inc(bits[codesize[i]]); - end; - end; - - { JPEG doesn't allow symbols with code lengths over 16 bits, so if the pure - Huffman procedure assigned any such lengths, we must adjust the coding. - Here is what the JPEG spec says about how this next bit works: - Since symbols are paired for the longest Huffman code, the symbols are - removed from this length category two at a time. The prefix for the pair - (which is one bit shorter) is allocated to one of the pair; then, - skipping the BITS entry for that prefix length, a code word from the next - shortest nonzero BITS entry is converted into a prefix for two code words - one bit longer. } - - for i := MAX_CLEN downto 17 do - begin - while (bits[i] > 0) do - begin - j := i - 2; { find length of new prefix to be used } - while (bits[j] = 0) do - Dec(j); - - Dec(bits[i], 2); { remove two symbols } - Inc(bits[i-1]); { one goes in this length } - Inc(bits[j+1], 2); { two new symbols in this length } - Dec(bits[j]); { symbol of this length is now a prefix } - end; - end; - - { Delphi 2: FOR-loop variable 'i' may be undefined after loop } - i := 16; { Nomssi: work around } - - { Remove the count for the pseudo-symbol 256 from the largest codelength } - while (bits[i] = 0) do { find largest codelength still in use } - Dec(i); - Dec(bits[i]); - - { Return final symbol counts (only for lengths 0..16) } - MEMCOPY(@htbl^.bits, @bits, SIZEOF(htbl^.bits)); - - { Return a list of the symbols sorted by code length } - { It's not real clear to me why we don't need to consider the codelength - changes made above, but the JPEG spec seems to think this works. } - - p := 0; - for i := 1 to MAX_CLEN do - begin - for j := 0 to 255 do - begin - if (codesize[j] = i) then - begin - htbl^.huffval[p] := UINT8 (j); - Inc(p); - end; - end; - end; - - { Set sent_table FALSE so updated table will be written to JPEG file. } - htbl^.sent_table := FALSE; -end; - - -{ Finish up a statistics-gathering pass and create the new Huffman tables. } - -{METHODDEF} -procedure finish_pass_gather (cinfo : j_compress_ptr); -var - entropy : huff_entropy_ptr; - ci, dctbl, actbl : int; - compptr : jpeg_component_info_ptr; - htblptr : ^JHUFF_TBL_PTR; - did_dc : array[0..NUM_HUFF_TBLS-1] of boolean; - did_ac : array[0..NUM_HUFF_TBLS-1] of boolean; -begin - entropy := huff_entropy_ptr (cinfo^.entropy); - - { It's important not to apply jpeg_gen_optimal_table more than once - per table, because it clobbers the input frequency counts! } - - MEMZERO(@did_dc, SIZEOF(did_dc)); - MEMZERO(@did_ac, SIZEOF(did_ac)); - - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - dctbl := compptr^.dc_tbl_no; - actbl := compptr^.ac_tbl_no; - if (not did_dc[dctbl]) then - begin - htblptr := @(cinfo^.dc_huff_tbl_ptrs[dctbl]); - if ( htblptr^ = NIL) then - htblptr^ := jpeg_alloc_huff_table(j_common_ptr(cinfo)); - jpeg_gen_optimal_table(cinfo, htblptr^, entropy^.dc_count_ptrs[dctbl]^); - did_dc[dctbl] := TRUE; - end; - if (not did_ac[actbl]) then - begin - htblptr := @(cinfo^.ac_huff_tbl_ptrs[actbl]); - if ( htblptr^ = NIL) then - htblptr^ := jpeg_alloc_huff_table(j_common_ptr(cinfo)); - jpeg_gen_optimal_table(cinfo, htblptr^, entropy^.ac_count_ptrs[actbl]^); - did_ac[actbl] := TRUE; - end; - end; -end; - -{$endif} { ENTROPY_OPT_SUPPORTED } - - -{ Module initialization routine for Huffman entropy encoding. } - -{GLOBAL} -procedure jinit_huff_encoder (cinfo : j_compress_ptr); -var - entropy : huff_entropy_ptr; - i : int; -begin - entropy := huff_entropy_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(huff_entropy_encoder)) ); - cinfo^.entropy := jpeg_entropy_encoder_ptr (entropy); - entropy^.pub.start_pass := start_pass_huff; - - { Mark tables unallocated } - for i := 0 to pred(NUM_HUFF_TBLS) do - begin - entropy^.ac_derived_tbls[i] := NIL; - entropy^.dc_derived_tbls[i] := NIL; -{$ifdef ENTROPY_OPT_SUPPORTED} - entropy^.ac_count_ptrs[i] := NIL; - entropy^.dc_count_ptrs[i] := NIL; -{$endif} - end; -end; - -end. +unit imjchuff; + +{ This file contains Huffman entropy encoding routines. + + Much of the complexity here has to do with supporting output suspension. + If the data destination module demands suspension, we want to be able to + back up to the start of the current MCU. To do this, we copy state + variables into local working storage, and update them back to the + permanent JPEG objects only upon successful completion of an MCU. } + +{ Original: jchuff.c; Copyright (C) 1991-1997, Thomas G. Lane. } + +interface + +{$I imjconfig.inc} + +uses + imjmorecfg, { longptr definition missing } + imjpeglib, + imjdeferr, + imjerror, + imjutils, + imjinclude, + imjcomapi; + +{ The legal range of a DCT coefficient is + -1024 .. +1023 for 8-bit data; + -16384 .. +16383 for 12-bit data. + Hence the magnitude should always fit in 10 or 14 bits respectively. } + + +{$ifdef BITS_IN_JSAMPLE_IS_8} +const + MAX_COEF_BITS = 10; +{$else} +const + MAX_COEF_BITS = 14; +{$endif} + +{ Derived data constructed for each Huffman table } +{ Declarations shared with jcphuff.c } +type + c_derived_tbl_ptr = ^c_derived_tbl; + c_derived_tbl = record + ehufco : array[0..256-1] of uInt; { code for each symbol } + ehufsi : array[0..256-1] of byte; { length of code for each symbol } + { If no code has been allocated for a symbol S, ehufsi[S] contains 0 } + end; +{ for JCHUFF und JCPHUFF } +type + TLongTable = array[0..256] of long; + TLongTablePtr = ^TLongTable; + +{ Compute the derived values for a Huffman table. + Note this is also used by jcphuff.c. } + +{GLOBAL} +procedure jpeg_make_c_derived_tbl (cinfo : j_compress_ptr; + isDC : boolean; + tblno : int; + var pdtbl : c_derived_tbl_ptr); + +{ Generate the optimal coding for the given counts, fill htbl. + Note this is also used by jcphuff.c. } + +{GLOBAL} +procedure jpeg_gen_optimal_table (cinfo : j_compress_ptr; + htbl : JHUFF_TBL_PTR; + var freq : TLongTable); { Nomssi } + +{ Module initialization routine for Huffman entropy encoding. } + +{GLOBAL} +procedure jinit_huff_encoder (cinfo : j_compress_ptr); + +implementation + +{ Expanded entropy encoder object for Huffman encoding. + + The savable_state subrecord contains fields that change within an MCU, + but must not be updated permanently until we complete the MCU. } + +type + savable_state = record + put_buffer : INT32; { current bit-accumulation buffer } + put_bits : int; { # of bits now in it } + last_dc_val : array[0..MAX_COMPS_IN_SCAN-1] of int; + { last DC coef for each component } + end; + + +type + huff_entropy_ptr = ^huff_entropy_encoder; + huff_entropy_encoder = record + pub : jpeg_entropy_encoder; { public fields } + + saved : savable_state; { Bit buffer & DC state at start of MCU } + + { These fields are NOT loaded into local working state. } + restarts_to_go : uInt; { MCUs left in this restart interval } + next_restart_num : int; { next restart number to write (0-7) } + + { Pointers to derived tables (these workspaces have image lifespan) } + dc_derived_tbls : array[0..NUM_HUFF_TBLS-1] of c_derived_tbl_ptr; + ac_derived_tbls : array[0..NUM_HUFF_TBLS-1] of c_derived_tbl_ptr; + + {$ifdef ENTROPY_OPT_SUPPORTED} { Statistics tables for optimization } + dc_count_ptrs : array[0..NUM_HUFF_TBLS-1] of TLongTablePtr; + ac_count_ptrs : array[0..NUM_HUFF_TBLS-1] of TLongTablePtr; + {$endif} + end; + + + +{ Working state while writing an MCU. + This struct contains all the fields that are needed by subroutines. } + +type + working_state = record + next_output_byte : JOCTETptr; { => next byte to write in buffer } + free_in_buffer : size_t; { # of byte spaces remaining in buffer } + cur : savable_state; { Current bit buffer & DC state } + cinfo : j_compress_ptr; { dump_buffer needs access to this } + end; + + +{ Forward declarations } +{METHODDEF} +function encode_mcu_huff (cinfo : j_compress_ptr; + const MCU_data : array of JBLOCKROW) : boolean; + forward; +{METHODDEF} +procedure finish_pass_huff (cinfo : j_compress_ptr); forward; +{$ifdef ENTROPY_OPT_SUPPORTED} +{METHODDEF} +function encode_mcu_gather (cinfo : j_compress_ptr; + const MCU_data: array of JBLOCKROW) : boolean; + forward; + +{METHODDEF} +procedure finish_pass_gather (cinfo : j_compress_ptr); forward; +{$endif} + + +{ Initialize for a Huffman-compressed scan. + If gather_statistics is TRUE, we do not output anything during the scan, + just count the Huffman symbols used and generate Huffman code tables. } + +{METHODDEF} +procedure start_pass_huff (cinfo : j_compress_ptr; + gather_statistics : boolean); +var + entropy : huff_entropy_ptr; + ci, dctbl, actbl : int; + compptr : jpeg_component_info_ptr; +begin + entropy := huff_entropy_ptr (cinfo^.entropy); + + if (gather_statistics) then + begin +{$ifdef ENTROPY_OPT_SUPPORTED} + entropy^.pub.encode_mcu := encode_mcu_gather; + entropy^.pub.finish_pass := finish_pass_gather; +{$else} + ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); +{$endif} + end + else + begin + entropy^.pub.encode_mcu := encode_mcu_huff; + entropy^.pub.finish_pass := finish_pass_huff; + end; + + for ci := 0 to pred(cinfo^.comps_in_scan) do + begin + compptr := cinfo^.cur_comp_info[ci]; + dctbl := compptr^.dc_tbl_no; + actbl := compptr^.ac_tbl_no; + if (gather_statistics) then + begin +{$ifdef ENTROPY_OPT_SUPPORTED} + { Check for invalid table indexes } + { (make_c_derived_tbl does this in the other path) } + if (dctbl < 0) or (dctbl >= NUM_HUFF_TBLS) then + ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, dctbl); + if (actbl < 0) or (actbl >= NUM_HUFF_TBLS) then + ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, actbl); + { Allocate and zero the statistics tables } + { Note that jpeg_gen_optimal_table expects 257 entries in each table! } + if (entropy^.dc_count_ptrs[dctbl] = NIL) then + entropy^.dc_count_ptrs[dctbl] := TLongTablePtr( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + 257 * SIZEOF(long)) ); + MEMZERO(entropy^.dc_count_ptrs[dctbl], 257 * SIZEOF(long)); + if (entropy^.ac_count_ptrs[actbl] = NIL) then + entropy^.ac_count_ptrs[actbl] := TLongTablePtr( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + 257 * SIZEOF(long)) ); + MEMZERO(entropy^.ac_count_ptrs[actbl], 257 * SIZEOF(long)); +{$endif} + end + else + begin + { Compute derived values for Huffman tables } + { We may do this more than once for a table, but it's not expensive } + jpeg_make_c_derived_tbl(cinfo, TRUE, dctbl, + entropy^.dc_derived_tbls[dctbl]); + jpeg_make_c_derived_tbl(cinfo, FALSE, actbl, + entropy^.ac_derived_tbls[actbl]); + end; + { Initialize DC predictions to 0 } + entropy^.saved.last_dc_val[ci] := 0; + end; + + { Initialize bit buffer to empty } + entropy^.saved.put_buffer := 0; + entropy^.saved.put_bits := 0; + + { Initialize restart stuff } + entropy^.restarts_to_go := cinfo^.restart_interval; + entropy^.next_restart_num := 0; +end; + + +{ Compute the derived values for a Huffman table. + This routine also performs some validation checks on the table. + + Note this is also used by jcphuff.c. } + +{GLOBAL} +procedure jpeg_make_c_derived_tbl (cinfo : j_compress_ptr; + isDC : boolean; + tblno : int; + var pdtbl : c_derived_tbl_ptr); +var + htbl : JHUFF_TBL_PTR; + dtbl : c_derived_tbl_ptr; + p, i, l, lastp, si, maxsymbol : int; + huffsize : array[0..257-1] of byte; + huffcode : array[0..257-1] of uInt; + code : uInt; +begin + { Note that huffsize[] and huffcode[] are filled in code-length order, + paralleling the order of the symbols themselves in htbl->huffval[]. } + + { Find the input Huffman table } + if (tblno < 0) or (tblno >= NUM_HUFF_TBLS) then + ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, tblno); + if isDC then + htbl := cinfo^.dc_huff_tbl_ptrs[tblno] + else + htbl := cinfo^.ac_huff_tbl_ptrs[tblno]; + if (htbl = NIL) then + ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, tblno); + + { Allocate a workspace if we haven't already done so. } + if (pdtbl = NIL) then + pdtbl := c_derived_tbl_ptr( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + SIZEOF(c_derived_tbl)) ); + dtbl := pdtbl; + + { Figure C.1: make table of Huffman code length for each symbol } + + p := 0; + for l := 1 to 16 do + begin + i := int(htbl^.bits[l]); + if (i < 0) and (p + i > 256) then { protect against table overrun } + ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE); + while (i > 0) do + begin + huffsize[p] := byte(l); + Inc(p); + Dec(i); + end; + end; + huffsize[p] := 0; + lastp := p; + + { Figure C.2: generate the codes themselves } + { We also validate that the counts represent a legal Huffman code tree. } + + code := 0; + si := huffsize[0]; + p := 0; + while (huffsize[p] <> 0) do + begin + while (( int(huffsize[p]) ) = si) do + begin + huffcode[p] := code; + Inc(p); + Inc(code); + end; + { code is now 1 more than the last code used for codelength si; but + it must still fit in si bits, since no code is allowed to be all ones. } + + if (INT32(code) >= (INT32(1) shl si)) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE); + code := code shl 1; + Inc(si); + end; + + { Figure C.3: generate encoding tables } + { These are code and size indexed by symbol value } + + { Set all codeless symbols to have code length 0; + this lets us detect duplicate VAL entries here, and later + allows emit_bits to detect any attempt to emit such symbols. } + + MEMZERO(@dtbl^.ehufsi, SIZEOF(dtbl^.ehufsi)); + + { This is also a convenient place to check for out-of-range + and duplicated VAL entries. We allow 0..255 for AC symbols + but only 0..15 for DC. (We could constrain them further + based on data depth and mode, but this seems enough.) } + + if isDC then + maxsymbol := 15 + else + maxsymbol := 255; + + for p := 0 to pred(lastp) do + begin + i := htbl^.huffval[p]; + if (i < 0) or (i > maxsymbol) or (dtbl^.ehufsi[i] <> 0) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE); + dtbl^.ehufco[i] := huffcode[p]; + dtbl^.ehufsi[i] := huffsize[p]; + end; +end; + + +{ Outputting bytes to the file } + + +{LOCAL} +function dump_buffer (var state : working_state) : boolean; +{ Empty the output buffer; return TRUE if successful, FALSE if must suspend } +var + dest : jpeg_destination_mgr_ptr; +begin + dest := state.cinfo^.dest; + + if (not dest^.empty_output_buffer (state.cinfo)) then + begin + dump_buffer := FALSE; + exit; + end; + { After a successful buffer dump, must reset buffer pointers } + state.next_output_byte := dest^.next_output_byte; + state.free_in_buffer := dest^.free_in_buffer; + dump_buffer := TRUE; +end; + + +{ Outputting bits to the file } + +{ Only the right 24 bits of put_buffer are used; the valid bits are + left-justified in this part. At most 16 bits can be passed to emit_bits + in one call, and we never retain more than 7 bits in put_buffer + between calls, so 24 bits are sufficient. } + + +{LOCAL} +function emit_bits (var state : working_state; + code : uInt; + size : int) : boolean; {INLINE} +{ Emit some bits; return TRUE if successful, FALSE if must suspend } +var + { This routine is heavily used, so it's worth coding tightly. } + {register} put_buffer : INT32; + {register} put_bits : int; +var + c : int; +begin + put_buffer := INT32 (code); + put_bits := state.cur.put_bits; + + { if size is 0, caller used an invalid Huffman table entry } + if (size = 0) then + ERREXIT(j_common_ptr(state.cinfo), JERR_HUFF_MISSING_CODE); + + put_buffer := put_buffer and pred(INT32(1) shl size); + { mask off any extra bits in code } + + Inc(put_bits, size); { new number of bits in buffer } + + put_buffer := put_buffer shl (24 - put_bits); + { align incoming bits } + put_buffer := put_buffer or state.cur.put_buffer; + { and merge with old buffer contents } + while (put_bits >= 8) do + begin + c := int ((put_buffer shr 16) and $FF); + + {emit_byte(state, c, return FALSE);} + { Emit a byte, return FALSE if must suspend. } + state.next_output_byte^ := JOCTET (c); + Inc(state.next_output_byte); + Dec(state.free_in_buffer); + if (state.free_in_buffer = 0) then + if not dump_buffer(state) then + begin + emit_bits := FALSE; + exit; + end; + + if (c = $FF) then { need to stuff a zero byte? } + begin + {emit_byte(state, 0, return FALSE);} + state.next_output_byte^ := JOCTET (0); + Inc(state.next_output_byte); + Dec(state.free_in_buffer); + if (state.free_in_buffer = 0) then + if not dump_buffer(state) then + begin + emit_bits := FALSE; + exit; + end; + + end; + put_buffer := put_buffer shl 8; + Dec(put_bits, 8); + end; + + state.cur.put_buffer := put_buffer; { update state variables } + state.cur.put_bits := put_bits; + + emit_bits := TRUE; +end; + + +{LOCAL} +function flush_bits (var state : working_state) : boolean; +begin + if (not emit_bits(state, $7F, 7)) then { fill any partial byte with ones } + begin + flush_bits := FALSE; + exit; + end; + state.cur.put_buffer := 0; { and reset bit-buffer to empty } + state.cur.put_bits := 0; + flush_bits := TRUE; +end; + + +{ Encode a single block's worth of coefficients } + +{LOCAL} +function encode_one_block (var state : working_state; + const block : JBLOCK; + last_dc_val : int; + dctbl : c_derived_tbl_ptr; + actbl : c_derived_tbl_ptr) : boolean; +var + {register} temp, temp2 : int; + {register} nbits : int; + {register} k, r, i : int; +begin + { Encode the DC coefficient difference per section F.1.2.1 } + + temp2 := block[0] - last_dc_val; + temp := temp2; + + if (temp < 0) then + begin + temp := -temp; { temp is abs value of input } + { For a negative input, want temp2 := bitwise complement of abs(input) } + { This code assumes we are on a two's complement machine } + Dec(temp2); + end; + + { Find the number of bits needed for the magnitude of the coefficient } + nbits := 0; + while (temp <> 0) do + begin + Inc(nbits); + temp := temp shr 1; + end; + + { Check for out-of-range coefficient values. + Since we're encoding a difference, the range limit is twice as much. } + + if (nbits > MAX_COEF_BITS+1) then + ERREXIT(j_common_ptr(state.cinfo), JERR_BAD_DCT_COEF); + + { Emit the Huffman-coded symbol for the number of bits } + if not emit_bits(state, dctbl^.ehufco[nbits], dctbl^.ehufsi[nbits]) then + begin + encode_one_block := FALSE; + exit; + end; + + { Emit that number of bits of the value, if positive, } + { or the complement of its magnitude, if negative. } + if (nbits <> 0) then { emit_bits rejects calls with size 0 } + if not emit_bits(state, uInt(temp2), nbits) then + begin + encode_one_block := FALSE; + exit; + end; + + { Encode the AC coefficients per section F.1.2.2 } + + r := 0; { r := run length of zeros } + + for k := 1 to pred(DCTSIZE2) do + begin + temp := block[jpeg_natural_order[k]]; + if (temp = 0) then + begin + Inc(r); + end + else + begin + { if run length > 15, must emit special run-length-16 codes ($F0) } + while (r > 15) do + begin + if not emit_bits(state, actbl^.ehufco[$F0], actbl^.ehufsi[$F0]) then + begin + encode_one_block := FALSE; + exit; + end; + Dec(r, 16); + end; + + temp2 := temp; + if (temp < 0) then + begin + temp := -temp; { temp is abs value of input } + { This code assumes we are on a two's complement machine } + Dec(temp2); + end; + + { Find the number of bits needed for the magnitude of the coefficient } + nbits := 0; { there must be at least one 1 bit } + repeat + Inc(nbits); + temp := temp shr 1; + until (temp = 0); + + { Check for out-of-range coefficient values } + if (nbits > MAX_COEF_BITS) then + ERREXIT(j_common_ptr(state.cinfo), JERR_BAD_DCT_COEF); + + { Emit Huffman symbol for run length / number of bits } + i := (r shl 4) + nbits; + if not emit_bits(state, actbl^.ehufco[i], actbl^.ehufsi[i]) then + begin + encode_one_block := FALSE; + exit; + end; + + { Emit that number of bits of the value, if positive, } + { or the complement of its magnitude, if negative. } + if not emit_bits(state, uInt(temp2), nbits) then + begin + encode_one_block := FALSE; + exit; + end; + + r := 0; + end; + end; + + { If the last coef(s) were zero, emit an end-of-block code } + if (r > 0) then + if not emit_bits(state, actbl^.ehufco[0], actbl^.ehufsi[0]) then + begin + encode_one_block := FALSE; + exit; + end; + + encode_one_block := TRUE; +end; + + +{ Emit a restart marker & resynchronize predictions. } + +{LOCAL} +function emit_restart (var state : working_state; + restart_num : int) : boolean; +var + ci : int; +begin + if (not flush_bits(state)) then + begin + emit_restart := FALSE; + exit; + end; + + {emit_byte(state, $FF, return FALSE);} + { Emit a byte, return FALSE if must suspend. } + state.next_output_byte^ := JOCTET ($FF); + Inc(state.next_output_byte); + Dec(state.free_in_buffer); + if (state.free_in_buffer = 0) then + if not dump_buffer(state) then + begin + emit_restart := FALSE; + exit; + end; + + {emit_byte(state, JPEG_RST0 + restart_num, return FALSE);} + { Emit a byte, return FALSE if must suspend. } + state.next_output_byte^ := JOCTET (JPEG_RST0 + restart_num); + Inc(state.next_output_byte); + Dec(state.free_in_buffer); + if (state.free_in_buffer = 0) then + if not dump_buffer(state) then + begin + emit_restart := FALSE; + exit; + end; + + { Re-initialize DC predictions to 0 } + for ci := 0 to pred(state.cinfo^.comps_in_scan) do + state.cur.last_dc_val[ci] := 0; + + { The restart counter is not updated until we successfully write the MCU. } + + emit_restart := TRUE; +end; + + +{ Encode and output one MCU's worth of Huffman-compressed coefficients. } + +{METHODDEF} +function encode_mcu_huff (cinfo : j_compress_ptr; + const MCU_data: array of JBLOCKROW) : boolean; +var + entropy : huff_entropy_ptr; + state : working_state; + blkn, ci : int; + compptr : jpeg_component_info_ptr; +begin + entropy := huff_entropy_ptr (cinfo^.entropy); + { Load up working state } + state.next_output_byte := cinfo^.dest^.next_output_byte; + state.free_in_buffer := cinfo^.dest^.free_in_buffer; + {ASSIGN_STATE(state.cur, entropy^.saved);} + state.cur := entropy^.saved; + state.cinfo := cinfo; + + { Emit restart marker if needed } + if (cinfo^.restart_interval <> 0) then + begin + if (entropy^.restarts_to_go = 0) then + if not emit_restart(state, entropy^.next_restart_num) then + begin + encode_mcu_huff := FALSE; + exit; + end; + end; + + { Encode the MCU data blocks } + for blkn := 0 to pred(cinfo^.blocks_in_MCU) do + begin + ci := cinfo^.MCU_membership[blkn]; + compptr := cinfo^.cur_comp_info[ci]; + if not encode_one_block(state, + MCU_data[blkn]^[0], + state.cur.last_dc_val[ci], + entropy^.dc_derived_tbls[compptr^.dc_tbl_no], + entropy^.ac_derived_tbls[compptr^.ac_tbl_no]) then + begin + encode_mcu_huff := FALSE; + exit; + end; + { Update last_dc_val } + state.cur.last_dc_val[ci] := MCU_data[blkn]^[0][0]; + end; + + { Completed MCU, so update state } + cinfo^.dest^.next_output_byte := state.next_output_byte; + cinfo^.dest^.free_in_buffer := state.free_in_buffer; + {ASSIGN_STATE(entropy^.saved, state.cur);} + entropy^.saved := state.cur; + + { Update restart-interval state too } + if (cinfo^.restart_interval <> 0) then + begin + if (entropy^.restarts_to_go = 0) then + begin + entropy^.restarts_to_go := cinfo^.restart_interval; + Inc(entropy^.next_restart_num); + with entropy^ do + next_restart_num := next_restart_num and 7; + end; + Dec(entropy^.restarts_to_go); + end; + + encode_mcu_huff := TRUE; +end; + + +{ Finish up at the end of a Huffman-compressed scan. } + +{METHODDEF} +procedure finish_pass_huff (cinfo : j_compress_ptr); +var + entropy : huff_entropy_ptr; + state : working_state; +begin + entropy := huff_entropy_ptr (cinfo^.entropy); + + { Load up working state ... flush_bits needs it } + state.next_output_byte := cinfo^.dest^.next_output_byte; + state.free_in_buffer := cinfo^.dest^.free_in_buffer; + {ASSIGN_STATE(state.cur, entropy^.saved);} + state.cur := entropy^.saved; + state.cinfo := cinfo; + + { Flush out the last data } + if not flush_bits(state) then + ERREXIT(j_common_ptr(cinfo), JERR_CANT_SUSPEND); + + { Update state } + cinfo^.dest^.next_output_byte := state.next_output_byte; + cinfo^.dest^.free_in_buffer := state.free_in_buffer; + {ASSIGN_STATE(entropy^.saved, state.cur);} + entropy^.saved := state.cur; +end; + + +{ Huffman coding optimization. + + We first scan the supplied data and count the number of uses of each symbol + that is to be Huffman-coded. (This process MUST agree with the code above.) + Then we build a Huffman coding tree for the observed counts. + Symbols which are not needed at all for the particular image are not + assigned any code, which saves space in the DHT marker as well as in + the compressed data. } + +{$ifdef ENTROPY_OPT_SUPPORTED} + + +{ Process a single block's worth of coefficients } + +{LOCAL} +procedure htest_one_block (cinfo : j_compress_ptr; + const block : JBLOCK; + last_dc_val : int; + dc_counts : TLongTablePtr; + ac_counts : TLongTablePtr); + +var + {register} temp : int; + {register} nbits : int; + {register} k, r : int; +begin + { Encode the DC coefficient difference per section F.1.2.1 } + temp := block[0] - last_dc_val; + if (temp < 0) then + temp := -temp; + + { Find the number of bits needed for the magnitude of the coefficient } + nbits := 0; + while (temp <> 0) do + begin + Inc(nbits); + temp := temp shr 1; + end; + + { Check for out-of-range coefficient values. + Since we're encoding a difference, the range limit is twice as much. } + + if (nbits > MAX_COEF_BITS+1) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_DCT_COEF); + + { Count the Huffman symbol for the number of bits } + Inc(dc_counts^[nbits]); + + { Encode the AC coefficients per section F.1.2.2 } + + r := 0; { r := run length of zeros } + + for k := 1 to pred(DCTSIZE2) do + begin + temp := block[jpeg_natural_order[k]]; + if (temp = 0) then + begin + Inc(r); + end + else + begin + { if run length > 15, must emit special run-length-16 codes ($F0) } + while (r > 15) do + begin + Inc(ac_counts^[$F0]); + Dec(r, 16); + end; + + { Find the number of bits needed for the magnitude of the coefficient } + if (temp < 0) then + temp := -temp; + + { Find the number of bits needed for the magnitude of the coefficient } + nbits := 0; { there must be at least one 1 bit } + repeat + Inc(nbits); + temp := temp shr 1; + until (temp = 0); + + + { Count Huffman symbol for run length / number of bits } + Inc(ac_counts^[(r shl 4) + nbits]); + + r := 0; + end; + end; + + { If the last coef(s) were zero, emit an end-of-block code } + if (r > 0) then + Inc(ac_counts^[0]); +end; + + +{ Trial-encode one MCU's worth of Huffman-compressed coefficients. + No data is actually output, so no suspension return is possible. } + +{METHODDEF} +function encode_mcu_gather (cinfo : j_compress_ptr; + const MCU_data: array of JBLOCKROW) : boolean; +var + entropy : huff_entropy_ptr; + blkn, ci : int; + compptr : jpeg_component_info_ptr; +begin + entropy := huff_entropy_ptr (cinfo^.entropy); + { Take care of restart intervals if needed } + if (cinfo^.restart_interval <> 0) then + begin + if (entropy^.restarts_to_go = 0) then + begin + { Re-initialize DC predictions to 0 } + for ci := 0 to pred(cinfo^.comps_in_scan) do + entropy^.saved.last_dc_val[ci] := 0; + { Update restart state } + entropy^.restarts_to_go := cinfo^.restart_interval; + end; + Dec(entropy^.restarts_to_go); + end; + + for blkn := 0 to pred(cinfo^.blocks_in_MCU) do + begin + ci := cinfo^.MCU_membership[blkn]; + compptr := cinfo^.cur_comp_info[ci]; + htest_one_block(cinfo, MCU_data[blkn]^[0], + entropy^.saved.last_dc_val[ci], + entropy^.dc_count_ptrs[compptr^.dc_tbl_no], + entropy^.ac_count_ptrs[compptr^.ac_tbl_no]); + entropy^.saved.last_dc_val[ci] := MCU_data[blkn]^[0][0]; + end; + + encode_mcu_gather := TRUE; +end; + + +{ Generate the best Huffman code table for the given counts, fill htbl. + Note this is also used by jcphuff.c. + + The JPEG standard requires that no symbol be assigned a codeword of all + one bits (so that padding bits added at the end of a compressed segment + can't look like a valid code). Because of the canonical ordering of + codewords, this just means that there must be an unused slot in the + longest codeword length category. Section K.2 of the JPEG spec suggests + reserving such a slot by pretending that symbol 256 is a valid symbol + with count 1. In theory that's not optimal; giving it count zero but + including it in the symbol set anyway should give a better Huffman code. + But the theoretically better code actually seems to come out worse in + practice, because it produces more all-ones bytes (which incur stuffed + zero bytes in the final file). In any case the difference is tiny. + + The JPEG standard requires Huffman codes to be no more than 16 bits long. + If some symbols have a very small but nonzero probability, the Huffman tree + must be adjusted to meet the code length restriction. We currently use + the adjustment method suggested in JPEG section K.2. This method is *not* + optimal; it may not choose the best possible limited-length code. But + typically only very-low-frequency symbols will be given less-than-optimal + lengths, so the code is almost optimal. Experimental comparisons against + an optimal limited-length-code algorithm indicate that the difference is + microscopic --- usually less than a hundredth of a percent of total size. + So the extra complexity of an optimal algorithm doesn't seem worthwhile. } + + +{GLOBAL} +procedure jpeg_gen_optimal_table (cinfo : j_compress_ptr; + htbl : JHUFF_TBL_PTR; + var freq : TLongTable); +const + MAX_CLEN = 32; { assumed maximum initial code length } +var + bits : array[0..MAX_CLEN+1-1] of UINT8; { bits[k] := # of symbols with code length k } + codesize : array[0..257-1] of int; { codesize[k] := code length of symbol k } + others : array[0..257-1] of int; { next symbol in current branch of tree } + c1, c2 : int; + p, i, j : int; + v : long; +begin + { This algorithm is explained in section K.2 of the JPEG standard } + + MEMZERO(@bits, SIZEOF(bits)); + MEMZERO(@codesize, SIZEOF(codesize)); + for i := 0 to 256 do + others[i] := -1; { init links to empty } + + freq[256] := 1; { make sure 256 has a nonzero count } + { Including the pseudo-symbol 256 in the Huffman procedure guarantees + that no real symbol is given code-value of all ones, because 256 + will be placed last in the largest codeword category. } + + { Huffman's basic algorithm to assign optimal code lengths to symbols } + + while TRUE do + begin + { Find the smallest nonzero frequency, set c1 := its symbol } + { In case of ties, take the larger symbol number } + c1 := -1; + v := long(1000000000); + for i := 0 to 256 do + begin + if (freq[i] <> 0) and (freq[i] <= v) then + begin + v := freq[i]; + c1 := i; + end; + end; + + { Find the next smallest nonzero frequency, set c2 := its symbol } + { In case of ties, take the larger symbol number } + c2 := -1; + v := long(1000000000); + for i := 0 to 256 do + begin + if (freq[i] <> 0) and (freq[i] <= v) and (i <> c1) then + begin + v := freq[i]; + c2 := i; + end; + end; + + { Done if we've merged everything into one frequency } + if (c2 < 0) then + break; + + { Else merge the two counts/trees } + Inc(freq[c1], freq[c2]); + freq[c2] := 0; + + { Increment the codesize of everything in c1's tree branch } + Inc(codesize[c1]); + while (others[c1] >= 0) do + begin + c1 := others[c1]; + Inc(codesize[c1]); + end; + + others[c1] := c2; { chain c2 onto c1's tree branch } + + { Increment the codesize of everything in c2's tree branch } + Inc(codesize[c2]); + while (others[c2] >= 0) do + begin + c2 := others[c2]; + Inc(codesize[c2]); + end; + end; + + { Now count the number of symbols of each code length } + for i := 0 to 256 do + begin + if (codesize[i]<>0) then + begin + { The JPEG standard seems to think that this can't happen, } + { but I'm paranoid... } + if (codesize[i] > MAX_CLEN) then + ERREXIT(j_common_ptr(cinfo), JERR_HUFF_CLEN_OVERFLOW); + + Inc(bits[codesize[i]]); + end; + end; + + { JPEG doesn't allow symbols with code lengths over 16 bits, so if the pure + Huffman procedure assigned any such lengths, we must adjust the coding. + Here is what the JPEG spec says about how this next bit works: + Since symbols are paired for the longest Huffman code, the symbols are + removed from this length category two at a time. The prefix for the pair + (which is one bit shorter) is allocated to one of the pair; then, + skipping the BITS entry for that prefix length, a code word from the next + shortest nonzero BITS entry is converted into a prefix for two code words + one bit longer. } + + for i := MAX_CLEN downto 17 do + begin + while (bits[i] > 0) do + begin + j := i - 2; { find length of new prefix to be used } + while (bits[j] = 0) do + Dec(j); + + Dec(bits[i], 2); { remove two symbols } + Inc(bits[i-1]); { one goes in this length } + Inc(bits[j+1], 2); { two new symbols in this length } + Dec(bits[j]); { symbol of this length is now a prefix } + end; + end; + + { Delphi 2: FOR-loop variable 'i' may be undefined after loop } + i := 16; { Nomssi: work around } + + { Remove the count for the pseudo-symbol 256 from the largest codelength } + while (bits[i] = 0) do { find largest codelength still in use } + Dec(i); + Dec(bits[i]); + + { Return final symbol counts (only for lengths 0..16) } + MEMCOPY(@htbl^.bits, @bits, SIZEOF(htbl^.bits)); + + { Return a list of the symbols sorted by code length } + { It's not real clear to me why we don't need to consider the codelength + changes made above, but the JPEG spec seems to think this works. } + + p := 0; + for i := 1 to MAX_CLEN do + begin + for j := 0 to 255 do + begin + if (codesize[j] = i) then + begin + htbl^.huffval[p] := UINT8 (j); + Inc(p); + end; + end; + end; + + { Set sent_table FALSE so updated table will be written to JPEG file. } + htbl^.sent_table := FALSE; +end; + + +{ Finish up a statistics-gathering pass and create the new Huffman tables. } + +{METHODDEF} +procedure finish_pass_gather (cinfo : j_compress_ptr); +var + entropy : huff_entropy_ptr; + ci, dctbl, actbl : int; + compptr : jpeg_component_info_ptr; + htblptr : ^JHUFF_TBL_PTR; + did_dc : array[0..NUM_HUFF_TBLS-1] of boolean; + did_ac : array[0..NUM_HUFF_TBLS-1] of boolean; +begin + entropy := huff_entropy_ptr (cinfo^.entropy); + + { It's important not to apply jpeg_gen_optimal_table more than once + per table, because it clobbers the input frequency counts! } + + MEMZERO(@did_dc, SIZEOF(did_dc)); + MEMZERO(@did_ac, SIZEOF(did_ac)); + + for ci := 0 to pred(cinfo^.comps_in_scan) do + begin + compptr := cinfo^.cur_comp_info[ci]; + dctbl := compptr^.dc_tbl_no; + actbl := compptr^.ac_tbl_no; + if (not did_dc[dctbl]) then + begin + htblptr := @(cinfo^.dc_huff_tbl_ptrs[dctbl]); + if ( htblptr^ = NIL) then + htblptr^ := jpeg_alloc_huff_table(j_common_ptr(cinfo)); + jpeg_gen_optimal_table(cinfo, htblptr^, entropy^.dc_count_ptrs[dctbl]^); + did_dc[dctbl] := TRUE; + end; + if (not did_ac[actbl]) then + begin + htblptr := @(cinfo^.ac_huff_tbl_ptrs[actbl]); + if ( htblptr^ = NIL) then + htblptr^ := jpeg_alloc_huff_table(j_common_ptr(cinfo)); + jpeg_gen_optimal_table(cinfo, htblptr^, entropy^.ac_count_ptrs[actbl]^); + did_ac[actbl] := TRUE; + end; + end; +end; + +{$endif} { ENTROPY_OPT_SUPPORTED } + + +{ Module initialization routine for Huffman entropy encoding. } + +{GLOBAL} +procedure jinit_huff_encoder (cinfo : j_compress_ptr); +var + entropy : huff_entropy_ptr; + i : int; +begin + entropy := huff_entropy_ptr( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + SIZEOF(huff_entropy_encoder)) ); + cinfo^.entropy := jpeg_entropy_encoder_ptr (entropy); + entropy^.pub.start_pass := start_pass_huff; + + { Mark tables unallocated } + for i := 0 to pred(NUM_HUFF_TBLS) do + begin + entropy^.ac_derived_tbls[i] := NIL; + entropy^.dc_derived_tbls[i] := NIL; +{$ifdef ENTROPY_OPT_SUPPORTED} + entropy^.ac_count_ptrs[i] := NIL; + entropy^.dc_count_ptrs[i] := NIL; +{$endif} + end; +end; + +end. diff --git a/Imaging/JpegLib/imjcinit.pas b/Imaging/JpegLib/imjcinit.pas index 2e495c0..2a844e6 100644 --- a/Imaging/JpegLib/imjcinit.pas +++ b/Imaging/JpegLib/imjcinit.pas @@ -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. diff --git a/Imaging/JpegLib/imjcmainct.pas b/Imaging/JpegLib/imjcmainct.pas index 53c0349..196fad4 100644 --- a/Imaging/JpegLib/imjcmainct.pas +++ b/Imaging/JpegLib/imjcmainct.pas @@ -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. diff --git a/Imaging/JpegLib/imjcmarker.pas b/Imaging/JpegLib/imjcmarker.pas index 9c84d27..d415607 100644 --- a/Imaging/JpegLib/imjcmarker.pas +++ b/Imaging/JpegLib/imjcmarker.pas @@ -1,724 +1,724 @@ -unit imjcmarker; - -{ This file contains routines to write JPEG datastream markers. } - -{ Original: jcmarker.c; Copyright (C) 1991-1998, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjinclude, imjmorecfg, imjerror, - imjdeferr, imjpeglib, imjutils; - - -const - { JPEG marker codes } - M_SOF0 = $c0; - M_SOF1 = $c1; - M_SOF2 = $c2; - M_SOF3 = $c3; - - M_SOF5 = $c5; - M_SOF6 = $c6; - M_SOF7 = $c7; - - M_JPG = $c8; - M_SOF9 = $c9; - M_SOF10 = $ca; - M_SOF11 = $cb; - - M_SOF13 = $cd; - M_SOF14 = $ce; - M_SOF15 = $cf; - - M_DHT = $c4; - - M_DAC = $cc; - - M_RST0 = $d0; - M_RST1 = $d1; - M_RST2 = $d2; - M_RST3 = $d3; - M_RST4 = $d4; - M_RST5 = $d5; - M_RST6 = $d6; - M_RST7 = $d7; - - M_SOI = $d8; - M_EOI = $d9; - M_SOS = $da; - M_DQT = $db; - M_DNL = $dc; - M_DRI = $dd; - M_DHP = $de; - M_EXP = $df; - - M_APP0 = $e0; - M_APP1 = $e1; - M_APP2 = $e2; - M_APP3 = $e3; - M_APP4 = $e4; - M_APP5 = $e5; - M_APP6 = $e6; - M_APP7 = $e7; - M_APP8 = $e8; - M_APP9 = $e9; - M_APP10 = $ea; - M_APP11 = $eb; - M_APP12 = $ec; - M_APP13 = $ed; - M_APP14 = $ee; - M_APP15 = $ef; - - M_JPG0 = $f0; - M_JPG13 = $fd; - M_COM = $fe; - - M_TEM = $01; - - M_ERROR = $100; - -type - JPEG_MARKER = Word; - -{ Private state } - -type - my_marker_ptr = ^my_marker_writer; - my_marker_writer = record - pub : jpeg_marker_writer; { public fields } - - last_restart_interval : uint; { last DRI value emitted; 0 after SOI } - end; - - - - -{GLOBAL} -procedure jinit_marker_writer (cinfo : j_compress_ptr); - -implementation - -{ Basic output routines. - - Note that we do not support suspension while writing a marker. - Therefore, an application using suspension must ensure that there is - enough buffer space for the initial markers (typ. 600-700 bytes) before - calling jpeg_start_compress, and enough space to write the trailing EOI - (a few bytes) before calling jpeg_finish_compress. Multipass compression - modes are not supported at all with suspension, so those two are the only - points where markers will be written. } - - -{LOCAL} -procedure emit_byte (cinfo : j_compress_ptr; val : int); -{ Emit a byte } -var - dest : jpeg_destination_mgr_ptr; -begin - dest := cinfo^.dest; - - dest^.next_output_byte^ := JOCTET(val); - Inc(dest^.next_output_byte); - - Dec(dest^.free_in_buffer); - if (dest^.free_in_buffer = 0) then - begin - if not dest^.empty_output_buffer(cinfo) then - ERREXIT(j_common_ptr(cinfo), JERR_CANT_SUSPEND); - end; -end; - - -{LOCAL} -procedure emit_marker(cinfo : j_compress_ptr; mark : JPEG_MARKER); -{ Emit a marker code } -begin - emit_byte(cinfo, $FF); - emit_byte(cinfo, int(mark)); -end; - - -{LOCAL} -procedure emit_2bytes (cinfo : j_compress_ptr; value : int); -{ Emit a 2-byte integer; these are always MSB first in JPEG files } -begin - emit_byte(cinfo, (value shr 8) and $FF); - emit_byte(cinfo, value and $FF); -end; - - -{ Routines to write specific marker types. } - -{LOCAL} -function emit_dqt (cinfo : j_compress_ptr; index : int) : int; -{ Emit a DQT marker } -{ Returns the precision used (0 = 8bits, 1 = 16bits) for baseline checking } -var - qtbl : JQUANT_TBL_PTR; - prec : int; - i : int; -var - qval : uint; -begin - qtbl := cinfo^.quant_tbl_ptrs[index]; - if (qtbl = NIL) then - ERREXIT1(j_common_ptr(cinfo), JERR_NO_QUANT_TABLE, index); - - prec := 0; - for i := 0 to Pred(DCTSIZE2) do - begin - if (qtbl^.quantval[i] > 255) then - prec := 1; - end; - - if not qtbl^.sent_table then - begin - emit_marker(cinfo, M_DQT); - - if (prec <> 0) then - emit_2bytes(cinfo, DCTSIZE2*2 + 1 + 2) - else - emit_2bytes(cinfo, DCTSIZE2 + 1 + 2); - - emit_byte(cinfo, index + (prec shl 4)); - - for i := 0 to Pred(DCTSIZE2) do - begin - { The table entries must be emitted in zigzag order. } - qval := qtbl^.quantval[jpeg_natural_order[i]]; - if (prec <> 0) then - emit_byte(cinfo, int(qval shr 8)); - emit_byte(cinfo, int(qval and $FF)); - end; - - qtbl^.sent_table := TRUE; - end; - - emit_dqt := prec; -end; - - -{LOCAL} -procedure emit_dht (cinfo : j_compress_ptr; index : int; is_ac : boolean); -{ Emit a DHT marker } -var - htbl : JHUFF_TBL_PTR; - length, i : int; -begin - if (is_ac) then - begin - htbl := cinfo^.ac_huff_tbl_ptrs[index]; - index := index + $10; { output index has AC bit set } - end - else - begin - htbl := cinfo^.dc_huff_tbl_ptrs[index]; - end; - - if (htbl = NIL) then - ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, index); - - if not htbl^.sent_table then - begin - emit_marker(cinfo, M_DHT); - - length := 0; - for i := 1 to 16 do - length := length + htbl^.bits[i]; - - emit_2bytes(cinfo, length + 2 + 1 + 16); - emit_byte(cinfo, index); - - for i := 1 to 16 do - emit_byte(cinfo, htbl^.bits[i]); - - for i := 0 to Pred(length) do - emit_byte(cinfo, htbl^.huffval[i]); - - htbl^.sent_table := TRUE; - end; -end; - - -{LOCAL} -procedure emit_dac (cinfo : j_compress_ptr); -{ Emit a DAC marker } -{ Since the useful info is so small, we want to emit all the tables in } -{ one DAC marker. Therefore this routine does its own scan of the table. } -{$ifdef C_ARITH_CODING_SUPPORTED} -var - dc_in_use : array[0..NUM_ARITH_TBLS] of byte; - ac_in_use : array[0..NUM_ARITH_TBLS] of byte; - length, i : int; - compptr : jpeg_component_info_ptr; -begin - for i := 0 to pred(NUM_ARITH_TBLS) do - begin - dc_in_use[i] := 0; - ac_in_use[i] := 0; - end; - - for i := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[i]; - dc_in_use[compptr^.dc_tbl_no] := 1; - ac_in_use[compptr^.ac_tbl_no] := 1; - end; - - length := 0; - for i := 0 to pred(NUM_ARITH_TBLS) do - Inc(length, dc_in_use[i] + ac_in_use[i]); - - emit_marker(cinfo, M_DAC); - - emit_2bytes(cinfo, length*2 + 2); - - for i := 0 to pred(NUM_ARITH_TBLS) do - begin - if (dc_in_use[i] <> 0) then - begin - emit_byte(cinfo, i); - emit_byte(cinfo, cinfo^.arith_dc_L[i] + (cinfo^.arith_dc_U[i] shl 4)); - end; - if (ac_in_use[i] <> 0) then - begin - emit_byte(cinfo, i + $10); - emit_byte(cinfo, cinfo^.arith_ac_K[i]); - end; - end; -end; -{$else} -begin -end; -{$endif} {C_ARITH_CODING_SUPPORTED} - - -{LOCAL} -procedure emit_dri (cinfo : j_compress_ptr); -{ Emit a DRI marker } -begin - emit_marker(cinfo, M_DRI); - - emit_2bytes(cinfo, 4); { fixed length } - - emit_2bytes(cinfo, int(cinfo^.restart_interval)); -end; - - -{LOCAL} -procedure emit_sof (cinfo : j_compress_ptr; code : JPEG_MARKER); -{ Emit a SOF marker } -var - ci : int; - compptr : jpeg_component_info_ptr; -begin - emit_marker(cinfo, code); - - emit_2bytes(cinfo, 3 * cinfo^.num_components + 2 + 5 + 1); { length } - - { Make sure image isn't bigger than SOF field can handle } - if (long(cinfo^.image_height) > long(65535)) or - (long(cinfo^.image_width) > long(65535)) then - ERREXIT1(j_common_ptr(cinfo), JERR_IMAGE_TOO_BIG, uInt(65535)); - - emit_byte(cinfo, cinfo^.data_precision); - emit_2bytes(cinfo, int(cinfo^.image_height)); - emit_2bytes(cinfo, int(cinfo^.image_width)); - - emit_byte(cinfo, cinfo^.num_components); - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to Pred(cinfo^.num_components) do - begin - emit_byte(cinfo, compptr^.component_id); - emit_byte(cinfo, (compptr^.h_samp_factor shl 4) + compptr^.v_samp_factor); - emit_byte(cinfo, compptr^.quant_tbl_no); - Inc(compptr); - end; -end; - - -{LOCAL} -procedure emit_sos (cinfo : j_compress_ptr); -{ Emit a SOS marker } -var - i, td, ta : int; - compptr : jpeg_component_info_ptr; -begin - emit_marker(cinfo, M_SOS); - - emit_2bytes(cinfo, 2 * cinfo^.comps_in_scan + 2 + 1 + 3); { length } - - emit_byte(cinfo, cinfo^.comps_in_scan); - - for i := 0 to Pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[i]; - emit_byte(cinfo, compptr^.component_id); - td := compptr^.dc_tbl_no; - ta := compptr^.ac_tbl_no; - if (cinfo^.progressive_mode) then - begin - { Progressive mode: only DC or only AC tables are used in one scan; - furthermore, Huffman coding of DC refinement uses no table at all. - We emit 0 for unused field(s); this is recommended by the P&M text - but does not seem to be specified in the standard. } - - if (cinfo^.Ss = 0) then - begin - ta := 0; { DC scan } - if (cinfo^.Ah <> 0) and not cinfo^.arith_code then - td := 0; { no DC table either } - end - else - begin - td := 0; { AC scan } - end; - end; - emit_byte(cinfo, (td shl 4) + ta); - end; - - emit_byte(cinfo, cinfo^.Ss); - emit_byte(cinfo, cinfo^.Se); - emit_byte(cinfo, (cinfo^.Ah shl 4) + cinfo^.Al); -end; - - -{LOCAL} -procedure emit_jfif_app0 (cinfo : j_compress_ptr); -{ Emit a JFIF-compliant APP0 marker } -{ - Length of APP0 block (2 bytes) - Block ID (4 bytes - ASCII "JFIF") - Zero byte (1 byte to terminate the ID string) - Version Major, Minor (2 bytes - major first) - Units (1 byte - $00 = none, $01 = inch, $02 = cm) - Xdpu (2 bytes - dots per unit horizontal) - Ydpu (2 bytes - dots per unit vertical) - Thumbnail X size (1 byte) - Thumbnail Y size (1 byte) -} -begin - emit_marker(cinfo, M_APP0); - - emit_2bytes(cinfo, 2 + 4 + 1 + 2 + 1 + 2 + 2 + 1 + 1); { length } - - emit_byte(cinfo, $4A); { Identifier: ASCII "JFIF" } - emit_byte(cinfo, $46); - emit_byte(cinfo, $49); - emit_byte(cinfo, $46); - emit_byte(cinfo, 0); - emit_byte(cinfo, cinfo^.JFIF_major_version); { Version fields } - emit_byte(cinfo, cinfo^.JFIF_minor_version); - emit_byte(cinfo, cinfo^.density_unit); { Pixel size information } - emit_2bytes(cinfo, int(cinfo^.X_density)); - emit_2bytes(cinfo, int(cinfo^.Y_density)); - emit_byte(cinfo, 0); { No thumbnail image } - emit_byte(cinfo, 0); -end; - - -{LOCAL} -procedure emit_adobe_app14 (cinfo : j_compress_ptr); -{ Emit an Adobe APP14 marker } -{ - Length of APP14 block (2 bytes) - Block ID (5 bytes - ASCII "Adobe") - Version Number (2 bytes - currently 100) - Flags0 (2 bytes - currently 0) - Flags1 (2 bytes - currently 0) - Color transform (1 byte) - - Although Adobe TN 5116 mentions Version = 101, all the Adobe files - now in circulation seem to use Version = 100, so that's what we write. - - We write the color transform byte as 1 if the JPEG color space is - YCbCr, 2 if it's YCCK, 0 otherwise. Adobe's definition has to do with - whether the encoder performed a transformation, which is pretty useless. -} -begin - emit_marker(cinfo, M_APP14); - - emit_2bytes(cinfo, 2 + 5 + 2 + 2 + 2 + 1); { length } - - emit_byte(cinfo, $41); { Identifier: ASCII "Adobe" } - emit_byte(cinfo, $64); - emit_byte(cinfo, $6F); - emit_byte(cinfo, $62); - emit_byte(cinfo, $65); - emit_2bytes(cinfo, 100); { Version } - emit_2bytes(cinfo, 0); { Flags0 } - emit_2bytes(cinfo, 0); { Flags1 } - case (cinfo^.jpeg_color_space) of - JCS_YCbCr: - emit_byte(cinfo, 1); { Color transform = 1 } - JCS_YCCK: - emit_byte(cinfo, 2); { Color transform = 2 } - else - emit_byte(cinfo, 0); { Color transform = 0 } - end; -end; - - -{ These routines allow writing an arbitrary marker with parameters. - The only intended use is to emit COM or APPn markers after calling - write_file_header and before calling write_frame_header. - Other uses are not guaranteed to produce desirable results. - Counting the parameter bytes properly is the caller's responsibility. } - -{METHODDEF} -procedure write_marker_header (cinfo : j_compress_ptr; - marker : int; - datalen : uint); -{ Emit an arbitrary marker header } -begin - if (datalen > uint(65533)) then { safety check } - ERREXIT(j_common_ptr(cinfo), JERR_BAD_LENGTH); - - emit_marker(cinfo, JPEG_MARKER(marker)); - - emit_2bytes(cinfo, int(datalen + 2)); { total length } -end; - -{METHODDEF} -procedure write_marker_byte (cinfo : j_compress_ptr; val : int); -{ Emit one byte of marker parameters following write_marker_header } -begin - emit_byte(cinfo, val); -end; - -{ Write datastream header. - This consists of an SOI and optional APPn markers. - We recommend use of the JFIF marker, but not the Adobe marker, - when using YCbCr or grayscale data. The JFIF marker should NOT - be used for any other JPEG colorspace. The Adobe marker is helpful - to distinguish RGB, CMYK, and YCCK colorspaces. - Note that an application can write additional header markers after - jpeg_start_compress returns. } - - -{METHODDEF} -procedure write_file_header (cinfo : j_compress_ptr); -var - marker : my_marker_ptr; -begin - marker := my_marker_ptr(cinfo^.marker); - - emit_marker(cinfo, M_SOI); { first the SOI } - - { SOI is defined to reset restart interval to 0 } - marker^.last_restart_interval := 0; - - if (cinfo^.write_JFIF_header) then { next an optional JFIF APP0 } - emit_jfif_app0(cinfo); - if (cinfo^.write_Adobe_marker) then { next an optional Adobe APP14 } - emit_adobe_app14(cinfo); -end; - - -{ Write frame header. - This consists of DQT and SOFn markers. - Note that we do not emit the SOF until we have emitted the DQT(s). - This avoids compatibility problems with incorrect implementations that - try to error-check the quant table numbers as soon as they see the SOF. } - - -{METHODDEF} -procedure write_frame_header (cinfo : j_compress_ptr); -var - ci, prec : int; - is_baseline : boolean; - compptr : jpeg_component_info_ptr; -begin - { Emit DQT for each quantization table. - Note that emit_dqt() suppresses any duplicate tables. } - - prec := 0; - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to Pred(cinfo^.num_components) do - begin - prec := prec + emit_dqt(cinfo, compptr^.quant_tbl_no); - Inc(compptr); - end; - { now prec is nonzero iff there are any 16-bit quant tables. } - - { Check for a non-baseline specification. - Note we assume that Huffman table numbers won't be changed later. } - - if (cinfo^.arith_code) or (cinfo^.progressive_mode) - or (cinfo^.data_precision <> 8) then - begin - is_baseline := FALSE; - end - else - begin - is_baseline := TRUE; - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to Pred(cinfo^.num_components) do - begin - if (compptr^.dc_tbl_no > 1) or (compptr^.ac_tbl_no > 1) then - is_baseline := FALSE; - Inc(compptr); - end; - if (prec <> 0) and (is_baseline) then - begin - is_baseline := FALSE; - { If it's baseline except for quantizer size, warn the user } - {$IFDEF DEBUG} - TRACEMS(j_common_ptr(cinfo), 0, JTRC_16BIT_TABLES); - {$ENDIF} - end; - end; - - { Emit the proper SOF marker } - if (cinfo^.arith_code) then - begin - emit_sof(cinfo, M_SOF9); { SOF code for arithmetic coding } - end - else - begin - if (cinfo^.progressive_mode) then - emit_sof(cinfo, M_SOF2) { SOF code for progressive Huffman } - else if (is_baseline) then - emit_sof(cinfo, M_SOF0) { SOF code for baseline implementation } - else - emit_sof(cinfo, M_SOF1); { SOF code for non-baseline Huffman file } - end; -end; - - -{ Write scan header. - This consists of DHT or DAC markers, optional DRI, and SOS. - Compressed data will be written following the SOS. } - -{METHODDEF} -procedure write_scan_header (cinfo : j_compress_ptr); -var - marker : my_marker_ptr; - i : int; - compptr : jpeg_component_info_ptr; -begin - marker := my_marker_ptr(cinfo^.marker); - if (cinfo^.arith_code) then - begin - { Emit arith conditioning info. We may have some duplication - if the file has multiple scans, but it's so small it's hardly - worth worrying about. } - emit_dac(cinfo); - end - else - begin - { Emit Huffman tables. - Note that emit_dht() suppresses any duplicate tables. } - for i := 0 to Pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[i]; - if (cinfo^.progressive_mode) then - begin - { Progressive mode: only DC or only AC tables are used in one scan } - if (cinfo^.Ss = 0) then - begin - if (cinfo^.Ah = 0) then { DC needs no table for refinement scan } - emit_dht(cinfo, compptr^.dc_tbl_no, FALSE); - end - else - begin - emit_dht(cinfo, compptr^.ac_tbl_no, TRUE); - end; - end - else - begin - { Sequential mode: need both DC and AC tables } - emit_dht(cinfo, compptr^.dc_tbl_no, FALSE); - emit_dht(cinfo, compptr^.ac_tbl_no, TRUE); - end; - end; - end; - - { Emit DRI if required --- note that DRI value could change for each scan. - We avoid wasting space with unnecessary DRIs, however. } - - if (cinfo^.restart_interval <> marker^.last_restart_interval) then - begin - emit_dri(cinfo); - marker^.last_restart_interval := cinfo^.restart_interval; - end; - - emit_sos(cinfo); -end; - - - -{ Write datastream trailer. } - - -{METHODDEF} -procedure write_file_trailer (cinfo : j_compress_ptr); -begin - emit_marker(cinfo, M_EOI); -end; - - -{ Write an abbreviated table-specification datastream. - This consists of SOI, DQT and DHT tables, and EOI. - Any table that is defined and not marked sent_table = TRUE will be - emitted. Note that all tables will be marked sent_table = TRUE at exit. } - - -{METHODDEF} -procedure write_tables_only (cinfo : j_compress_ptr); -var - i : int; -begin - emit_marker(cinfo, M_SOI); - - for i := 0 to Pred(NUM_QUANT_TBLS) do - begin - if (cinfo^.quant_tbl_ptrs[i] <> NIL) then - emit_dqt(cinfo, i); { dummy := ... } - end; - - if (not cinfo^.arith_code) then - begin - for i := 0 to Pred(NUM_HUFF_TBLS) do - begin - if (cinfo^.dc_huff_tbl_ptrs[i] <> NIL) then - emit_dht(cinfo, i, FALSE); - if (cinfo^.ac_huff_tbl_ptrs[i] <> NIL) then - emit_dht(cinfo, i, TRUE); - end; - end; - - emit_marker(cinfo, M_EOI); -end; - - -{ Initialize the marker writer module. } - -{GLOBAL} -procedure jinit_marker_writer (cinfo : j_compress_ptr); -var - marker : my_marker_ptr; -begin - { Create the subobject } - marker := my_marker_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_marker_writer)) ); - cinfo^.marker := jpeg_marker_writer_ptr(marker); - { Initialize method pointers } - marker^.pub.write_file_header := write_file_header; - marker^.pub.write_frame_header := write_frame_header; - marker^.pub.write_scan_header := write_scan_header; - marker^.pub.write_file_trailer := write_file_trailer; - marker^.pub.write_tables_only := write_tables_only; - marker^.pub.write_marker_header := write_marker_header; - marker^.pub.write_marker_byte := write_marker_byte; - { Initialize private state } - marker^.last_restart_interval := 0; -end; - - -end. +unit imjcmarker; + +{ This file contains routines to write JPEG datastream markers. } + +{ Original: jcmarker.c; Copyright (C) 1991-1998, Thomas G. Lane. } + +interface + +{$I imjconfig.inc} + +uses + imjinclude, imjmorecfg, imjerror, + imjdeferr, imjpeglib, imjutils; + + +const + { JPEG marker codes } + M_SOF0 = $c0; + M_SOF1 = $c1; + M_SOF2 = $c2; + M_SOF3 = $c3; + + M_SOF5 = $c5; + M_SOF6 = $c6; + M_SOF7 = $c7; + + M_JPG = $c8; + M_SOF9 = $c9; + M_SOF10 = $ca; + M_SOF11 = $cb; + + M_SOF13 = $cd; + M_SOF14 = $ce; + M_SOF15 = $cf; + + M_DHT = $c4; + + M_DAC = $cc; + + M_RST0 = $d0; + M_RST1 = $d1; + M_RST2 = $d2; + M_RST3 = $d3; + M_RST4 = $d4; + M_RST5 = $d5; + M_RST6 = $d6; + M_RST7 = $d7; + + M_SOI = $d8; + M_EOI = $d9; + M_SOS = $da; + M_DQT = $db; + M_DNL = $dc; + M_DRI = $dd; + M_DHP = $de; + M_EXP = $df; + + M_APP0 = $e0; + M_APP1 = $e1; + M_APP2 = $e2; + M_APP3 = $e3; + M_APP4 = $e4; + M_APP5 = $e5; + M_APP6 = $e6; + M_APP7 = $e7; + M_APP8 = $e8; + M_APP9 = $e9; + M_APP10 = $ea; + M_APP11 = $eb; + M_APP12 = $ec; + M_APP13 = $ed; + M_APP14 = $ee; + M_APP15 = $ef; + + M_JPG0 = $f0; + M_JPG13 = $fd; + M_COM = $fe; + + M_TEM = $01; + + M_ERROR = $100; + +type + JPEG_MARKER = Word; + +{ Private state } + +type + my_marker_ptr = ^my_marker_writer; + my_marker_writer = record + pub : jpeg_marker_writer; { public fields } + + last_restart_interval : uint; { last DRI value emitted; 0 after SOI } + end; + + + + +{GLOBAL} +procedure jinit_marker_writer (cinfo : j_compress_ptr); + +implementation + +{ Basic output routines. + + Note that we do not support suspension while writing a marker. + Therefore, an application using suspension must ensure that there is + enough buffer space for the initial markers (typ. 600-700 bytes) before + calling jpeg_start_compress, and enough space to write the trailing EOI + (a few bytes) before calling jpeg_finish_compress. Multipass compression + modes are not supported at all with suspension, so those two are the only + points where markers will be written. } + + +{LOCAL} +procedure emit_byte (cinfo : j_compress_ptr; val : int); +{ Emit a byte } +var + dest : jpeg_destination_mgr_ptr; +begin + dest := cinfo^.dest; + + dest^.next_output_byte^ := JOCTET(val); + Inc(dest^.next_output_byte); + + Dec(dest^.free_in_buffer); + if (dest^.free_in_buffer = 0) then + begin + if not dest^.empty_output_buffer(cinfo) then + ERREXIT(j_common_ptr(cinfo), JERR_CANT_SUSPEND); + end; +end; + + +{LOCAL} +procedure emit_marker(cinfo : j_compress_ptr; mark : JPEG_MARKER); +{ Emit a marker code } +begin + emit_byte(cinfo, $FF); + emit_byte(cinfo, int(mark)); +end; + + +{LOCAL} +procedure emit_2bytes (cinfo : j_compress_ptr; value : int); +{ Emit a 2-byte integer; these are always MSB first in JPEG files } +begin + emit_byte(cinfo, (value shr 8) and $FF); + emit_byte(cinfo, value and $FF); +end; + + +{ Routines to write specific marker types. } + +{LOCAL} +function emit_dqt (cinfo : j_compress_ptr; index : int) : int; +{ Emit a DQT marker } +{ Returns the precision used (0 = 8bits, 1 = 16bits) for baseline checking } +var + qtbl : JQUANT_TBL_PTR; + prec : int; + i : int; +var + qval : uint; +begin + qtbl := cinfo^.quant_tbl_ptrs[index]; + if (qtbl = NIL) then + ERREXIT1(j_common_ptr(cinfo), JERR_NO_QUANT_TABLE, index); + + prec := 0; + for i := 0 to Pred(DCTSIZE2) do + begin + if (qtbl^.quantval[i] > 255) then + prec := 1; + end; + + if not qtbl^.sent_table then + begin + emit_marker(cinfo, M_DQT); + + if (prec <> 0) then + emit_2bytes(cinfo, DCTSIZE2*2 + 1 + 2) + else + emit_2bytes(cinfo, DCTSIZE2 + 1 + 2); + + emit_byte(cinfo, index + (prec shl 4)); + + for i := 0 to Pred(DCTSIZE2) do + begin + { The table entries must be emitted in zigzag order. } + qval := qtbl^.quantval[jpeg_natural_order[i]]; + if (prec <> 0) then + emit_byte(cinfo, int(qval shr 8)); + emit_byte(cinfo, int(qval and $FF)); + end; + + qtbl^.sent_table := TRUE; + end; + + emit_dqt := prec; +end; + + +{LOCAL} +procedure emit_dht (cinfo : j_compress_ptr; index : int; is_ac : boolean); +{ Emit a DHT marker } +var + htbl : JHUFF_TBL_PTR; + length, i : int; +begin + if (is_ac) then + begin + htbl := cinfo^.ac_huff_tbl_ptrs[index]; + index := index + $10; { output index has AC bit set } + end + else + begin + htbl := cinfo^.dc_huff_tbl_ptrs[index]; + end; + + if (htbl = NIL) then + ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, index); + + if not htbl^.sent_table then + begin + emit_marker(cinfo, M_DHT); + + length := 0; + for i := 1 to 16 do + length := length + htbl^.bits[i]; + + emit_2bytes(cinfo, length + 2 + 1 + 16); + emit_byte(cinfo, index); + + for i := 1 to 16 do + emit_byte(cinfo, htbl^.bits[i]); + + for i := 0 to Pred(length) do + emit_byte(cinfo, htbl^.huffval[i]); + + htbl^.sent_table := TRUE; + end; +end; + + +{LOCAL} +procedure emit_dac (cinfo : j_compress_ptr); +{ Emit a DAC marker } +{ Since the useful info is so small, we want to emit all the tables in } +{ one DAC marker. Therefore this routine does its own scan of the table. } +{$ifdef C_ARITH_CODING_SUPPORTED} +var + dc_in_use : array[0..NUM_ARITH_TBLS] of byte; + ac_in_use : array[0..NUM_ARITH_TBLS] of byte; + length, i : int; + compptr : jpeg_component_info_ptr; +begin + for i := 0 to pred(NUM_ARITH_TBLS) do + begin + dc_in_use[i] := 0; + ac_in_use[i] := 0; + end; + + for i := 0 to pred(cinfo^.comps_in_scan) do + begin + compptr := cinfo^.cur_comp_info[i]; + dc_in_use[compptr^.dc_tbl_no] := 1; + ac_in_use[compptr^.ac_tbl_no] := 1; + end; + + length := 0; + for i := 0 to pred(NUM_ARITH_TBLS) do + Inc(length, dc_in_use[i] + ac_in_use[i]); + + emit_marker(cinfo, M_DAC); + + emit_2bytes(cinfo, length*2 + 2); + + for i := 0 to pred(NUM_ARITH_TBLS) do + begin + if (dc_in_use[i] <> 0) then + begin + emit_byte(cinfo, i); + emit_byte(cinfo, cinfo^.arith_dc_L[i] + (cinfo^.arith_dc_U[i] shl 4)); + end; + if (ac_in_use[i] <> 0) then + begin + emit_byte(cinfo, i + $10); + emit_byte(cinfo, cinfo^.arith_ac_K[i]); + end; + end; +end; +{$else} +begin +end; +{$endif} {C_ARITH_CODING_SUPPORTED} + + +{LOCAL} +procedure emit_dri (cinfo : j_compress_ptr); +{ Emit a DRI marker } +begin + emit_marker(cinfo, M_DRI); + + emit_2bytes(cinfo, 4); { fixed length } + + emit_2bytes(cinfo, int(cinfo^.restart_interval)); +end; + + +{LOCAL} +procedure emit_sof (cinfo : j_compress_ptr; code : JPEG_MARKER); +{ Emit a SOF marker } +var + ci : int; + compptr : jpeg_component_info_ptr; +begin + emit_marker(cinfo, code); + + emit_2bytes(cinfo, 3 * cinfo^.num_components + 2 + 5 + 1); { length } + + { Make sure image isn't bigger than SOF field can handle } + if (long(cinfo^.image_height) > long(65535)) or + (long(cinfo^.image_width) > long(65535)) then + ERREXIT1(j_common_ptr(cinfo), JERR_IMAGE_TOO_BIG, uInt(65535)); + + emit_byte(cinfo, cinfo^.data_precision); + emit_2bytes(cinfo, int(cinfo^.image_height)); + emit_2bytes(cinfo, int(cinfo^.image_width)); + + emit_byte(cinfo, cinfo^.num_components); + + compptr := jpeg_component_info_ptr(cinfo^.comp_info); + for ci := 0 to Pred(cinfo^.num_components) do + begin + emit_byte(cinfo, compptr^.component_id); + emit_byte(cinfo, (compptr^.h_samp_factor shl 4) + compptr^.v_samp_factor); + emit_byte(cinfo, compptr^.quant_tbl_no); + Inc(compptr); + end; +end; + + +{LOCAL} +procedure emit_sos (cinfo : j_compress_ptr); +{ Emit a SOS marker } +var + i, td, ta : int; + compptr : jpeg_component_info_ptr; +begin + emit_marker(cinfo, M_SOS); + + emit_2bytes(cinfo, 2 * cinfo^.comps_in_scan + 2 + 1 + 3); { length } + + emit_byte(cinfo, cinfo^.comps_in_scan); + + for i := 0 to Pred(cinfo^.comps_in_scan) do + begin + compptr := cinfo^.cur_comp_info[i]; + emit_byte(cinfo, compptr^.component_id); + td := compptr^.dc_tbl_no; + ta := compptr^.ac_tbl_no; + if (cinfo^.progressive_mode) then + begin + { Progressive mode: only DC or only AC tables are used in one scan; + furthermore, Huffman coding of DC refinement uses no table at all. + We emit 0 for unused field(s); this is recommended by the P&M text + but does not seem to be specified in the standard. } + + if (cinfo^.Ss = 0) then + begin + ta := 0; { DC scan } + if (cinfo^.Ah <> 0) and not cinfo^.arith_code then + td := 0; { no DC table either } + end + else + begin + td := 0; { AC scan } + end; + end; + emit_byte(cinfo, (td shl 4) + ta); + end; + + emit_byte(cinfo, cinfo^.Ss); + emit_byte(cinfo, cinfo^.Se); + emit_byte(cinfo, (cinfo^.Ah shl 4) + cinfo^.Al); +end; + + +{LOCAL} +procedure emit_jfif_app0 (cinfo : j_compress_ptr); +{ Emit a JFIF-compliant APP0 marker } +{ + Length of APP0 block (2 bytes) + Block ID (4 bytes - ASCII "JFIF") + Zero byte (1 byte to terminate the ID string) + Version Major, Minor (2 bytes - major first) + Units (1 byte - $00 = none, $01 = inch, $02 = cm) + Xdpu (2 bytes - dots per unit horizontal) + Ydpu (2 bytes - dots per unit vertical) + Thumbnail X size (1 byte) + Thumbnail Y size (1 byte) +} +begin + emit_marker(cinfo, M_APP0); + + emit_2bytes(cinfo, 2 + 4 + 1 + 2 + 1 + 2 + 2 + 1 + 1); { length } + + emit_byte(cinfo, $4A); { Identifier: ASCII "JFIF" } + emit_byte(cinfo, $46); + emit_byte(cinfo, $49); + emit_byte(cinfo, $46); + emit_byte(cinfo, 0); + emit_byte(cinfo, cinfo^.JFIF_major_version); { Version fields } + emit_byte(cinfo, cinfo^.JFIF_minor_version); + emit_byte(cinfo, cinfo^.density_unit); { Pixel size information } + emit_2bytes(cinfo, int(cinfo^.X_density)); + emit_2bytes(cinfo, int(cinfo^.Y_density)); + emit_byte(cinfo, 0); { No thumbnail image } + emit_byte(cinfo, 0); +end; + + +{LOCAL} +procedure emit_adobe_app14 (cinfo : j_compress_ptr); +{ Emit an Adobe APP14 marker } +{ + Length of APP14 block (2 bytes) + Block ID (5 bytes - ASCII "Adobe") + Version Number (2 bytes - currently 100) + Flags0 (2 bytes - currently 0) + Flags1 (2 bytes - currently 0) + Color transform (1 byte) + + Although Adobe TN 5116 mentions Version = 101, all the Adobe files + now in circulation seem to use Version = 100, so that's what we write. + + We write the color transform byte as 1 if the JPEG color space is + YCbCr, 2 if it's YCCK, 0 otherwise. Adobe's definition has to do with + whether the encoder performed a transformation, which is pretty useless. +} +begin + emit_marker(cinfo, M_APP14); + + emit_2bytes(cinfo, 2 + 5 + 2 + 2 + 2 + 1); { length } + + emit_byte(cinfo, $41); { Identifier: ASCII "Adobe" } + emit_byte(cinfo, $64); + emit_byte(cinfo, $6F); + emit_byte(cinfo, $62); + emit_byte(cinfo, $65); + emit_2bytes(cinfo, 100); { Version } + emit_2bytes(cinfo, 0); { Flags0 } + emit_2bytes(cinfo, 0); { Flags1 } + case (cinfo^.jpeg_color_space) of + JCS_YCbCr: + emit_byte(cinfo, 1); { Color transform = 1 } + JCS_YCCK: + emit_byte(cinfo, 2); { Color transform = 2 } + else + emit_byte(cinfo, 0); { Color transform = 0 } + end; +end; + + +{ These routines allow writing an arbitrary marker with parameters. + The only intended use is to emit COM or APPn markers after calling + write_file_header and before calling write_frame_header. + Other uses are not guaranteed to produce desirable results. + Counting the parameter bytes properly is the caller's responsibility. } + +{METHODDEF} +procedure write_marker_header (cinfo : j_compress_ptr; + marker : int; + datalen : uint); +{ Emit an arbitrary marker header } +begin + if (datalen > uint(65533)) then { safety check } + ERREXIT(j_common_ptr(cinfo), JERR_BAD_LENGTH); + + emit_marker(cinfo, JPEG_MARKER(marker)); + + emit_2bytes(cinfo, int(datalen + 2)); { total length } +end; + +{METHODDEF} +procedure write_marker_byte (cinfo : j_compress_ptr; val : int); +{ Emit one byte of marker parameters following write_marker_header } +begin + emit_byte(cinfo, val); +end; + +{ Write datastream header. + This consists of an SOI and optional APPn markers. + We recommend use of the JFIF marker, but not the Adobe marker, + when using YCbCr or grayscale data. The JFIF marker should NOT + be used for any other JPEG colorspace. The Adobe marker is helpful + to distinguish RGB, CMYK, and YCCK colorspaces. + Note that an application can write additional header markers after + jpeg_start_compress returns. } + + +{METHODDEF} +procedure write_file_header (cinfo : j_compress_ptr); +var + marker : my_marker_ptr; +begin + marker := my_marker_ptr(cinfo^.marker); + + emit_marker(cinfo, M_SOI); { first the SOI } + + { SOI is defined to reset restart interval to 0 } + marker^.last_restart_interval := 0; + + if (cinfo^.write_JFIF_header) then { next an optional JFIF APP0 } + emit_jfif_app0(cinfo); + if (cinfo^.write_Adobe_marker) then { next an optional Adobe APP14 } + emit_adobe_app14(cinfo); +end; + + +{ Write frame header. + This consists of DQT and SOFn markers. + Note that we do not emit the SOF until we have emitted the DQT(s). + This avoids compatibility problems with incorrect implementations that + try to error-check the quant table numbers as soon as they see the SOF. } + + +{METHODDEF} +procedure write_frame_header (cinfo : j_compress_ptr); +var + ci, prec : int; + is_baseline : boolean; + compptr : jpeg_component_info_ptr; +begin + { Emit DQT for each quantization table. + Note that emit_dqt() suppresses any duplicate tables. } + + prec := 0; + compptr := jpeg_component_info_ptr(cinfo^.comp_info); + for ci := 0 to Pred(cinfo^.num_components) do + begin + prec := prec + emit_dqt(cinfo, compptr^.quant_tbl_no); + Inc(compptr); + end; + { now prec is nonzero iff there are any 16-bit quant tables. } + + { Check for a non-baseline specification. + Note we assume that Huffman table numbers won't be changed later. } + + if (cinfo^.arith_code) or (cinfo^.progressive_mode) + or (cinfo^.data_precision <> 8) then + begin + is_baseline := FALSE; + end + else + begin + is_baseline := TRUE; + compptr := jpeg_component_info_ptr(cinfo^.comp_info); + for ci := 0 to Pred(cinfo^.num_components) do + begin + if (compptr^.dc_tbl_no > 1) or (compptr^.ac_tbl_no > 1) then + is_baseline := FALSE; + Inc(compptr); + end; + if (prec <> 0) and (is_baseline) then + begin + is_baseline := FALSE; + { If it's baseline except for quantizer size, warn the user } + {$IFDEF DEBUG} + TRACEMS(j_common_ptr(cinfo), 0, JTRC_16BIT_TABLES); + {$ENDIF} + end; + end; + + { Emit the proper SOF marker } + if (cinfo^.arith_code) then + begin + emit_sof(cinfo, M_SOF9); { SOF code for arithmetic coding } + end + else + begin + if (cinfo^.progressive_mode) then + emit_sof(cinfo, M_SOF2) { SOF code for progressive Huffman } + else if (is_baseline) then + emit_sof(cinfo, M_SOF0) { SOF code for baseline implementation } + else + emit_sof(cinfo, M_SOF1); { SOF code for non-baseline Huffman file } + end; +end; + + +{ Write scan header. + This consists of DHT or DAC markers, optional DRI, and SOS. + Compressed data will be written following the SOS. } + +{METHODDEF} +procedure write_scan_header (cinfo : j_compress_ptr); +var + marker : my_marker_ptr; + i : int; + compptr : jpeg_component_info_ptr; +begin + marker := my_marker_ptr(cinfo^.marker); + if (cinfo^.arith_code) then + begin + { Emit arith conditioning info. We may have some duplication + if the file has multiple scans, but it's so small it's hardly + worth worrying about. } + emit_dac(cinfo); + end + else + begin + { Emit Huffman tables. + Note that emit_dht() suppresses any duplicate tables. } + for i := 0 to Pred(cinfo^.comps_in_scan) do + begin + compptr := cinfo^.cur_comp_info[i]; + if (cinfo^.progressive_mode) then + begin + { Progressive mode: only DC or only AC tables are used in one scan } + if (cinfo^.Ss = 0) then + begin + if (cinfo^.Ah = 0) then { DC needs no table for refinement scan } + emit_dht(cinfo, compptr^.dc_tbl_no, FALSE); + end + else + begin + emit_dht(cinfo, compptr^.ac_tbl_no, TRUE); + end; + end + else + begin + { Sequential mode: need both DC and AC tables } + emit_dht(cinfo, compptr^.dc_tbl_no, FALSE); + emit_dht(cinfo, compptr^.ac_tbl_no, TRUE); + end; + end; + end; + + { Emit DRI if required --- note that DRI value could change for each scan. + We avoid wasting space with unnecessary DRIs, however. } + + if (cinfo^.restart_interval <> marker^.last_restart_interval) then + begin + emit_dri(cinfo); + marker^.last_restart_interval := cinfo^.restart_interval; + end; + + emit_sos(cinfo); +end; + + + +{ Write datastream trailer. } + + +{METHODDEF} +procedure write_file_trailer (cinfo : j_compress_ptr); +begin + emit_marker(cinfo, M_EOI); +end; + + +{ Write an abbreviated table-specification datastream. + This consists of SOI, DQT and DHT tables, and EOI. + Any table that is defined and not marked sent_table = TRUE will be + emitted. Note that all tables will be marked sent_table = TRUE at exit. } + + +{METHODDEF} +procedure write_tables_only (cinfo : j_compress_ptr); +var + i : int; +begin + emit_marker(cinfo, M_SOI); + + for i := 0 to Pred(NUM_QUANT_TBLS) do + begin + if (cinfo^.quant_tbl_ptrs[i] <> NIL) then + emit_dqt(cinfo, i); { dummy := ... } + end; + + if (not cinfo^.arith_code) then + begin + for i := 0 to Pred(NUM_HUFF_TBLS) do + begin + if (cinfo^.dc_huff_tbl_ptrs[i] <> NIL) then + emit_dht(cinfo, i, FALSE); + if (cinfo^.ac_huff_tbl_ptrs[i] <> NIL) then + emit_dht(cinfo, i, TRUE); + end; + end; + + emit_marker(cinfo, M_EOI); +end; + + +{ Initialize the marker writer module. } + +{GLOBAL} +procedure jinit_marker_writer (cinfo : j_compress_ptr); +var + marker : my_marker_ptr; +begin + { Create the subobject } + marker := my_marker_ptr( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + SIZEOF(my_marker_writer)) ); + cinfo^.marker := jpeg_marker_writer_ptr(marker); + { Initialize method pointers } + marker^.pub.write_file_header := write_file_header; + marker^.pub.write_frame_header := write_frame_header; + marker^.pub.write_scan_header := write_scan_header; + marker^.pub.write_file_trailer := write_file_trailer; + marker^.pub.write_tables_only := write_tables_only; + marker^.pub.write_marker_header := write_marker_header; + marker^.pub.write_marker_byte := write_marker_byte; + { Initialize private state } + marker^.last_restart_interval := 0; +end; + + +end. diff --git a/Imaging/JpegLib/imjcmaster.pas b/Imaging/JpegLib/imjcmaster.pas index 0a25a66..90faeb5 100644 --- a/Imaging/JpegLib/imjcmaster.pas +++ b/Imaging/JpegLib/imjcmaster.pas @@ -1,701 +1,701 @@ -unit imjcmaster; - -{ This file contains master control logic for the JPEG compressor. - These routines are concerned with parameter validation, initial setup, - and inter-pass control (determining the number of passes and the work - to be done in each pass). } - -{ Original: jcmaster.c ; Copyright (C) 1991-1997, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjdeferr, - imjerror, - imjutils, - imjpeglib; - -{ Initialize master compression control. } - -{GLOBAL} -procedure jinit_c_master_control (cinfo : j_compress_ptr; - transcode_only : boolean); - -implementation - -{ Private state } - -type - c_pass_type = ( - main_pass, { input data, also do first output step } - huff_opt_pass, { Huffman code optimization pass } - output_pass { data output pass } - ); - -type - my_master_ptr = ^my_comp_master; - my_comp_master = record - pub : jpeg_comp_master; { public fields } - - pass_type : c_pass_type; { the type of the current pass } - - pass_number : int; { # of passes completed } - total_passes : int; { total # of passes needed } - - scan_number : int; { current index in scan_info[] } - end; - - -{ Support routines that do various essential calculations. } - -{LOCAL} -procedure initial_setup (cinfo : j_compress_ptr); -{ Do computations that are needed before master selection phase } -var - ci : int; - compptr : jpeg_component_info_ptr; - samplesperrow : long; - jd_samplesperrow : JDIMENSION; -begin - - { Sanity check on image dimensions } - if (cinfo^.image_height <= 0) or (cinfo^.image_width <= 0) or - (cinfo^.num_components <= 0) or (cinfo^.input_components <= 0) then - ERREXIT(j_common_ptr(cinfo), JERR_EMPTY_IMAGE); - - { 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)); - - { Width of an input scanline must be representable as JDIMENSION. } - samplesperrow := long (cinfo^.image_width) * long (cinfo^.input_components); - jd_samplesperrow := JDIMENSION (samplesperrow); - if ( long(jd_samplesperrow) <> samplesperrow) then - ERREXIT(j_common_ptr(cinfo), JERR_WIDTH_OVERFLOW); - - { 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); - { MAX } - if cinfo^.max_h_samp_factor > compptr^.h_samp_factor then - cinfo^.max_h_samp_factor := cinfo^.max_h_samp_factor - else - cinfo^.max_h_samp_factor := compptr^.h_samp_factor; - { MAX } - if cinfo^.max_v_samp_factor > compptr^.v_samp_factor then - cinfo^.max_v_samp_factor := cinfo^.max_v_samp_factor - else - cinfo^.max_v_samp_factor := compptr^.v_samp_factor; - Inc(compptr); - end; - - { Compute dimensions of components } - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - { Fill in the correct component_index value; don't rely on application } - compptr^.component_index := ci; - { For compression, we never do DCT scaling. } - 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)) ); - { 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 (this flag isn't actually used for compression) } - compptr^.component_needed := TRUE; - Inc(compptr); - end; - - { Compute number of fully interleaved MCU rows (number of times that - main controller will call coefficient controller). } - - cinfo^.total_iMCU_rows := JDIMENSION ( - jdiv_round_up(long (cinfo^.image_height), - long (cinfo^.max_v_samp_factor*DCTSIZE)) ); -end; - - -{$ifdef C_MULTISCAN_FILES_SUPPORTED} - -{LOCAL} -procedure validate_script (cinfo : j_compress_ptr); -{ Verify that the scan script in cinfo^.scan_info[] is valid; also - determine whether it uses progressive JPEG, and set cinfo^.progressive_mode. } -type - IntRow = array[0..DCTSIZE2-1] of int; - introw_ptr = ^IntRow; -var - {const}scanptr : jpeg_scan_info_ptr; - scanno, ncomps, ci, coefi, thisi : int; - Ss, Se, Ah, Al : int; - component_sent : array[0..MAX_COMPONENTS-1] of boolean; -{$ifdef C_PROGRESSIVE_SUPPORTED} - last_bitpos_int_ptr : int_ptr; - last_bitpos_ptr : introw_ptr; - last_bitpos : array[0..MAX_COMPONENTS-1] of IntRow; - { -1 until that coefficient has been seen; then last Al for it } - { The JPEG spec simply gives the ranges 0..13 for Ah and Al, but that - seems wrong: the upper bound ought to depend on data precision. - Perhaps they really meant 0..N+1 for N-bit precision. - Here we allow 0..10 for 8-bit data; Al larger than 10 results in - out-of-range reconstructed DC values during the first DC scan, - which might cause problems for some decoders. } -{$ifdef BITS_IN_JSAMPLE_IS_8} -const - MAX_AH_AL = 10; -{$else} -const - MAX_AH_AL = 13; -{$endif} -{$endif} -begin - - if (cinfo^.num_scans <= 0) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_SCAN_SCRIPT, 0); - - { For sequential JPEG, all scans must have Ss=0, Se=DCTSIZE2-1; - for progressive JPEG, no scan can have this. } - - scanptr := cinfo^.scan_info; - if (scanptr^.Ss <> 0) or (scanptr^.Se <> DCTSIZE2-1) then - begin -{$ifdef C_PROGRESSIVE_SUPPORTED} - cinfo^.progressive_mode := TRUE; - last_bitpos_int_ptr := @(last_bitpos[0][0]); - for ci := 0 to pred(cinfo^.num_components) do - for coefi := 0 to pred(DCTSIZE2) do - begin - last_bitpos_int_ptr^ := -1; - Inc(last_bitpos_int_ptr); - end; -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); -{$endif} - end - else - begin - cinfo^.progressive_mode := FALSE; - for ci := 0 to pred(cinfo^.num_components) do - component_sent[ci] := FALSE; - end; - - for scanno := 1 to cinfo^.num_scans do - begin - { Validate component indexes } - ncomps := scanptr^.comps_in_scan; - if (ncomps <= 0) or (ncomps > MAX_COMPS_IN_SCAN) then - ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, ncomps, MAX_COMPS_IN_SCAN); - for ci := 0 to pred(ncomps) do - begin - thisi := scanptr^.component_index[ci]; - if (thisi < 0) or (thisi >= cinfo^.num_components) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_SCAN_SCRIPT, scanno); - { Components must appear in SOF order within each scan } - if (ci > 0) and (thisi <= scanptr^.component_index[ci-1]) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_SCAN_SCRIPT, scanno); - end; - { Validate progression parameters } - Ss := scanptr^.Ss; - Se := scanptr^.Se; - Ah := scanptr^.Ah; - Al := scanptr^.Al; - if (cinfo^.progressive_mode) then - begin -{$ifdef C_PROGRESSIVE_SUPPORTED} - if (Ss < 0) or (Ss >= DCTSIZE2) or (Se < Ss) or (Se >= DCTSIZE2) or - (Ah < 0) or (Ah > MAX_AH_AL) or (Al < 0) or (Al > MAX_AH_AL) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); - - if (Ss < 0) or (Ss >= DCTSIZE2) or (Se < Ss) or (Se >= DCTSIZE2) - or (Ah < 0) or (Ah > MAX_AH_AL) or (Al < 0) or (Al > MAX_AH_AL) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); - if (Ss = 0) then - begin - if (Se <> 0) then { DC and AC together not OK } - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); - end - else - begin - if (ncomps <> 1) then { AC scans must be for only one component } - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); - end; - for ci := 0 to pred(ncomps) do - begin - last_bitpos_ptr := @( last_bitpos[scanptr^.component_index[ci]]); - if (Ss <> 0) and (last_bitpos_ptr^[0] < 0) then { AC without prior DC scan } - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); - for coefi := Ss to Se do - begin - if (last_bitpos_ptr^[coefi] < 0) then - begin - { first scan of this coefficient } - if (Ah <> 0) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); - end - else - begin - { not first scan } - if (Ah <> last_bitpos_ptr^[coefi]) or (Al <> Ah-1) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); - end; - last_bitpos_ptr^[coefi] := Al; - end; - end; -{$endif} - end - else - begin - { For sequential JPEG, all progression parameters must be these: } - if (Ss <> 0) or (Se <> DCTSIZE2-1) or (Ah <> 0) or (Al <> 0) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); - { Make sure components are not sent twice } - for ci := 0 to pred(ncomps) do - begin - thisi := scanptr^.component_index[ci]; - if (component_sent[thisi]) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_SCAN_SCRIPT, scanno); - component_sent[thisi] := TRUE; - end; - end; - Inc(scanptr); - end; - - { Now verify that everything got sent. } - if (cinfo^.progressive_mode) then - begin -{$ifdef C_PROGRESSIVE_SUPPORTED} - { For progressive mode, we only check that at least some DC data - got sent for each component; the spec does not require that all bits - of all coefficients be transmitted. Would it be wiser to enforce - transmission of all coefficient bits?? } - - for ci := 0 to pred(cinfo^.num_components) do - begin - if (last_bitpos[ci][0] < 0) then - ERREXIT(j_common_ptr(cinfo), JERR_MISSING_DATA); - end; -{$endif} - end - else - begin - for ci := 0 to pred(cinfo^.num_components) do - begin - if (not component_sent[ci]) then - ERREXIT(j_common_ptr(cinfo), JERR_MISSING_DATA); - end; - end; -end; - -{$endif} { C_MULTISCAN_FILES_SUPPORTED } - - -{LOCAL} -procedure select_scan_parameters (cinfo : j_compress_ptr); -{ Set up the scan parameters for the current scan } -var - master : my_master_ptr; - {const} scanptr : jpeg_scan_info_ptr; - ci : int; -var - comp_infos : jpeg_component_info_list_ptr; -begin -{$ifdef C_MULTISCAN_FILES_SUPPORTED} - if (cinfo^.scan_info <> NIL) then - begin - { Prepare for current scan --- the script is already validated } - master := my_master_ptr (cinfo^.master); - scanptr := cinfo^.scan_info; - Inc(scanptr, master^.scan_number); - - cinfo^.comps_in_scan := scanptr^.comps_in_scan; - comp_infos := cinfo^.comp_info; - for ci := 0 to pred(scanptr^.comps_in_scan) do - begin - cinfo^.cur_comp_info[ci] := - @(comp_infos^[scanptr^.component_index[ci]]); - end; - cinfo^.Ss := scanptr^.Ss; - cinfo^.Se := scanptr^.Se; - cinfo^.Ah := scanptr^.Ah; - cinfo^.Al := scanptr^.Al; - end - else -{$endif} - begin - { Prepare for single sequential-JPEG scan containing all components } - if (cinfo^.num_components > MAX_COMPS_IN_SCAN) then - ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, cinfo^.num_components, - MAX_COMPS_IN_SCAN); - cinfo^.comps_in_scan := cinfo^.num_components; - comp_infos := cinfo^.comp_info; - for ci := 0 to pred(cinfo^.num_components) do - begin - cinfo^.cur_comp_info[ci] := @(comp_infos^[ci]); - end; - cinfo^.Ss := 0; - cinfo^.Se := DCTSIZE2-1; - cinfo^.Ah := 0; - cinfo^.Al := 0; - end; -end; - - -{LOCAL} -procedure per_scan_setup (cinfo : j_compress_ptr); -{ Do computations that are needed before processing a JPEG scan } -{ cinfo^.comps_in_scan and cinfo^.cur_comp_info[] are already set } -var - ci, mcublks, tmp : int; - compptr : jpeg_component_info_ptr; - nominal : long; -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 := DCTSIZE; - 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 (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 * DCTSIZE; - { Figure number of non-dummy blocks in last MCU column & row } - tmp := int (compptr^.width_in_blocks) mod compptr^.MCU_width; - if (tmp = 0) then - tmp := compptr^.MCU_width; - compptr^.last_col_width := tmp; - tmp := int (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 (cinfo^.blocks_in_MCU + mcublks > C_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; - - { Convert restart specified in rows to actual MCU count. } - { Note that count must fit in 16 bits, so we provide limiting. } - if (cinfo^.restart_in_rows > 0) then - begin - nominal := long(cinfo^.restart_in_rows) * long(cinfo^.MCUs_per_row); - if nominal < long(65535) then - cinfo^.restart_interval := uInt (nominal) - else - cinfo^.restart_interval := long(65535); - end; -end; - - -{ Per-pass setup. - This is called at the beginning of each pass. We determine which modules - will be active during this pass and give them appropriate start_pass calls. - We also set is_last_pass to indicate whether any more passes will be - required. } - -{METHODDEF} -procedure prepare_for_pass (cinfo : j_compress_ptr); -var - master : my_master_ptr; -var - fallthrough : boolean; -begin - master := my_master_ptr (cinfo^.master); - fallthrough := true; - - case (master^.pass_type) of - main_pass: - begin - { Initial pass: will collect input data, and do either Huffman - optimization or data output for the first scan. } - select_scan_parameters(cinfo); - per_scan_setup(cinfo); - if (not cinfo^.raw_data_in) then - begin - cinfo^.cconvert^.start_pass (cinfo); - cinfo^.downsample^.start_pass (cinfo); - cinfo^.prep^.start_pass (cinfo, JBUF_PASS_THRU); - end; - cinfo^.fdct^.start_pass (cinfo); - cinfo^.entropy^.start_pass (cinfo, cinfo^.optimize_coding); - if master^.total_passes > 1 then - cinfo^.coef^.start_pass (cinfo, JBUF_SAVE_AND_PASS) - else - cinfo^.coef^.start_pass (cinfo, JBUF_PASS_THRU); - cinfo^.main^.start_pass (cinfo, JBUF_PASS_THRU); - if (cinfo^.optimize_coding) then - begin - { No immediate data output; postpone writing frame/scan headers } - master^.pub.call_pass_startup := FALSE; - end - else - begin - { Will write frame/scan headers at first jpeg_write_scanlines call } - master^.pub.call_pass_startup := TRUE; - end; - end; -{$ifdef ENTROPY_OPT_SUPPORTED} - huff_opt_pass, - output_pass: - begin - if (master^.pass_type = huff_opt_pass) then - begin - { Do Huffman optimization for a scan after the first one. } - select_scan_parameters(cinfo); - per_scan_setup(cinfo); - if (cinfo^.Ss <> 0) or (cinfo^.Ah = 0) or (cinfo^.arith_code) then - begin - cinfo^.entropy^.start_pass (cinfo, TRUE); - cinfo^.coef^.start_pass (cinfo, JBUF_CRANK_DEST); - master^.pub.call_pass_startup := FALSE; - fallthrough := false; - end; - { Special case: Huffman DC refinement scans need no Huffman table - and therefore we can skip the optimization pass for them. } - if fallthrough then - begin - master^.pass_type := output_pass; - Inc(master^.pass_number); - {FALLTHROUGH} - end; - end; -{$else} - output_pass: - begin -{$endif} - if fallthrough then - begin - { Do a data-output pass. } - { We need not repeat per-scan setup if prior optimization pass did it. } - if (not cinfo^.optimize_coding) then - begin - select_scan_parameters(cinfo); - per_scan_setup(cinfo); - end; - cinfo^.entropy^.start_pass (cinfo, FALSE); - cinfo^.coef^.start_pass (cinfo, JBUF_CRANK_DEST); - { We emit frame/scan headers now } - if (master^.scan_number = 0) then - cinfo^.marker^.write_frame_header (cinfo); - cinfo^.marker^.write_scan_header (cinfo); - master^.pub.call_pass_startup := FALSE; - end; - end; - else - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); - end; - - master^.pub.is_last_pass := (master^.pass_number = master^.total_passes-1); - - { Set up progress monitor's pass info if present } - if (cinfo^.progress <> NIL) then - begin - cinfo^.progress^.completed_passes := master^.pass_number; - cinfo^.progress^.total_passes := master^.total_passes; - end; -end; - - -{ Special start-of-pass hook. - This is called by jpeg_write_scanlines if call_pass_startup is TRUE. - In single-pass processing, we need this hook because we don't want to - write frame/scan headers during jpeg_start_compress; we want to let the - application write COM markers etc. between jpeg_start_compress and the - jpeg_write_scanlines loop. - In multi-pass processing, this routine is not used. } - -{METHODDEF} -procedure pass_startup (cinfo : j_compress_ptr); -begin - cinfo^.master^.call_pass_startup := FALSE; { reset flag so call only once } - - cinfo^.marker^.write_frame_header (cinfo); - cinfo^.marker^.write_scan_header (cinfo); -end; - - -{ Finish up at end of pass. } - -{METHODDEF} -procedure finish_pass_master (cinfo : j_compress_ptr); -var - master : my_master_ptr; -begin - master := my_master_ptr (cinfo^.master); - - { The entropy coder always needs an end-of-pass call, - either to analyze statistics or to flush its output buffer. } - cinfo^.entropy^.finish_pass (cinfo); - - { Update state for next pass } - case (master^.pass_type) of - main_pass: - begin - { next pass is either output of scan 0 (after optimization) - or output of scan 1 (if no optimization). } - - master^.pass_type := output_pass; - if (not cinfo^.optimize_coding) then - Inc(master^.scan_number); - end; - huff_opt_pass: - { next pass is always output of current scan } - master^.pass_type := output_pass; - output_pass: - begin - { next pass is either optimization or output of next scan } - if (cinfo^.optimize_coding) then - master^.pass_type := huff_opt_pass; - Inc(master^.scan_number); - end; - end; - - Inc(master^.pass_number); -end; - - -{ Initialize master compression control. } - -{GLOBAL} -procedure jinit_c_master_control (cinfo : j_compress_ptr; - transcode_only : boolean); -var - master : my_master_ptr; -begin - master := my_master_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_comp_master)) ); - cinfo^.master := jpeg_comp_master_ptr(master); - master^.pub.prepare_for_pass := prepare_for_pass; - master^.pub.pass_startup := pass_startup; - master^.pub.finish_pass := finish_pass_master; - master^.pub.is_last_pass := FALSE; - - { Validate parameters, determine derived values } - initial_setup(cinfo); - - if (cinfo^.scan_info <> NIL) then - begin -{$ifdef C_MULTISCAN_FILES_SUPPORTED} - validate_script(cinfo); -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); -{$endif} - end - else - begin - cinfo^.progressive_mode := FALSE; - cinfo^.num_scans := 1; - end; - - if (cinfo^.progressive_mode) then { TEMPORARY HACK ??? } - cinfo^.optimize_coding := TRUE; { assume default tables no good for progressive mode } - - { Initialize my private state } - if (transcode_only) then - begin - { no main pass in transcoding } - if (cinfo^.optimize_coding) then - master^.pass_type := huff_opt_pass - else - master^.pass_type := output_pass; - end - else - begin - { for normal compression, first pass is always this type: } - master^.pass_type := main_pass; - end; - master^.scan_number := 0; - master^.pass_number := 0; - if (cinfo^.optimize_coding) then - master^.total_passes := cinfo^.num_scans * 2 - else - master^.total_passes := cinfo^.num_scans; -end; - -end. +unit imjcmaster; + +{ This file contains master control logic for the JPEG compressor. + These routines are concerned with parameter validation, initial setup, + and inter-pass control (determining the number of passes and the work + to be done in each pass). } + +{ Original: jcmaster.c ; Copyright (C) 1991-1997, Thomas G. Lane. } + +interface + +{$I imjconfig.inc} + +uses + imjmorecfg, + imjinclude, + imjdeferr, + imjerror, + imjutils, + imjpeglib; + +{ Initialize master compression control. } + +{GLOBAL} +procedure jinit_c_master_control (cinfo : j_compress_ptr; + transcode_only : boolean); + +implementation + +{ Private state } + +type + c_pass_type = ( + main_pass, { input data, also do first output step } + huff_opt_pass, { Huffman code optimization pass } + output_pass { data output pass } + ); + +type + my_master_ptr = ^my_comp_master; + my_comp_master = record + pub : jpeg_comp_master; { public fields } + + pass_type : c_pass_type; { the type of the current pass } + + pass_number : int; { # of passes completed } + total_passes : int; { total # of passes needed } + + scan_number : int; { current index in scan_info[] } + end; + + +{ Support routines that do various essential calculations. } + +{LOCAL} +procedure initial_setup (cinfo : j_compress_ptr); +{ Do computations that are needed before master selection phase } +var + ci : int; + compptr : jpeg_component_info_ptr; + samplesperrow : long; + jd_samplesperrow : JDIMENSION; +begin + + { Sanity check on image dimensions } + if (cinfo^.image_height <= 0) or (cinfo^.image_width <= 0) or + (cinfo^.num_components <= 0) or (cinfo^.input_components <= 0) then + ERREXIT(j_common_ptr(cinfo), JERR_EMPTY_IMAGE); + + { 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)); + + { Width of an input scanline must be representable as JDIMENSION. } + samplesperrow := long (cinfo^.image_width) * long (cinfo^.input_components); + jd_samplesperrow := JDIMENSION (samplesperrow); + if ( long(jd_samplesperrow) <> samplesperrow) then + ERREXIT(j_common_ptr(cinfo), JERR_WIDTH_OVERFLOW); + + { 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); + { MAX } + if cinfo^.max_h_samp_factor > compptr^.h_samp_factor then + cinfo^.max_h_samp_factor := cinfo^.max_h_samp_factor + else + cinfo^.max_h_samp_factor := compptr^.h_samp_factor; + { MAX } + if cinfo^.max_v_samp_factor > compptr^.v_samp_factor then + cinfo^.max_v_samp_factor := cinfo^.max_v_samp_factor + else + cinfo^.max_v_samp_factor := compptr^.v_samp_factor; + Inc(compptr); + end; + + { Compute dimensions of components } + compptr := jpeg_component_info_ptr(cinfo^.comp_info); + for ci := 0 to pred(cinfo^.num_components) do + begin + { Fill in the correct component_index value; don't rely on application } + compptr^.component_index := ci; + { For compression, we never do DCT scaling. } + 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)) ); + { 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 (this flag isn't actually used for compression) } + compptr^.component_needed := TRUE; + Inc(compptr); + end; + + { Compute number of fully interleaved MCU rows (number of times that + main controller will call coefficient controller). } + + cinfo^.total_iMCU_rows := JDIMENSION ( + jdiv_round_up(long (cinfo^.image_height), + long (cinfo^.max_v_samp_factor*DCTSIZE)) ); +end; + + +{$ifdef C_MULTISCAN_FILES_SUPPORTED} + +{LOCAL} +procedure validate_script (cinfo : j_compress_ptr); +{ Verify that the scan script in cinfo^.scan_info[] is valid; also + determine whether it uses progressive JPEG, and set cinfo^.progressive_mode. } +type + IntRow = array[0..DCTSIZE2-1] of int; + introw_ptr = ^IntRow; +var + {const}scanptr : jpeg_scan_info_ptr; + scanno, ncomps, ci, coefi, thisi : int; + Ss, Se, Ah, Al : int; + component_sent : array[0..MAX_COMPONENTS-1] of boolean; +{$ifdef C_PROGRESSIVE_SUPPORTED} + last_bitpos_int_ptr : int_ptr; + last_bitpos_ptr : introw_ptr; + last_bitpos : array[0..MAX_COMPONENTS-1] of IntRow; + { -1 until that coefficient has been seen; then last Al for it } + { The JPEG spec simply gives the ranges 0..13 for Ah and Al, but that + seems wrong: the upper bound ought to depend on data precision. + Perhaps they really meant 0..N+1 for N-bit precision. + Here we allow 0..10 for 8-bit data; Al larger than 10 results in + out-of-range reconstructed DC values during the first DC scan, + which might cause problems for some decoders. } +{$ifdef BITS_IN_JSAMPLE_IS_8} +const + MAX_AH_AL = 10; +{$else} +const + MAX_AH_AL = 13; +{$endif} +{$endif} +begin + + if (cinfo^.num_scans <= 0) then + ERREXIT1(j_common_ptr(cinfo), JERR_BAD_SCAN_SCRIPT, 0); + + { For sequential JPEG, all scans must have Ss=0, Se=DCTSIZE2-1; + for progressive JPEG, no scan can have this. } + + scanptr := cinfo^.scan_info; + if (scanptr^.Ss <> 0) or (scanptr^.Se <> DCTSIZE2-1) then + begin +{$ifdef C_PROGRESSIVE_SUPPORTED} + cinfo^.progressive_mode := TRUE; + last_bitpos_int_ptr := @(last_bitpos[0][0]); + for ci := 0 to pred(cinfo^.num_components) do + for coefi := 0 to pred(DCTSIZE2) do + begin + last_bitpos_int_ptr^ := -1; + Inc(last_bitpos_int_ptr); + end; +{$else} + ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); +{$endif} + end + else + begin + cinfo^.progressive_mode := FALSE; + for ci := 0 to pred(cinfo^.num_components) do + component_sent[ci] := FALSE; + end; + + for scanno := 1 to cinfo^.num_scans do + begin + { Validate component indexes } + ncomps := scanptr^.comps_in_scan; + if (ncomps <= 0) or (ncomps > MAX_COMPS_IN_SCAN) then + ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, ncomps, MAX_COMPS_IN_SCAN); + for ci := 0 to pred(ncomps) do + begin + thisi := scanptr^.component_index[ci]; + if (thisi < 0) or (thisi >= cinfo^.num_components) then + ERREXIT1(j_common_ptr(cinfo), JERR_BAD_SCAN_SCRIPT, scanno); + { Components must appear in SOF order within each scan } + if (ci > 0) and (thisi <= scanptr^.component_index[ci-1]) then + ERREXIT1(j_common_ptr(cinfo), JERR_BAD_SCAN_SCRIPT, scanno); + end; + { Validate progression parameters } + Ss := scanptr^.Ss; + Se := scanptr^.Se; + Ah := scanptr^.Ah; + Al := scanptr^.Al; + if (cinfo^.progressive_mode) then + begin +{$ifdef C_PROGRESSIVE_SUPPORTED} + if (Ss < 0) or (Ss >= DCTSIZE2) or (Se < Ss) or (Se >= DCTSIZE2) or + (Ah < 0) or (Ah > MAX_AH_AL) or (Al < 0) or (Al > MAX_AH_AL) then + ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); + + if (Ss < 0) or (Ss >= DCTSIZE2) or (Se < Ss) or (Se >= DCTSIZE2) + or (Ah < 0) or (Ah > MAX_AH_AL) or (Al < 0) or (Al > MAX_AH_AL) then + ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); + if (Ss = 0) then + begin + if (Se <> 0) then { DC and AC together not OK } + ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); + end + else + begin + if (ncomps <> 1) then { AC scans must be for only one component } + ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); + end; + for ci := 0 to pred(ncomps) do + begin + last_bitpos_ptr := @( last_bitpos[scanptr^.component_index[ci]]); + if (Ss <> 0) and (last_bitpos_ptr^[0] < 0) then { AC without prior DC scan } + ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); + for coefi := Ss to Se do + begin + if (last_bitpos_ptr^[coefi] < 0) then + begin + { first scan of this coefficient } + if (Ah <> 0) then + ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); + end + else + begin + { not first scan } + if (Ah <> last_bitpos_ptr^[coefi]) or (Al <> Ah-1) then + ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); + end; + last_bitpos_ptr^[coefi] := Al; + end; + end; +{$endif} + end + else + begin + { For sequential JPEG, all progression parameters must be these: } + if (Ss <> 0) or (Se <> DCTSIZE2-1) or (Ah <> 0) or (Al <> 0) then + ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); + { Make sure components are not sent twice } + for ci := 0 to pred(ncomps) do + begin + thisi := scanptr^.component_index[ci]; + if (component_sent[thisi]) then + ERREXIT1(j_common_ptr(cinfo), JERR_BAD_SCAN_SCRIPT, scanno); + component_sent[thisi] := TRUE; + end; + end; + Inc(scanptr); + end; + + { Now verify that everything got sent. } + if (cinfo^.progressive_mode) then + begin +{$ifdef C_PROGRESSIVE_SUPPORTED} + { For progressive mode, we only check that at least some DC data + got sent for each component; the spec does not require that all bits + of all coefficients be transmitted. Would it be wiser to enforce + transmission of all coefficient bits?? } + + for ci := 0 to pred(cinfo^.num_components) do + begin + if (last_bitpos[ci][0] < 0) then + ERREXIT(j_common_ptr(cinfo), JERR_MISSING_DATA); + end; +{$endif} + end + else + begin + for ci := 0 to pred(cinfo^.num_components) do + begin + if (not component_sent[ci]) then + ERREXIT(j_common_ptr(cinfo), JERR_MISSING_DATA); + end; + end; +end; + +{$endif} { C_MULTISCAN_FILES_SUPPORTED } + + +{LOCAL} +procedure select_scan_parameters (cinfo : j_compress_ptr); +{ Set up the scan parameters for the current scan } +var + master : my_master_ptr; + {const} scanptr : jpeg_scan_info_ptr; + ci : int; +var + comp_infos : jpeg_component_info_list_ptr; +begin +{$ifdef C_MULTISCAN_FILES_SUPPORTED} + if (cinfo^.scan_info <> NIL) then + begin + { Prepare for current scan --- the script is already validated } + master := my_master_ptr (cinfo^.master); + scanptr := cinfo^.scan_info; + Inc(scanptr, master^.scan_number); + + cinfo^.comps_in_scan := scanptr^.comps_in_scan; + comp_infos := cinfo^.comp_info; + for ci := 0 to pred(scanptr^.comps_in_scan) do + begin + cinfo^.cur_comp_info[ci] := + @(comp_infos^[scanptr^.component_index[ci]]); + end; + cinfo^.Ss := scanptr^.Ss; + cinfo^.Se := scanptr^.Se; + cinfo^.Ah := scanptr^.Ah; + cinfo^.Al := scanptr^.Al; + end + else +{$endif} + begin + { Prepare for single sequential-JPEG scan containing all components } + if (cinfo^.num_components > MAX_COMPS_IN_SCAN) then + ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, cinfo^.num_components, + MAX_COMPS_IN_SCAN); + cinfo^.comps_in_scan := cinfo^.num_components; + comp_infos := cinfo^.comp_info; + for ci := 0 to pred(cinfo^.num_components) do + begin + cinfo^.cur_comp_info[ci] := @(comp_infos^[ci]); + end; + cinfo^.Ss := 0; + cinfo^.Se := DCTSIZE2-1; + cinfo^.Ah := 0; + cinfo^.Al := 0; + end; +end; + + +{LOCAL} +procedure per_scan_setup (cinfo : j_compress_ptr); +{ Do computations that are needed before processing a JPEG scan } +{ cinfo^.comps_in_scan and cinfo^.cur_comp_info[] are already set } +var + ci, mcublks, tmp : int; + compptr : jpeg_component_info_ptr; + nominal : long; +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 := DCTSIZE; + 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 (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 * DCTSIZE; + { Figure number of non-dummy blocks in last MCU column & row } + tmp := int (compptr^.width_in_blocks) mod compptr^.MCU_width; + if (tmp = 0) then + tmp := compptr^.MCU_width; + compptr^.last_col_width := tmp; + tmp := int (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 (cinfo^.blocks_in_MCU + mcublks > C_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; + + { Convert restart specified in rows to actual MCU count. } + { Note that count must fit in 16 bits, so we provide limiting. } + if (cinfo^.restart_in_rows > 0) then + begin + nominal := long(cinfo^.restart_in_rows) * long(cinfo^.MCUs_per_row); + if nominal < long(65535) then + cinfo^.restart_interval := uInt (nominal) + else + cinfo^.restart_interval := long(65535); + end; +end; + + +{ Per-pass setup. + This is called at the beginning of each pass. We determine which modules + will be active during this pass and give them appropriate start_pass calls. + We also set is_last_pass to indicate whether any more passes will be + required. } + +{METHODDEF} +procedure prepare_for_pass (cinfo : j_compress_ptr); +var + master : my_master_ptr; +var + fallthrough : boolean; +begin + master := my_master_ptr (cinfo^.master); + fallthrough := true; + + case (master^.pass_type) of + main_pass: + begin + { Initial pass: will collect input data, and do either Huffman + optimization or data output for the first scan. } + select_scan_parameters(cinfo); + per_scan_setup(cinfo); + if (not cinfo^.raw_data_in) then + begin + cinfo^.cconvert^.start_pass (cinfo); + cinfo^.downsample^.start_pass (cinfo); + cinfo^.prep^.start_pass (cinfo, JBUF_PASS_THRU); + end; + cinfo^.fdct^.start_pass (cinfo); + cinfo^.entropy^.start_pass (cinfo, cinfo^.optimize_coding); + if master^.total_passes > 1 then + cinfo^.coef^.start_pass (cinfo, JBUF_SAVE_AND_PASS) + else + cinfo^.coef^.start_pass (cinfo, JBUF_PASS_THRU); + cinfo^.main^.start_pass (cinfo, JBUF_PASS_THRU); + if (cinfo^.optimize_coding) then + begin + { No immediate data output; postpone writing frame/scan headers } + master^.pub.call_pass_startup := FALSE; + end + else + begin + { Will write frame/scan headers at first jpeg_write_scanlines call } + master^.pub.call_pass_startup := TRUE; + end; + end; +{$ifdef ENTROPY_OPT_SUPPORTED} + huff_opt_pass, + output_pass: + begin + if (master^.pass_type = huff_opt_pass) then + begin + { Do Huffman optimization for a scan after the first one. } + select_scan_parameters(cinfo); + per_scan_setup(cinfo); + if (cinfo^.Ss <> 0) or (cinfo^.Ah = 0) or (cinfo^.arith_code) then + begin + cinfo^.entropy^.start_pass (cinfo, TRUE); + cinfo^.coef^.start_pass (cinfo, JBUF_CRANK_DEST); + master^.pub.call_pass_startup := FALSE; + fallthrough := false; + end; + { Special case: Huffman DC refinement scans need no Huffman table + and therefore we can skip the optimization pass for them. } + if fallthrough then + begin + master^.pass_type := output_pass; + Inc(master^.pass_number); + {FALLTHROUGH} + end; + end; +{$else} + output_pass: + begin +{$endif} + if fallthrough then + begin + { Do a data-output pass. } + { We need not repeat per-scan setup if prior optimization pass did it. } + if (not cinfo^.optimize_coding) then + begin + select_scan_parameters(cinfo); + per_scan_setup(cinfo); + end; + cinfo^.entropy^.start_pass (cinfo, FALSE); + cinfo^.coef^.start_pass (cinfo, JBUF_CRANK_DEST); + { We emit frame/scan headers now } + if (master^.scan_number = 0) then + cinfo^.marker^.write_frame_header (cinfo); + cinfo^.marker^.write_scan_header (cinfo); + master^.pub.call_pass_startup := FALSE; + end; + end; + else + ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); + end; + + master^.pub.is_last_pass := (master^.pass_number = master^.total_passes-1); + + { Set up progress monitor's pass info if present } + if (cinfo^.progress <> NIL) then + begin + cinfo^.progress^.completed_passes := master^.pass_number; + cinfo^.progress^.total_passes := master^.total_passes; + end; +end; + + +{ Special start-of-pass hook. + This is called by jpeg_write_scanlines if call_pass_startup is TRUE. + In single-pass processing, we need this hook because we don't want to + write frame/scan headers during jpeg_start_compress; we want to let the + application write COM markers etc. between jpeg_start_compress and the + jpeg_write_scanlines loop. + In multi-pass processing, this routine is not used. } + +{METHODDEF} +procedure pass_startup (cinfo : j_compress_ptr); +begin + cinfo^.master^.call_pass_startup := FALSE; { reset flag so call only once } + + cinfo^.marker^.write_frame_header (cinfo); + cinfo^.marker^.write_scan_header (cinfo); +end; + + +{ Finish up at end of pass. } + +{METHODDEF} +procedure finish_pass_master (cinfo : j_compress_ptr); +var + master : my_master_ptr; +begin + master := my_master_ptr (cinfo^.master); + + { The entropy coder always needs an end-of-pass call, + either to analyze statistics or to flush its output buffer. } + cinfo^.entropy^.finish_pass (cinfo); + + { Update state for next pass } + case (master^.pass_type) of + main_pass: + begin + { next pass is either output of scan 0 (after optimization) + or output of scan 1 (if no optimization). } + + master^.pass_type := output_pass; + if (not cinfo^.optimize_coding) then + Inc(master^.scan_number); + end; + huff_opt_pass: + { next pass is always output of current scan } + master^.pass_type := output_pass; + output_pass: + begin + { next pass is either optimization or output of next scan } + if (cinfo^.optimize_coding) then + master^.pass_type := huff_opt_pass; + Inc(master^.scan_number); + end; + end; + + Inc(master^.pass_number); +end; + + +{ Initialize master compression control. } + +{GLOBAL} +procedure jinit_c_master_control (cinfo : j_compress_ptr; + transcode_only : boolean); +var + master : my_master_ptr; +begin + master := my_master_ptr( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + SIZEOF(my_comp_master)) ); + cinfo^.master := jpeg_comp_master_ptr(master); + master^.pub.prepare_for_pass := prepare_for_pass; + master^.pub.pass_startup := pass_startup; + master^.pub.finish_pass := finish_pass_master; + master^.pub.is_last_pass := FALSE; + + { Validate parameters, determine derived values } + initial_setup(cinfo); + + if (cinfo^.scan_info <> NIL) then + begin +{$ifdef C_MULTISCAN_FILES_SUPPORTED} + validate_script(cinfo); +{$else} + ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); +{$endif} + end + else + begin + cinfo^.progressive_mode := FALSE; + cinfo^.num_scans := 1; + end; + + if (cinfo^.progressive_mode) then { TEMPORARY HACK ??? } + cinfo^.optimize_coding := TRUE; { assume default tables no good for progressive mode } + + { Initialize my private state } + if (transcode_only) then + begin + { no main pass in transcoding } + if (cinfo^.optimize_coding) then + master^.pass_type := huff_opt_pass + else + master^.pass_type := output_pass; + end + else + begin + { for normal compression, first pass is always this type: } + master^.pass_type := main_pass; + end; + master^.scan_number := 0; + master^.pass_number := 0; + if (cinfo^.optimize_coding) then + master^.total_passes := cinfo^.num_scans * 2 + else + master^.total_passes := cinfo^.num_scans; +end; + +end. diff --git a/Imaging/JpegLib/imjcomapi.pas b/Imaging/JpegLib/imjcomapi.pas index 3242ed0..c58a7ae 100644 --- a/Imaging/JpegLib/imjcomapi.pas +++ b/Imaging/JpegLib/imjcomapi.pas @@ -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. diff --git a/Imaging/JpegLib/imjconfig.inc b/Imaging/JpegLib/imjconfig.inc index d1f6efa..91b3521 100644 --- a/Imaging/JpegLib/imjconfig.inc +++ b/Imaging/JpegLib/imjconfig.inc @@ -1,124 +1,124 @@ -{ ----------------------- 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-} + diff --git a/Imaging/JpegLib/imjcparam.pas b/Imaging/JpegLib/imjcparam.pas index c971e99..345fc32 100644 --- a/Imaging/JpegLib/imjcparam.pas +++ b/Imaging/JpegLib/imjcparam.pas @@ -1,701 +1,701 @@ -unit imjcparam; - -{ This file contains optional default-setting code for the JPEG compressor. - Applications do not have to use this file, but those that don't use it - must know a lot more about the innards of the JPEG code. } - -{ Original: jcparam.c ; Copyright (C) 1991-1998, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjdeferr, - imjerror, - imjcomapi, - imjpeglib; - -{ Quantization table setup routines } - -{GLOBAL} -procedure jpeg_add_quant_table (cinfo : j_compress_ptr; - which_tbl : int; - const basic_table : array of uInt; - scale_factor : int; - force_baseline : boolean); - -{GLOBAL} -procedure jpeg_set_linear_quality (cinfo : j_compress_ptr; - scale_factor : int; - force_baseline : boolean); -{ Set or change the 'quality' (quantization) setting, using default tables - and a straight percentage-scaling quality scale. In most cases it's better - to use jpeg_set_quality (below); this entry point is provided for - applications that insist on a linear percentage scaling. } - -{GLOBAL} -function jpeg_quality_scaling (quality : int) : int; -{ Convert a user-specified quality rating to a percentage scaling factor - for an underlying quantization table, using our recommended scaling curve. - The input 'quality' factor should be 0 (terrible) to 100 (very good). } - -{GLOBAL} -procedure jpeg_set_quality (cinfo : j_compress_ptr; - quality : int; - force_baseline : boolean); -{ Set or change the 'quality' (quantization) setting, using default tables. - This is the standard quality-adjusting entry point for typical user - interfaces; only those who want detailed control over quantization tables - would use the preceding three routines directly. } - -{GLOBAL} -procedure jpeg_set_defaults (cinfo : j_compress_ptr); - -{ Create a recommended progressive-JPEG script. - cinfo^.num_components and cinfo^.jpeg_color_space must be correct. } - -{ Set the JPEG colorspace, and choose colorspace-dependent default values. } - -{GLOBAL} -procedure jpeg_set_colorspace (cinfo : j_compress_ptr; - colorspace : J_COLOR_SPACE); - -{ Select an appropriate JPEG colorspace for in_color_space. } - -{GLOBAL} -procedure jpeg_default_colorspace (cinfo : j_compress_ptr); - -{GLOBAL} -procedure jpeg_simple_progression (cinfo : j_compress_ptr); - - -implementation - -{ Quantization table setup routines } - -{GLOBAL} -procedure jpeg_add_quant_table (cinfo : j_compress_ptr; - which_tbl : int; - const basic_table : array of uInt; - scale_factor : int; - force_baseline : boolean); -{ Define a quantization table equal to the basic_table times - a scale factor (given as a percentage). - If force_baseline is TRUE, the computed quantization table entries - are limited to 1..255 for JPEG baseline compatibility. } -var - qtblptr :^JQUANT_TBL_PTR; - i : int; - temp : long; -begin - { Safety check to ensure start_compress not called yet. } - if (cinfo^.global_state <> CSTATE_START) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - - if (which_tbl < 0) or (which_tbl >= NUM_QUANT_TBLS) then - ERREXIT1(j_common_ptr(cinfo), JERR_DQT_INDEX, which_tbl); - - qtblptr := @(cinfo^.quant_tbl_ptrs[which_tbl]); - - if (qtblptr^ = NIL) then - qtblptr^ := jpeg_alloc_quant_table(j_common_ptr(cinfo)); - - for i := 0 to pred(DCTSIZE2) do - begin - temp := (long(basic_table[i]) * scale_factor + long(50)) div long(100); - { limit the values to the valid range } - if (temp <= long(0)) then - temp := long(1); - if (temp > long(32767)) then - temp := long(32767); { max quantizer needed for 12 bits } - if (force_baseline) and (temp > long(255)) then - temp := long(255); { limit to baseline range if requested } - (qtblptr^)^.quantval[i] := UINT16 (temp); - end; - - { Initialize sent_table FALSE so table will be written to JPEG file. } - (qtblptr^)^.sent_table := FALSE; -end; - - -{GLOBAL} -procedure jpeg_set_linear_quality (cinfo : j_compress_ptr; - scale_factor : int; - force_baseline : boolean); -{ Set or change the 'quality' (quantization) setting, using default tables - and a straight percentage-scaling quality scale. In most cases it's better - to use jpeg_set_quality (below); this entry point is provided for - applications that insist on a linear percentage scaling. } - -{ These are the sample quantization tables given in JPEG spec section K.1. - The spec says that the values given produce "good" quality, and - when divided by 2, "very good" quality. } - -const - std_luminance_quant_tbl : array[0..DCTSIZE2-1] of uInt = - (16, 11, 10, 16, 24, 40, 51, 61, - 12, 12, 14, 19, 26, 58, 60, 55, - 14, 13, 16, 24, 40, 57, 69, 56, - 14, 17, 22, 29, 51, 87, 80, 62, - 18, 22, 37, 56, 68, 109, 103, 77, - 24, 35, 55, 64, 81, 104, 113, 92, - 49, 64, 78, 87, 103, 121, 120, 101, - 72, 92, 95, 98, 112, 100, 103, 99); - -const - std_chrominance_quant_tbl : array[0..DCTSIZE2-1] of uInt = - (17, 18, 24, 47, 99, 99, 99, 99, - 18, 21, 26, 66, 99, 99, 99, 99, - 24, 26, 56, 99, 99, 99, 99, 99, - 47, 66, 99, 99, 99, 99, 99, 99, - 99, 99, 99, 99, 99, 99, 99, 99, - 99, 99, 99, 99, 99, 99, 99, 99, - 99, 99, 99, 99, 99, 99, 99, 99, - 99, 99, 99, 99, 99, 99, 99, 99); -begin - { Set up two quantization tables using the specified scaling } - jpeg_add_quant_table(cinfo, 0, std_luminance_quant_tbl, - scale_factor, force_baseline); - jpeg_add_quant_table(cinfo, 1, std_chrominance_quant_tbl, - scale_factor, force_baseline); -end; - - -{GLOBAL} -function jpeg_quality_scaling (quality : int) : int; -{ Convert a user-specified quality rating to a percentage scaling factor - for an underlying quantization table, using our recommended scaling curve. - The input 'quality' factor should be 0 (terrible) to 100 (very good). } -begin - { Safety limit on quality factor. Convert 0 to 1 to avoid zero divide. } - if (quality <= 0) then - quality := 1; - if (quality > 100) then - quality := 100; - - { The basic table is used as-is (scaling 100) for a quality of 50. - Qualities 50..100 are converted to scaling percentage 200 - 2*Q; - note that at Q=100 the scaling is 0, which will cause jpeg_add_quant_table - to make all the table entries 1 (hence, minimum quantization loss). - Qualities 1..50 are converted to scaling percentage 5000/Q. } - if (quality < 50) then - quality := 5000 div quality - else - quality := 200 - quality*2; - - jpeg_quality_scaling := quality; -end; - - -{GLOBAL} -procedure jpeg_set_quality (cinfo : j_compress_ptr; - quality : int; - force_baseline : boolean); -{ Set or change the 'quality' (quantization) setting, using default tables. - This is the standard quality-adjusting entry point for typical user - interfaces; only those who want detailed control over quantization tables - would use the preceding three routines directly. } -begin - { Convert user 0-100 rating to percentage scaling } - quality := jpeg_quality_scaling(quality); - - { Set up standard quality tables } - jpeg_set_linear_quality(cinfo, quality, force_baseline); -end; - - -{ Huffman table setup routines } - -{LOCAL} -procedure add_huff_table (cinfo : j_compress_ptr; - var htblptr : JHUFF_TBL_PTR; - var bits : array of UINT8; - var val : array of UINT8); -{ Define a Huffman table } -var - nsymbols, len : int; -begin - if (htblptr = NIL) then - htblptr := jpeg_alloc_huff_table(j_common_ptr(cinfo)); - - { Copy the number-of-symbols-of-each-code-length counts } - MEMCOPY(@htblptr^.bits, @bits, SIZEOF(htblptr^.bits)); - - - { Validate the counts. We do this here mainly so we can copy the right - number of symbols from the val[] array, without risking marching off - the end of memory. jchuff.c will do a more thorough test later. } - - nsymbols := 0; - for len := 1 to 16 do - Inc(nsymbols, bits[len]); - if (nsymbols < 1) or (nsymbols > 256) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE); - - MEMCOPY(@htblptr^.huffval, @val, nsymbols * SIZEOF(UINT8)); - - { Initialize sent_table FALSE so table will be written to JPEG file. } - (htblptr)^.sent_table := FALSE; -end; - - -{$J+} -{LOCAL} -procedure std_huff_tables (cinfo : j_compress_ptr); -{ Set up the standard Huffman tables (cf. JPEG standard section K.3) } -{ IMPORTANT: these are only valid for 8-bit data precision! } - const bits_dc_luminance : array[0..17-1] of UINT8 = - ({ 0-base } 0, 0, 1, 5, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0); - const val_dc_luminance : array[0..11] of UINT8 = - (0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11); - - const bits_dc_chrominance : array[0..17-1] of UINT8 = - ( { 0-base } 0, 0, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0 ); - const val_dc_chrominance : array[0..11] of UINT8 = - ( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11 ); - - const bits_ac_luminance : array[0..17-1] of UINT8 = - ( { 0-base } 0, 0, 2, 1, 3, 3, 2, 4, 3, 5, 5, 4, 4, 0, 0, 1, $7d ); - const val_ac_luminance : array[0..161] of UINT8 = - ( $01, $02, $03, $00, $04, $11, $05, $12, - $21, $31, $41, $06, $13, $51, $61, $07, - $22, $71, $14, $32, $81, $91, $a1, $08, - $23, $42, $b1, $c1, $15, $52, $d1, $f0, - $24, $33, $62, $72, $82, $09, $0a, $16, - $17, $18, $19, $1a, $25, $26, $27, $28, - $29, $2a, $34, $35, $36, $37, $38, $39, - $3a, $43, $44, $45, $46, $47, $48, $49, - $4a, $53, $54, $55, $56, $57, $58, $59, - $5a, $63, $64, $65, $66, $67, $68, $69, - $6a, $73, $74, $75, $76, $77, $78, $79, - $7a, $83, $84, $85, $86, $87, $88, $89, - $8a, $92, $93, $94, $95, $96, $97, $98, - $99, $9a, $a2, $a3, $a4, $a5, $a6, $a7, - $a8, $a9, $aa, $b2, $b3, $b4, $b5, $b6, - $b7, $b8, $b9, $ba, $c2, $c3, $c4, $c5, - $c6, $c7, $c8, $c9, $ca, $d2, $d3, $d4, - $d5, $d6, $d7, $d8, $d9, $da, $e1, $e2, - $e3, $e4, $e5, $e6, $e7, $e8, $e9, $ea, - $f1, $f2, $f3, $f4, $f5, $f6, $f7, $f8, - $f9, $fa ); - - const bits_ac_chrominance : array[0..17-1] of UINT8 = - ( { 0-base } 0, 0, 2, 1, 2, 4, 4, 3, 4, 7, 5, 4, 4, 0, 1, 2, $77 ); - const val_ac_chrominance : array[0..161] of UINT8 = - ( $00, $01, $02, $03, $11, $04, $05, $21, - $31, $06, $12, $41, $51, $07, $61, $71, - $13, $22, $32, $81, $08, $14, $42, $91, - $a1, $b1, $c1, $09, $23, $33, $52, $f0, - $15, $62, $72, $d1, $0a, $16, $24, $34, - $e1, $25, $f1, $17, $18, $19, $1a, $26, - $27, $28, $29, $2a, $35, $36, $37, $38, - $39, $3a, $43, $44, $45, $46, $47, $48, - $49, $4a, $53, $54, $55, $56, $57, $58, - $59, $5a, $63, $64, $65, $66, $67, $68, - $69, $6a, $73, $74, $75, $76, $77, $78, - $79, $7a, $82, $83, $84, $85, $86, $87, - $88, $89, $8a, $92, $93, $94, $95, $96, - $97, $98, $99, $9a, $a2, $a3, $a4, $a5, - $a6, $a7, $a8, $a9, $aa, $b2, $b3, $b4, - $b5, $b6, $b7, $b8, $b9, $ba, $c2, $c3, - $c4, $c5, $c6, $c7, $c8, $c9, $ca, $d2, - $d3, $d4, $d5, $d6, $d7, $d8, $d9, $da, - $e2, $e3, $e4, $e5, $e6, $e7, $e8, $e9, - $ea, $f2, $f3, $f4, $f5, $f6, $f7, $f8, - $f9, $fa ); -begin - add_huff_table(cinfo, cinfo^.dc_huff_tbl_ptrs[0], - bits_dc_luminance, val_dc_luminance); - add_huff_table(cinfo, cinfo^.ac_huff_tbl_ptrs[0], - bits_ac_luminance, val_ac_luminance); - add_huff_table(cinfo, cinfo^.dc_huff_tbl_ptrs[1], - bits_dc_chrominance, val_dc_chrominance); - add_huff_table(cinfo, cinfo^.ac_huff_tbl_ptrs[1], - bits_ac_chrominance, val_ac_chrominance); -end; - - -{ Default parameter setup for compression. - - Applications that don't choose to use this routine must do their - own setup of all these parameters. Alternately, you can call this - to establish defaults and then alter parameters selectively. This - is the recommended approach since, if we add any new parameters, - your code will still work (they'll be set to reasonable defaults). } - -{GLOBAL} -procedure jpeg_set_defaults (cinfo : j_compress_ptr); -var - i : int; -begin - { Safety check to ensure start_compress not called yet. } - if (cinfo^.global_state <> CSTATE_START) then - ERREXIT1(J_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - - { Allocate comp_info array large enough for maximum component count. - Array is made permanent in case application wants to compress - multiple images at same param settings. } - - if (cinfo^.comp_info = NIL) then - cinfo^.comp_info := jpeg_component_info_list_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_PERMANENT, - MAX_COMPONENTS * SIZEOF(jpeg_component_info)) ); - - { Initialize everything not dependent on the color space } - - cinfo^.data_precision := BITS_IN_JSAMPLE; - { Set up two quantization tables using default quality of 75 } - jpeg_set_quality(cinfo, 75, TRUE); - { Set up two Huffman tables } - std_huff_tables(cinfo); - - { Initialize default arithmetic coding conditioning } - for i := 0 to pred(NUM_ARITH_TBLS) do - begin - cinfo^.arith_dc_L[i] := 0; - cinfo^.arith_dc_U[i] := 1; - cinfo^.arith_ac_K[i] := 5; - end; - - { Default is no multiple-scan output } - cinfo^.scan_info := NIL; - cinfo^.num_scans := 0; - - { Expect normal source image, not raw downsampled data } - cinfo^.raw_data_in := FALSE; - - { Use Huffman coding, not arithmetic coding, by default } - cinfo^.arith_code := FALSE; - - { By default, don't do extra passes to optimize entropy coding } - cinfo^.optimize_coding := FALSE; - { The standard Huffman tables are only valid for 8-bit data precision. - If the precision is higher, force optimization on so that usable - tables will be computed. This test can be removed if default tables - are supplied that are valid for the desired precision. } - - if (cinfo^.data_precision > 8) then - cinfo^.optimize_coding := TRUE; - - { By default, use the simpler non-cosited sampling alignment } - cinfo^.CCIR601_sampling := FALSE; - - { No input smoothing } - cinfo^.smoothing_factor := 0; - - { DCT algorithm preference } - cinfo^.dct_method := JDCT_DEFAULT; - - { No restart markers } - cinfo^.restart_interval := 0; - cinfo^.restart_in_rows := 0; - - { Fill in default JFIF marker parameters. Note that whether the marker - will actually be written is determined by jpeg_set_colorspace. - - By default, the library emits JFIF version code 1.01. - An application that wants to emit JFIF 1.02 extension markers should set - JFIF_minor_version to 2. We could probably get away with just defaulting - to 1.02, but there may still be some decoders in use that will complain - about that; saying 1.01 should minimize compatibility problems. } - - cinfo^.JFIF_major_version := 1; { Default JFIF version = 1.01 } - cinfo^.JFIF_minor_version := 1; - cinfo^.density_unit := 0; { Pixel size is unknown by default } - cinfo^.X_density := 1; { Pixel aspect ratio is square by default } - cinfo^.Y_density := 1; - - { Choose JPEG colorspace based on input space, set defaults accordingly } - - jpeg_default_colorspace(cinfo); -end; - - -{ Select an appropriate JPEG colorspace for in_color_space. } - -{GLOBAL} -procedure jpeg_default_colorspace (cinfo : j_compress_ptr); -begin - case (cinfo^.in_color_space) of - JCS_GRAYSCALE: - jpeg_set_colorspace(cinfo, JCS_GRAYSCALE); - JCS_RGB: - jpeg_set_colorspace(cinfo, JCS_YCbCr); - JCS_YCbCr: - jpeg_set_colorspace(cinfo, JCS_YCbCr); - JCS_CMYK: - jpeg_set_colorspace(cinfo, JCS_CMYK); { By default, no translation } - JCS_YCCK: - jpeg_set_colorspace(cinfo, JCS_YCCK); - JCS_UNKNOWN: - jpeg_set_colorspace(cinfo, JCS_UNKNOWN); - else - ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE); - end; -end; - - -{ Set the JPEG colorspace, and choose colorspace-dependent default values. } - -{GLOBAL} -procedure jpeg_set_colorspace (cinfo : j_compress_ptr; - colorspace : J_COLOR_SPACE); - { macro } - procedure SET_COMP(index,id,hsamp,vsamp,quant,dctbl,actbl : int); - begin - with cinfo^.comp_info^[index] do - begin - component_id := (id); - h_samp_factor := (hsamp); - v_samp_factor := (vsamp); - quant_tbl_no := (quant); - dc_tbl_no := (dctbl); - ac_tbl_no := (actbl); - end; - end; - -var - ci : int; -begin - { Safety check to ensure start_compress not called yet. } - if (cinfo^.global_state <> CSTATE_START) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - - { For all colorspaces, we use Q and Huff tables 0 for luminance components, - tables 1 for chrominance components. } - - cinfo^.jpeg_color_space := colorspace; - - cinfo^.write_JFIF_header := FALSE; { No marker for non-JFIF colorspaces } - cinfo^.write_Adobe_marker := FALSE; { write no Adobe marker by default } - - case (colorspace) of - JCS_GRAYSCALE: - begin - cinfo^.write_JFIF_header := TRUE; { Write a JFIF marker } - cinfo^.num_components := 1; - { JFIF specifies component ID 1 } - SET_COMP(0, 1, 1,1, 0, 0,0); - end; - JCS_RGB: - begin - cinfo^.write_Adobe_marker := TRUE; { write Adobe marker to flag RGB } - cinfo^.num_components := 3; - SET_COMP(0, $52 { 'R' }, 1,1, 0, 0,0); - SET_COMP(1, $47 { 'G' }, 1,1, 0, 0,0); - SET_COMP(2, $42 { 'B' }, 1,1, 0, 0,0); - end; - JCS_YCbCr: - begin - cinfo^.write_JFIF_header := TRUE; { Write a JFIF marker } - cinfo^.num_components := 3; - { JFIF specifies component IDs 1,2,3 } - { We default to 2x2 subsamples of chrominance } - SET_COMP(0, 1, 2,2, 0, 0,0); - SET_COMP(1, 2, 1,1, 1, 1,1); - SET_COMP(2, 3, 1,1, 1, 1,1); - end; - JCS_CMYK: - begin - cinfo^.write_Adobe_marker := TRUE; { write Adobe marker to flag CMYK } - cinfo^.num_components := 4; - SET_COMP(0, $43 { 'C' }, 1,1, 0, 0,0); - SET_COMP(1, $4D { 'M' }, 1,1, 0, 0,0); - SET_COMP(2, $59 { 'Y' }, 1,1, 0, 0,0); - SET_COMP(3, $4B { 'K' }, 1,1, 0, 0,0); - end; - JCS_YCCK: - begin - cinfo^.write_Adobe_marker := TRUE; { write Adobe marker to flag YCCK } - cinfo^.num_components := 4; - SET_COMP(0, 1, 2,2, 0, 0,0); - SET_COMP(1, 2, 1,1, 1, 1,1); - SET_COMP(2, 3, 1,1, 1, 1,1); - SET_COMP(3, 4, 2,2, 0, 0,0); - end; - JCS_UNKNOWN: - begin - cinfo^.num_components := cinfo^.input_components; - if (cinfo^.num_components < 1) - or (cinfo^.num_components > MAX_COMPONENTS) then - ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, - cinfo^.num_components, MAX_COMPONENTS); - for ci := 0 to pred(cinfo^.num_components) do - begin - SET_COMP(ci, ci, 1,1, 0, 0,0); - end; - end; - else - ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); - end; -end; - - -{$ifdef C_PROGRESSIVE_SUPPORTED} - -{LOCAL} -function fill_a_scan (scanptr : jpeg_scan_info_ptr; - ci : int; Ss : int; - Se : int; Ah : int; - Al : int) : jpeg_scan_info_ptr; -{ Support routine: generate one scan for specified component } -begin - scanptr^.comps_in_scan := 1; - scanptr^.component_index[0] := ci; - scanptr^.Ss := Ss; - scanptr^.Se := Se; - scanptr^.Ah := Ah; - scanptr^.Al := Al; - Inc(scanptr); - fill_a_scan := scanptr; -end; - -{LOCAL} -function fill_scans (scanptr : jpeg_scan_info_ptr; - ncomps : int; - Ss : int; Se : int; - Ah : int; Al : int) : jpeg_scan_info_ptr; -{ Support routine: generate one scan for each component } -var - ci : int; -begin - - for ci := 0 to pred(ncomps) do - begin - scanptr^.comps_in_scan := 1; - scanptr^.component_index[0] := ci; - scanptr^.Ss := Ss; - scanptr^.Se := Se; - scanptr^.Ah := Ah; - scanptr^.Al := Al; - Inc(scanptr); - end; - fill_scans := scanptr; -end; - -{LOCAL} -function fill_dc_scans (scanptr : jpeg_scan_info_ptr; - ncomps : int; - Ah : int; Al : int) : jpeg_scan_info_ptr; -{ Support routine: generate interleaved DC scan if possible, else N scans } -var - ci : int; -begin - - if (ncomps <= MAX_COMPS_IN_SCAN) then - begin - { Single interleaved DC scan } - scanptr^.comps_in_scan := ncomps; - for ci := 0 to pred(ncomps) do - scanptr^.component_index[ci] := ci; - scanptr^.Ss := 0; - scanptr^.Se := 0; - scanptr^.Ah := Ah; - scanptr^.Al := Al; - Inc(scanptr); - end - else - begin - { Noninterleaved DC scan for each component } - scanptr := fill_scans(scanptr, ncomps, 0, 0, Ah, Al); - end; - fill_dc_scans := scanptr; -end; - - -{ Create a recommended progressive-JPEG script. - cinfo^.num_components and cinfo^.jpeg_color_space must be correct. } - -{GLOBAL} -procedure jpeg_simple_progression (cinfo : j_compress_ptr); -var - ncomps : int; - nscans : int; - scanptr : jpeg_scan_info_ptr; -begin - ncomps := cinfo^.num_components; - - { Safety check to ensure start_compress not called yet. } - if (cinfo^.global_state <> CSTATE_START) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - - { Figure space needed for script. Calculation must match code below! } - if (ncomps = 3) and (cinfo^.jpeg_color_space = JCS_YCbCr) then - begin - { Custom script for YCbCr color images. } - nscans := 10; - end - else - begin - { All-purpose script for other color spaces. } - if (ncomps > MAX_COMPS_IN_SCAN) then - nscans := 6 * ncomps { 2 DC + 4 AC scans per component } - else - nscans := 2 + 4 * ncomps; { 2 DC scans; 4 AC scans per component } - end; - - { Allocate space for script. - We need to put it in the permanent pool in case the application performs - multiple compressions without changing the settings. To avoid a memory - leak if jpeg_simple_progression is called repeatedly for the same JPEG - object, we try to re-use previously allocated space, and we allocate - enough space to handle YCbCr even if initially asked for grayscale. } - - if (cinfo^.script_space = NIL) or (cinfo^.script_space_size < nscans) then - begin - if nscans > 10 then - cinfo^.script_space_size := nscans - else - cinfo^.script_space_size := 10; - - cinfo^.script_space := jpeg_scan_info_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_PERMANENT, - cinfo^.script_space_size * SIZEOF(jpeg_scan_info)) ); - end; - scanptr := cinfo^.script_space; - - cinfo^.scan_info := scanptr; - cinfo^.num_scans := nscans; - - if (ncomps = 3) and (cinfo^.jpeg_color_space = JCS_YCbCr) then - begin - { Custom script for YCbCr color images. } - { Initial DC scan } - scanptr := fill_dc_scans(scanptr, ncomps, 0, 1); - { Initial AC scan: get some luma data out in a hurry } - scanptr := fill_a_scan(scanptr, 0, 1, 5, 0, 2); - { Chroma data is too small to be worth expending many scans on } - scanptr := fill_a_scan(scanptr, 2, 1, 63, 0, 1); - scanptr := fill_a_scan(scanptr, 1, 1, 63, 0, 1); - { Complete spectral selection for luma AC } - scanptr := fill_a_scan(scanptr, 0, 6, 63, 0, 2); - { Refine next bit of luma AC } - scanptr := fill_a_scan(scanptr, 0, 1, 63, 2, 1); - { Finish DC successive approximation } - scanptr := fill_dc_scans(scanptr, ncomps, 1, 0); - { Finish AC successive approximation } - scanptr := fill_a_scan(scanptr, 2, 1, 63, 1, 0); - scanptr := fill_a_scan(scanptr, 1, 1, 63, 1, 0); - { Luma bottom bit comes last since it's usually largest scan } - scanptr := fill_a_scan(scanptr, 0, 1, 63, 1, 0); - end - else - begin - { All-purpose script for other color spaces. } - { Successive approximation first pass } - scanptr := fill_dc_scans(scanptr, ncomps, 0, 1); - scanptr := fill_scans(scanptr, ncomps, 1, 5, 0, 2); - scanptr := fill_scans(scanptr, ncomps, 6, 63, 0, 2); - { Successive approximation second pass } - scanptr := fill_scans(scanptr, ncomps, 1, 63, 2, 1); - { Successive approximation final pass } - scanptr := fill_dc_scans(scanptr, ncomps, 1, 0); - scanptr := fill_scans(scanptr, ncomps, 1, 63, 1, 0); - end; -end; - -{$endif} -end. +unit imjcparam; + +{ This file contains optional default-setting code for the JPEG compressor. + Applications do not have to use this file, but those that don't use it + must know a lot more about the innards of the JPEG code. } + +{ Original: jcparam.c ; Copyright (C) 1991-1998, Thomas G. Lane. } + +interface + +{$I imjconfig.inc} + +uses + imjmorecfg, + imjinclude, + imjdeferr, + imjerror, + imjcomapi, + imjpeglib; + +{ Quantization table setup routines } + +{GLOBAL} +procedure jpeg_add_quant_table (cinfo : j_compress_ptr; + which_tbl : int; + const basic_table : array of uInt; + scale_factor : int; + force_baseline : boolean); + +{GLOBAL} +procedure jpeg_set_linear_quality (cinfo : j_compress_ptr; + scale_factor : int; + force_baseline : boolean); +{ Set or change the 'quality' (quantization) setting, using default tables + and a straight percentage-scaling quality scale. In most cases it's better + to use jpeg_set_quality (below); this entry point is provided for + applications that insist on a linear percentage scaling. } + +{GLOBAL} +function jpeg_quality_scaling (quality : int) : int; +{ Convert a user-specified quality rating to a percentage scaling factor + for an underlying quantization table, using our recommended scaling curve. + The input 'quality' factor should be 0 (terrible) to 100 (very good). } + +{GLOBAL} +procedure jpeg_set_quality (cinfo : j_compress_ptr; + quality : int; + force_baseline : boolean); +{ Set or change the 'quality' (quantization) setting, using default tables. + This is the standard quality-adjusting entry point for typical user + interfaces; only those who want detailed control over quantization tables + would use the preceding three routines directly. } + +{GLOBAL} +procedure jpeg_set_defaults (cinfo : j_compress_ptr); + +{ Create a recommended progressive-JPEG script. + cinfo^.num_components and cinfo^.jpeg_color_space must be correct. } + +{ Set the JPEG colorspace, and choose colorspace-dependent default values. } + +{GLOBAL} +procedure jpeg_set_colorspace (cinfo : j_compress_ptr; + colorspace : J_COLOR_SPACE); + +{ Select an appropriate JPEG colorspace for in_color_space. } + +{GLOBAL} +procedure jpeg_default_colorspace (cinfo : j_compress_ptr); + +{GLOBAL} +procedure jpeg_simple_progression (cinfo : j_compress_ptr); + + +implementation + +{ Quantization table setup routines } + +{GLOBAL} +procedure jpeg_add_quant_table (cinfo : j_compress_ptr; + which_tbl : int; + const basic_table : array of uInt; + scale_factor : int; + force_baseline : boolean); +{ Define a quantization table equal to the basic_table times + a scale factor (given as a percentage). + If force_baseline is TRUE, the computed quantization table entries + are limited to 1..255 for JPEG baseline compatibility. } +var + qtblptr :^JQUANT_TBL_PTR; + i : int; + temp : long; +begin + { Safety check to ensure start_compress not called yet. } + if (cinfo^.global_state <> CSTATE_START) then + ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); + + if (which_tbl < 0) or (which_tbl >= NUM_QUANT_TBLS) then + ERREXIT1(j_common_ptr(cinfo), JERR_DQT_INDEX, which_tbl); + + qtblptr := @(cinfo^.quant_tbl_ptrs[which_tbl]); + + if (qtblptr^ = NIL) then + qtblptr^ := jpeg_alloc_quant_table(j_common_ptr(cinfo)); + + for i := 0 to pred(DCTSIZE2) do + begin + temp := (long(basic_table[i]) * scale_factor + long(50)) div long(100); + { limit the values to the valid range } + if (temp <= long(0)) then + temp := long(1); + if (temp > long(32767)) then + temp := long(32767); { max quantizer needed for 12 bits } + if (force_baseline) and (temp > long(255)) then + temp := long(255); { limit to baseline range if requested } + (qtblptr^)^.quantval[i] := UINT16 (temp); + end; + + { Initialize sent_table FALSE so table will be written to JPEG file. } + (qtblptr^)^.sent_table := FALSE; +end; + + +{GLOBAL} +procedure jpeg_set_linear_quality (cinfo : j_compress_ptr; + scale_factor : int; + force_baseline : boolean); +{ Set or change the 'quality' (quantization) setting, using default tables + and a straight percentage-scaling quality scale. In most cases it's better + to use jpeg_set_quality (below); this entry point is provided for + applications that insist on a linear percentage scaling. } + +{ These are the sample quantization tables given in JPEG spec section K.1. + The spec says that the values given produce "good" quality, and + when divided by 2, "very good" quality. } + +const + std_luminance_quant_tbl : array[0..DCTSIZE2-1] of uInt = + (16, 11, 10, 16, 24, 40, 51, 61, + 12, 12, 14, 19, 26, 58, 60, 55, + 14, 13, 16, 24, 40, 57, 69, 56, + 14, 17, 22, 29, 51, 87, 80, 62, + 18, 22, 37, 56, 68, 109, 103, 77, + 24, 35, 55, 64, 81, 104, 113, 92, + 49, 64, 78, 87, 103, 121, 120, 101, + 72, 92, 95, 98, 112, 100, 103, 99); + +const + std_chrominance_quant_tbl : array[0..DCTSIZE2-1] of uInt = + (17, 18, 24, 47, 99, 99, 99, 99, + 18, 21, 26, 66, 99, 99, 99, 99, + 24, 26, 56, 99, 99, 99, 99, 99, + 47, 66, 99, 99, 99, 99, 99, 99, + 99, 99, 99, 99, 99, 99, 99, 99, + 99, 99, 99, 99, 99, 99, 99, 99, + 99, 99, 99, 99, 99, 99, 99, 99, + 99, 99, 99, 99, 99, 99, 99, 99); +begin + { Set up two quantization tables using the specified scaling } + jpeg_add_quant_table(cinfo, 0, std_luminance_quant_tbl, + scale_factor, force_baseline); + jpeg_add_quant_table(cinfo, 1, std_chrominance_quant_tbl, + scale_factor, force_baseline); +end; + + +{GLOBAL} +function jpeg_quality_scaling (quality : int) : int; +{ Convert a user-specified quality rating to a percentage scaling factor + for an underlying quantization table, using our recommended scaling curve. + The input 'quality' factor should be 0 (terrible) to 100 (very good). } +begin + { Safety limit on quality factor. Convert 0 to 1 to avoid zero divide. } + if (quality <= 0) then + quality := 1; + if (quality > 100) then + quality := 100; + + { The basic table is used as-is (scaling 100) for a quality of 50. + Qualities 50..100 are converted to scaling percentage 200 - 2*Q; + note that at Q=100 the scaling is 0, which will cause jpeg_add_quant_table + to make all the table entries 1 (hence, minimum quantization loss). + Qualities 1..50 are converted to scaling percentage 5000/Q. } + if (quality < 50) then + quality := 5000 div quality + else + quality := 200 - quality*2; + + jpeg_quality_scaling := quality; +end; + + +{GLOBAL} +procedure jpeg_set_quality (cinfo : j_compress_ptr; + quality : int; + force_baseline : boolean); +{ Set or change the 'quality' (quantization) setting, using default tables. + This is the standard quality-adjusting entry point for typical user + interfaces; only those who want detailed control over quantization tables + would use the preceding three routines directly. } +begin + { Convert user 0-100 rating to percentage scaling } + quality := jpeg_quality_scaling(quality); + + { Set up standard quality tables } + jpeg_set_linear_quality(cinfo, quality, force_baseline); +end; + + +{ Huffman table setup routines } + +{LOCAL} +procedure add_huff_table (cinfo : j_compress_ptr; + var htblptr : JHUFF_TBL_PTR; + var bits : array of UINT8; + var val : array of UINT8); +{ Define a Huffman table } +var + nsymbols, len : int; +begin + if (htblptr = NIL) then + htblptr := jpeg_alloc_huff_table(j_common_ptr(cinfo)); + + { Copy the number-of-symbols-of-each-code-length counts } + MEMCOPY(@htblptr^.bits, @bits, SIZEOF(htblptr^.bits)); + + + { Validate the counts. We do this here mainly so we can copy the right + number of symbols from the val[] array, without risking marching off + the end of memory. jchuff.c will do a more thorough test later. } + + nsymbols := 0; + for len := 1 to 16 do + Inc(nsymbols, bits[len]); + if (nsymbols < 1) or (nsymbols > 256) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE); + + MEMCOPY(@htblptr^.huffval, @val, nsymbols * SIZEOF(UINT8)); + + { Initialize sent_table FALSE so table will be written to JPEG file. } + (htblptr)^.sent_table := FALSE; +end; + + +{$J+} +{LOCAL} +procedure std_huff_tables (cinfo : j_compress_ptr); +{ Set up the standard Huffman tables (cf. JPEG standard section K.3) } +{ IMPORTANT: these are only valid for 8-bit data precision! } + const bits_dc_luminance : array[0..17-1] of UINT8 = + ({ 0-base } 0, 0, 1, 5, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0); + const val_dc_luminance : array[0..11] of UINT8 = + (0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11); + + const bits_dc_chrominance : array[0..17-1] of UINT8 = + ( { 0-base } 0, 0, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0 ); + const val_dc_chrominance : array[0..11] of UINT8 = + ( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11 ); + + const bits_ac_luminance : array[0..17-1] of UINT8 = + ( { 0-base } 0, 0, 2, 1, 3, 3, 2, 4, 3, 5, 5, 4, 4, 0, 0, 1, $7d ); + const val_ac_luminance : array[0..161] of UINT8 = + ( $01, $02, $03, $00, $04, $11, $05, $12, + $21, $31, $41, $06, $13, $51, $61, $07, + $22, $71, $14, $32, $81, $91, $a1, $08, + $23, $42, $b1, $c1, $15, $52, $d1, $f0, + $24, $33, $62, $72, $82, $09, $0a, $16, + $17, $18, $19, $1a, $25, $26, $27, $28, + $29, $2a, $34, $35, $36, $37, $38, $39, + $3a, $43, $44, $45, $46, $47, $48, $49, + $4a, $53, $54, $55, $56, $57, $58, $59, + $5a, $63, $64, $65, $66, $67, $68, $69, + $6a, $73, $74, $75, $76, $77, $78, $79, + $7a, $83, $84, $85, $86, $87, $88, $89, + $8a, $92, $93, $94, $95, $96, $97, $98, + $99, $9a, $a2, $a3, $a4, $a5, $a6, $a7, + $a8, $a9, $aa, $b2, $b3, $b4, $b5, $b6, + $b7, $b8, $b9, $ba, $c2, $c3, $c4, $c5, + $c6, $c7, $c8, $c9, $ca, $d2, $d3, $d4, + $d5, $d6, $d7, $d8, $d9, $da, $e1, $e2, + $e3, $e4, $e5, $e6, $e7, $e8, $e9, $ea, + $f1, $f2, $f3, $f4, $f5, $f6, $f7, $f8, + $f9, $fa ); + + const bits_ac_chrominance : array[0..17-1] of UINT8 = + ( { 0-base } 0, 0, 2, 1, 2, 4, 4, 3, 4, 7, 5, 4, 4, 0, 1, 2, $77 ); + const val_ac_chrominance : array[0..161] of UINT8 = + ( $00, $01, $02, $03, $11, $04, $05, $21, + $31, $06, $12, $41, $51, $07, $61, $71, + $13, $22, $32, $81, $08, $14, $42, $91, + $a1, $b1, $c1, $09, $23, $33, $52, $f0, + $15, $62, $72, $d1, $0a, $16, $24, $34, + $e1, $25, $f1, $17, $18, $19, $1a, $26, + $27, $28, $29, $2a, $35, $36, $37, $38, + $39, $3a, $43, $44, $45, $46, $47, $48, + $49, $4a, $53, $54, $55, $56, $57, $58, + $59, $5a, $63, $64, $65, $66, $67, $68, + $69, $6a, $73, $74, $75, $76, $77, $78, + $79, $7a, $82, $83, $84, $85, $86, $87, + $88, $89, $8a, $92, $93, $94, $95, $96, + $97, $98, $99, $9a, $a2, $a3, $a4, $a5, + $a6, $a7, $a8, $a9, $aa, $b2, $b3, $b4, + $b5, $b6, $b7, $b8, $b9, $ba, $c2, $c3, + $c4, $c5, $c6, $c7, $c8, $c9, $ca, $d2, + $d3, $d4, $d5, $d6, $d7, $d8, $d9, $da, + $e2, $e3, $e4, $e5, $e6, $e7, $e8, $e9, + $ea, $f2, $f3, $f4, $f5, $f6, $f7, $f8, + $f9, $fa ); +begin + add_huff_table(cinfo, cinfo^.dc_huff_tbl_ptrs[0], + bits_dc_luminance, val_dc_luminance); + add_huff_table(cinfo, cinfo^.ac_huff_tbl_ptrs[0], + bits_ac_luminance, val_ac_luminance); + add_huff_table(cinfo, cinfo^.dc_huff_tbl_ptrs[1], + bits_dc_chrominance, val_dc_chrominance); + add_huff_table(cinfo, cinfo^.ac_huff_tbl_ptrs[1], + bits_ac_chrominance, val_ac_chrominance); +end; + + +{ Default parameter setup for compression. + + Applications that don't choose to use this routine must do their + own setup of all these parameters. Alternately, you can call this + to establish defaults and then alter parameters selectively. This + is the recommended approach since, if we add any new parameters, + your code will still work (they'll be set to reasonable defaults). } + +{GLOBAL} +procedure jpeg_set_defaults (cinfo : j_compress_ptr); +var + i : int; +begin + { Safety check to ensure start_compress not called yet. } + if (cinfo^.global_state <> CSTATE_START) then + ERREXIT1(J_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); + + { Allocate comp_info array large enough for maximum component count. + Array is made permanent in case application wants to compress + multiple images at same param settings. } + + if (cinfo^.comp_info = NIL) then + cinfo^.comp_info := jpeg_component_info_list_ptr( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_PERMANENT, + MAX_COMPONENTS * SIZEOF(jpeg_component_info)) ); + + { Initialize everything not dependent on the color space } + + cinfo^.data_precision := BITS_IN_JSAMPLE; + { Set up two quantization tables using default quality of 75 } + jpeg_set_quality(cinfo, 75, TRUE); + { Set up two Huffman tables } + std_huff_tables(cinfo); + + { Initialize default arithmetic coding conditioning } + for i := 0 to pred(NUM_ARITH_TBLS) do + begin + cinfo^.arith_dc_L[i] := 0; + cinfo^.arith_dc_U[i] := 1; + cinfo^.arith_ac_K[i] := 5; + end; + + { Default is no multiple-scan output } + cinfo^.scan_info := NIL; + cinfo^.num_scans := 0; + + { Expect normal source image, not raw downsampled data } + cinfo^.raw_data_in := FALSE; + + { Use Huffman coding, not arithmetic coding, by default } + cinfo^.arith_code := FALSE; + + { By default, don't do extra passes to optimize entropy coding } + cinfo^.optimize_coding := FALSE; + { The standard Huffman tables are only valid for 8-bit data precision. + If the precision is higher, force optimization on so that usable + tables will be computed. This test can be removed if default tables + are supplied that are valid for the desired precision. } + + if (cinfo^.data_precision > 8) then + cinfo^.optimize_coding := TRUE; + + { By default, use the simpler non-cosited sampling alignment } + cinfo^.CCIR601_sampling := FALSE; + + { No input smoothing } + cinfo^.smoothing_factor := 0; + + { DCT algorithm preference } + cinfo^.dct_method := JDCT_DEFAULT; + + { No restart markers } + cinfo^.restart_interval := 0; + cinfo^.restart_in_rows := 0; + + { Fill in default JFIF marker parameters. Note that whether the marker + will actually be written is determined by jpeg_set_colorspace. + + By default, the library emits JFIF version code 1.01. + An application that wants to emit JFIF 1.02 extension markers should set + JFIF_minor_version to 2. We could probably get away with just defaulting + to 1.02, but there may still be some decoders in use that will complain + about that; saying 1.01 should minimize compatibility problems. } + + cinfo^.JFIF_major_version := 1; { Default JFIF version = 1.01 } + cinfo^.JFIF_minor_version := 1; + cinfo^.density_unit := 0; { Pixel size is unknown by default } + cinfo^.X_density := 1; { Pixel aspect ratio is square by default } + cinfo^.Y_density := 1; + + { Choose JPEG colorspace based on input space, set defaults accordingly } + + jpeg_default_colorspace(cinfo); +end; + + +{ Select an appropriate JPEG colorspace for in_color_space. } + +{GLOBAL} +procedure jpeg_default_colorspace (cinfo : j_compress_ptr); +begin + case (cinfo^.in_color_space) of + JCS_GRAYSCALE: + jpeg_set_colorspace(cinfo, JCS_GRAYSCALE); + JCS_RGB: + jpeg_set_colorspace(cinfo, JCS_YCbCr); + JCS_YCbCr: + jpeg_set_colorspace(cinfo, JCS_YCbCr); + JCS_CMYK: + jpeg_set_colorspace(cinfo, JCS_CMYK); { By default, no translation } + JCS_YCCK: + jpeg_set_colorspace(cinfo, JCS_YCCK); + JCS_UNKNOWN: + jpeg_set_colorspace(cinfo, JCS_UNKNOWN); + else + ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE); + end; +end; + + +{ Set the JPEG colorspace, and choose colorspace-dependent default values. } + +{GLOBAL} +procedure jpeg_set_colorspace (cinfo : j_compress_ptr; + colorspace : J_COLOR_SPACE); + { macro } + procedure SET_COMP(index,id,hsamp,vsamp,quant,dctbl,actbl : int); + begin + with cinfo^.comp_info^[index] do + begin + component_id := (id); + h_samp_factor := (hsamp); + v_samp_factor := (vsamp); + quant_tbl_no := (quant); + dc_tbl_no := (dctbl); + ac_tbl_no := (actbl); + end; + end; + +var + ci : int; +begin + { Safety check to ensure start_compress not called yet. } + if (cinfo^.global_state <> CSTATE_START) then + ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); + + { For all colorspaces, we use Q and Huff tables 0 for luminance components, + tables 1 for chrominance components. } + + cinfo^.jpeg_color_space := colorspace; + + cinfo^.write_JFIF_header := FALSE; { No marker for non-JFIF colorspaces } + cinfo^.write_Adobe_marker := FALSE; { write no Adobe marker by default } + + case (colorspace) of + JCS_GRAYSCALE: + begin + cinfo^.write_JFIF_header := TRUE; { Write a JFIF marker } + cinfo^.num_components := 1; + { JFIF specifies component ID 1 } + SET_COMP(0, 1, 1,1, 0, 0,0); + end; + JCS_RGB: + begin + cinfo^.write_Adobe_marker := TRUE; { write Adobe marker to flag RGB } + cinfo^.num_components := 3; + SET_COMP(0, $52 { 'R' }, 1,1, 0, 0,0); + SET_COMP(1, $47 { 'G' }, 1,1, 0, 0,0); + SET_COMP(2, $42 { 'B' }, 1,1, 0, 0,0); + end; + JCS_YCbCr: + begin + cinfo^.write_JFIF_header := TRUE; { Write a JFIF marker } + cinfo^.num_components := 3; + { JFIF specifies component IDs 1,2,3 } + { We default to 2x2 subsamples of chrominance } + SET_COMP(0, 1, 2,2, 0, 0,0); + SET_COMP(1, 2, 1,1, 1, 1,1); + SET_COMP(2, 3, 1,1, 1, 1,1); + end; + JCS_CMYK: + begin + cinfo^.write_Adobe_marker := TRUE; { write Adobe marker to flag CMYK } + cinfo^.num_components := 4; + SET_COMP(0, $43 { 'C' }, 1,1, 0, 0,0); + SET_COMP(1, $4D { 'M' }, 1,1, 0, 0,0); + SET_COMP(2, $59 { 'Y' }, 1,1, 0, 0,0); + SET_COMP(3, $4B { 'K' }, 1,1, 0, 0,0); + end; + JCS_YCCK: + begin + cinfo^.write_Adobe_marker := TRUE; { write Adobe marker to flag YCCK } + cinfo^.num_components := 4; + SET_COMP(0, 1, 2,2, 0, 0,0); + SET_COMP(1, 2, 1,1, 1, 1,1); + SET_COMP(2, 3, 1,1, 1, 1,1); + SET_COMP(3, 4, 2,2, 0, 0,0); + end; + JCS_UNKNOWN: + begin + cinfo^.num_components := cinfo^.input_components; + if (cinfo^.num_components < 1) + or (cinfo^.num_components > MAX_COMPONENTS) then + ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, + cinfo^.num_components, MAX_COMPONENTS); + for ci := 0 to pred(cinfo^.num_components) do + begin + SET_COMP(ci, ci, 1,1, 0, 0,0); + end; + end; + else + ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); + end; +end; + + +{$ifdef C_PROGRESSIVE_SUPPORTED} + +{LOCAL} +function fill_a_scan (scanptr : jpeg_scan_info_ptr; + ci : int; Ss : int; + Se : int; Ah : int; + Al : int) : jpeg_scan_info_ptr; +{ Support routine: generate one scan for specified component } +begin + scanptr^.comps_in_scan := 1; + scanptr^.component_index[0] := ci; + scanptr^.Ss := Ss; + scanptr^.Se := Se; + scanptr^.Ah := Ah; + scanptr^.Al := Al; + Inc(scanptr); + fill_a_scan := scanptr; +end; + +{LOCAL} +function fill_scans (scanptr : jpeg_scan_info_ptr; + ncomps : int; + Ss : int; Se : int; + Ah : int; Al : int) : jpeg_scan_info_ptr; +{ Support routine: generate one scan for each component } +var + ci : int; +begin + + for ci := 0 to pred(ncomps) do + begin + scanptr^.comps_in_scan := 1; + scanptr^.component_index[0] := ci; + scanptr^.Ss := Ss; + scanptr^.Se := Se; + scanptr^.Ah := Ah; + scanptr^.Al := Al; + Inc(scanptr); + end; + fill_scans := scanptr; +end; + +{LOCAL} +function fill_dc_scans (scanptr : jpeg_scan_info_ptr; + ncomps : int; + Ah : int; Al : int) : jpeg_scan_info_ptr; +{ Support routine: generate interleaved DC scan if possible, else N scans } +var + ci : int; +begin + + if (ncomps <= MAX_COMPS_IN_SCAN) then + begin + { Single interleaved DC scan } + scanptr^.comps_in_scan := ncomps; + for ci := 0 to pred(ncomps) do + scanptr^.component_index[ci] := ci; + scanptr^.Ss := 0; + scanptr^.Se := 0; + scanptr^.Ah := Ah; + scanptr^.Al := Al; + Inc(scanptr); + end + else + begin + { Noninterleaved DC scan for each component } + scanptr := fill_scans(scanptr, ncomps, 0, 0, Ah, Al); + end; + fill_dc_scans := scanptr; +end; + + +{ Create a recommended progressive-JPEG script. + cinfo^.num_components and cinfo^.jpeg_color_space must be correct. } + +{GLOBAL} +procedure jpeg_simple_progression (cinfo : j_compress_ptr); +var + ncomps : int; + nscans : int; + scanptr : jpeg_scan_info_ptr; +begin + ncomps := cinfo^.num_components; + + { Safety check to ensure start_compress not called yet. } + if (cinfo^.global_state <> CSTATE_START) then + ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); + + { Figure space needed for script. Calculation must match code below! } + if (ncomps = 3) and (cinfo^.jpeg_color_space = JCS_YCbCr) then + begin + { Custom script for YCbCr color images. } + nscans := 10; + end + else + begin + { All-purpose script for other color spaces. } + if (ncomps > MAX_COMPS_IN_SCAN) then + nscans := 6 * ncomps { 2 DC + 4 AC scans per component } + else + nscans := 2 + 4 * ncomps; { 2 DC scans; 4 AC scans per component } + end; + + { Allocate space for script. + We need to put it in the permanent pool in case the application performs + multiple compressions without changing the settings. To avoid a memory + leak if jpeg_simple_progression is called repeatedly for the same JPEG + object, we try to re-use previously allocated space, and we allocate + enough space to handle YCbCr even if initially asked for grayscale. } + + if (cinfo^.script_space = NIL) or (cinfo^.script_space_size < nscans) then + begin + if nscans > 10 then + cinfo^.script_space_size := nscans + else + cinfo^.script_space_size := 10; + + cinfo^.script_space := jpeg_scan_info_ptr( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_PERMANENT, + cinfo^.script_space_size * SIZEOF(jpeg_scan_info)) ); + end; + scanptr := cinfo^.script_space; + + cinfo^.scan_info := scanptr; + cinfo^.num_scans := nscans; + + if (ncomps = 3) and (cinfo^.jpeg_color_space = JCS_YCbCr) then + begin + { Custom script for YCbCr color images. } + { Initial DC scan } + scanptr := fill_dc_scans(scanptr, ncomps, 0, 1); + { Initial AC scan: get some luma data out in a hurry } + scanptr := fill_a_scan(scanptr, 0, 1, 5, 0, 2); + { Chroma data is too small to be worth expending many scans on } + scanptr := fill_a_scan(scanptr, 2, 1, 63, 0, 1); + scanptr := fill_a_scan(scanptr, 1, 1, 63, 0, 1); + { Complete spectral selection for luma AC } + scanptr := fill_a_scan(scanptr, 0, 6, 63, 0, 2); + { Refine next bit of luma AC } + scanptr := fill_a_scan(scanptr, 0, 1, 63, 2, 1); + { Finish DC successive approximation } + scanptr := fill_dc_scans(scanptr, ncomps, 1, 0); + { Finish AC successive approximation } + scanptr := fill_a_scan(scanptr, 2, 1, 63, 1, 0); + scanptr := fill_a_scan(scanptr, 1, 1, 63, 1, 0); + { Luma bottom bit comes last since it's usually largest scan } + scanptr := fill_a_scan(scanptr, 0, 1, 63, 1, 0); + end + else + begin + { All-purpose script for other color spaces. } + { Successive approximation first pass } + scanptr := fill_dc_scans(scanptr, ncomps, 0, 1); + scanptr := fill_scans(scanptr, ncomps, 1, 5, 0, 2); + scanptr := fill_scans(scanptr, ncomps, 6, 63, 0, 2); + { Successive approximation second pass } + scanptr := fill_scans(scanptr, ncomps, 1, 63, 2, 1); + { Successive approximation final pass } + scanptr := fill_dc_scans(scanptr, ncomps, 1, 0); + scanptr := fill_scans(scanptr, ncomps, 1, 63, 1, 0); + end; +end; + +{$endif} +end. diff --git a/Imaging/JpegLib/imjcphuff.pas b/Imaging/JpegLib/imjcphuff.pas index bd294a6..2b779ef 100644 --- a/Imaging/JpegLib/imjcphuff.pas +++ b/Imaging/JpegLib/imjcphuff.pas @@ -1,962 +1,962 @@ -unit imjcphuff; - -{ This file contains Huffman entropy encoding routines for progressive JPEG. - - We do not support output suspension in this module, since the library - currently does not allow multiple-scan files to be written with output - suspension. } - -{ Original: jcphuff.c; Copyright (C) 1995-1997, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjpeglib, - imjdeferr, - imjerror, - imjutils, - imjcomapi, - imjchuff; { Declarations shared with jchuff.c } - -{ Module initialization routine for progressive Huffman entropy encoding. } - -{GLOBAL} -procedure jinit_phuff_encoder (cinfo : j_compress_ptr); - -implementation - -{ Expanded entropy encoder object for progressive Huffman encoding. } -type - phuff_entropy_ptr = ^phuff_entropy_encoder; - phuff_entropy_encoder = record - pub : jpeg_entropy_encoder; { public fields } - - { Mode flag: TRUE for optimization, FALSE for actual data output } - gather_statistics : boolean; - - { Bit-level coding status. - next_output_byte/free_in_buffer are local copies of cinfo^.dest fields.} - - next_output_byte : JOCTETptr; { => next byte to write in buffer } - free_in_buffer : size_t; { # of byte spaces remaining in buffer } - put_buffer : INT32; { current bit-accumulation buffer } - put_bits : int; { # of bits now in it } - cinfo : j_compress_ptr; { link to cinfo (needed for dump_buffer) } - - { Coding status for DC components } - last_dc_val : array[0..MAX_COMPS_IN_SCAN-1] of int; - { last DC coef for each component } - - { Coding status for AC components } - ac_tbl_no : int; { the table number of the single component } - EOBRUN : uInt; { run length of EOBs } - BE : uInt; { # of buffered correction bits before MCU } - bit_buffer : JBytePtr; { buffer for correction bits (1 per char) } - { packing correction bits tightly would save some space but cost time... } - - restarts_to_go : uInt; { MCUs left in this restart interval } - next_restart_num : int; { next restart number to write (0-7) } - - { Pointers to derived tables (these workspaces have image lifespan). - Since any one scan codes only DC or only AC, we only need one set - of tables, not one for DC and one for AC. } - - derived_tbls : array[0..NUM_HUFF_TBLS-1] of c_derived_tbl_ptr; - - { Statistics tables for optimization; again, one set is enough } - count_ptrs : array[0..NUM_HUFF_TBLS-1] of TLongTablePtr; - end; - - -{ MAX_CORR_BITS is the number of bits the AC refinement correction-bit - buffer can hold. Larger sizes may slightly improve compression, but - 1000 is already well into the realm of overkill. - The minimum safe size is 64 bits. } - -const - MAX_CORR_BITS = 1000; { Max # of correction bits I can buffer } - - -{ Forward declarations } -{METHODDEF} -function encode_mcu_DC_first (cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; - forward; -{METHODDEF} -function encode_mcu_AC_first (cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; - forward; -{METHODDEF} -function encode_mcu_DC_refine (cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; - forward; -{METHODDEF} -function encode_mcu_AC_refine (cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; - forward; - -{METHODDEF} -procedure finish_pass_phuff (cinfo : j_compress_ptr); forward; - -{METHODDEF} -procedure finish_pass_gather_phuff (cinfo : j_compress_ptr); forward; - - -{ Initialize for a Huffman-compressed scan using progressive JPEG. } - -{METHODDEF} -procedure start_pass_phuff (cinfo : j_compress_ptr; - gather_statistics : boolean); -var - entropy : phuff_entropy_ptr; - is_DC_band : boolean; - ci, tbl : int; - compptr : jpeg_component_info_ptr; -begin - tbl := 0; - entropy := phuff_entropy_ptr (cinfo^.entropy); - - entropy^.cinfo := cinfo; - entropy^.gather_statistics := gather_statistics; - - is_DC_band := (cinfo^.Ss = 0); - - { We assume jcmaster.c already validated the scan parameters. } - - { Select execution routines } - if (cinfo^.Ah = 0) then - begin - if (is_DC_band) then - entropy^.pub.encode_mcu := encode_mcu_DC_first - else - entropy^.pub.encode_mcu := encode_mcu_AC_first; - end - else - begin - if (is_DC_band) then - entropy^.pub.encode_mcu := encode_mcu_DC_refine - else - begin - entropy^.pub.encode_mcu := encode_mcu_AC_refine; - { AC refinement needs a correction bit buffer } - if (entropy^.bit_buffer = NIL) then - entropy^.bit_buffer := JBytePtr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - MAX_CORR_BITS * SIZEOF(byte)) ); - end; - end; - if (gather_statistics) then - entropy^.pub.finish_pass := finish_pass_gather_phuff - else - entropy^.pub.finish_pass := finish_pass_phuff; - - { Only DC coefficients may be interleaved, so cinfo^.comps_in_scan = 1 - for AC coefficients. } - - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - { Initialize DC predictions to 0 } - entropy^.last_dc_val[ci] := 0; - { Get table index } - if (is_DC_band) then - begin - if (cinfo^.Ah <> 0) then { DC refinement needs no table } - continue; - tbl := compptr^.dc_tbl_no; - end - else - begin - tbl := compptr^.ac_tbl_no; - entropy^.ac_tbl_no := tbl; - end; - if (gather_statistics) then - begin - { Check for invalid table index } - { (make_c_derived_tbl does this in the other path) } - if (tbl < 0) or (tbl >= NUM_HUFF_TBLS) then - ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, tbl); - { Allocate and zero the statistics tables } - { Note that jpeg_gen_optimal_table expects 257 entries in each table! } - if (entropy^.count_ptrs[tbl] = NIL) then - entropy^.count_ptrs[tbl] := TLongTablePtr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - 257 * SIZEOF(long)) ); - MEMZERO(entropy^.count_ptrs[tbl], 257 * SIZEOF(long)); - end else - begin - { Compute derived values for Huffman table } - { We may do this more than once for a table, but it's not expensive } - jpeg_make_c_derived_tbl(cinfo, is_DC_band, tbl, - entropy^.derived_tbls[tbl]); - end; - end; - - { Initialize AC stuff } - entropy^.EOBRUN := 0; - entropy^.BE := 0; - - { Initialize bit buffer to empty } - entropy^.put_buffer := 0; - entropy^.put_bits := 0; - - { Initialize restart stuff } - entropy^.restarts_to_go := cinfo^.restart_interval; - entropy^.next_restart_num := 0; -end; - - - - -{LOCAL} -procedure dump_buffer (entropy : phuff_entropy_ptr); -{ Empty the output buffer; we do not support suspension in this module. } -var - dest : jpeg_destination_mgr_ptr; -begin - dest := entropy^.cinfo^.dest; - - if (not dest^.empty_output_buffer (entropy^.cinfo)) then - ERREXIT(j_common_ptr(entropy^.cinfo), JERR_CANT_SUSPEND); - { After a successful buffer dump, must reset buffer pointers } - entropy^.next_output_byte := dest^.next_output_byte; - entropy^.free_in_buffer := dest^.free_in_buffer; -end; - - -{ Outputting bits to the file } - -{ Only the right 24 bits of put_buffer are used; the valid bits are - left-justified in this part. At most 16 bits can be passed to emit_bits - in one call, and we never retain more than 7 bits in put_buffer - between calls, so 24 bits are sufficient. } - - -{LOCAL} -procedure emit_bits (entropy : phuff_entropy_ptr; - code : uInt; - size : int); {INLINE} -{ Emit some bits, unless we are in gather mode } -var - {register} put_buffer : INT32; - {register} put_bits : int; -var - c : int; -begin - { This routine is heavily used, so it's worth coding tightly. } - put_buffer := INT32 (code); - put_bits := entropy^.put_bits; - - { if size is 0, caller used an invalid Huffman table entry } - if (size = 0) then - ERREXIT(j_common_ptr(entropy^.cinfo), JERR_HUFF_MISSING_CODE); - - if (entropy^.gather_statistics) then - exit; { do nothing if we're only getting stats } - - put_buffer := put_buffer and ((INT32(1) shl size) - 1); - { mask off any extra bits in code } - - Inc(put_bits, size); { new number of bits in buffer } - - put_buffer := put_buffer shl (24 - put_bits); { align incoming bits } - - put_buffer := put_buffer or entropy^.put_buffer; - { and merge with old buffer contents } - - while (put_bits >= 8) do - begin - c := int ((put_buffer shr 16) and $FF); - - {emit_byte(entropy, c);} - { Outputting bytes to the file. - NB: these must be called only when actually outputting, - that is, entropy^.gather_statistics = FALSE. } - { Emit a byte } - entropy^.next_output_byte^ := JOCTET(c); - Inc(entropy^.next_output_byte); - Dec(entropy^.free_in_buffer); - if (entropy^.free_in_buffer = 0) then - dump_buffer(entropy); - - if (c = $FF) then - begin { need to stuff a zero byte? } - {emit_byte(entropy, 0);} - entropy^.next_output_byte^ := JOCTET(0); - Inc(entropy^.next_output_byte); - Dec(entropy^.free_in_buffer); - if (entropy^.free_in_buffer = 0) then - dump_buffer(entropy); - end; - put_buffer := put_buffer shl 8; - Dec(put_bits, 8); - end; - - entropy^.put_buffer := put_buffer; { update variables } - entropy^.put_bits := put_bits; -end; - - -{LOCAL} -procedure flush_bits (entropy : phuff_entropy_ptr); -begin - emit_bits(entropy, $7F, 7); { fill any partial byte with ones } - entropy^.put_buffer := 0; { and reset bit-buffer to empty } - entropy^.put_bits := 0; -end; - -{ Emit (or just count) a Huffman symbol. } - - -{LOCAL} -procedure emit_symbol (entropy : phuff_entropy_ptr; - tbl_no : int; - symbol : int); {INLINE} -var - tbl : c_derived_tbl_ptr; -begin - if (entropy^.gather_statistics) then - Inc(entropy^.count_ptrs[tbl_no]^[symbol]) - else - begin - tbl := entropy^.derived_tbls[tbl_no]; - emit_bits(entropy, tbl^.ehufco[symbol], tbl^.ehufsi[symbol]); - end; -end; - - -{ Emit bits from a correction bit buffer. } - -{LOCAL} -procedure emit_buffered_bits (entropy : phuff_entropy_ptr; - bufstart : JBytePtr; - nbits : uInt); -var - bufptr : byteptr; -begin - if (entropy^.gather_statistics) then - exit; { no real work } - - bufptr := byteptr(bufstart); - while (nbits > 0) do - begin - emit_bits(entropy, uInt(bufptr^), 1); - Inc(bufptr); - Dec(nbits); - end; -end; - - -{ Emit any pending EOBRUN symbol. } - -{LOCAL} -procedure emit_eobrun (entropy : phuff_entropy_ptr); -var - {register} temp, nbits : int; -begin - if (entropy^.EOBRUN > 0) then - begin { if there is any pending EOBRUN } - temp := entropy^.EOBRUN; - nbits := 0; - temp := temp shr 1; - while (temp <> 0) do - begin - Inc(nbits); - temp := temp shr 1; - end; - - { safety check: shouldn't happen given limited correction-bit buffer } - if (nbits > 14) then - ERREXIT(j_common_ptr(entropy^.cinfo), JERR_HUFF_MISSING_CODE); - - emit_symbol(entropy, entropy^.ac_tbl_no, nbits shl 4); - if (nbits <> 0) then - emit_bits(entropy, entropy^.EOBRUN, nbits); - - entropy^.EOBRUN := 0; - - { Emit any buffered correction bits } - emit_buffered_bits(entropy, entropy^.bit_buffer, entropy^.BE); - entropy^.BE := 0; - end; -end; - - -{ Emit a restart marker & resynchronize predictions. } - -{LOCAL} -procedure emit_restart (entropy : phuff_entropy_ptr; - restart_num : int); -var - ci : int; -begin - emit_eobrun(entropy); - - if (not entropy^.gather_statistics) then - begin - flush_bits(entropy); - {emit_byte(entropy, $FF);} - { Outputting bytes to the file. - NB: these must be called only when actually outputting, - that is, entropy^.gather_statistics = FALSE. } - - entropy^.next_output_byte^ := JOCTET($FF); - Inc(entropy^.next_output_byte); - Dec(entropy^.free_in_buffer); - if (entropy^.free_in_buffer = 0) then - dump_buffer(entropy); - - {emit_byte(entropy, JPEG_RST0 + restart_num);} - entropy^.next_output_byte^ := JOCTET(JPEG_RST0 + restart_num); - Inc(entropy^.next_output_byte); - Dec(entropy^.free_in_buffer); - if (entropy^.free_in_buffer = 0) then - dump_buffer(entropy); - end; - - if (entropy^.cinfo^.Ss = 0) then - begin - { Re-initialize DC predictions to 0 } - for ci := 0 to pred(entropy^.cinfo^.comps_in_scan) do - entropy^.last_dc_val[ci] := 0; - end - else - begin - { Re-initialize all AC-related fields to 0 } - entropy^.EOBRUN := 0; - entropy^.BE := 0; - end; -end; - - -{ MCU encoding for DC initial scan (either spectral selection, - or first pass of successive approximation). } - -{METHODDEF} -function encode_mcu_DC_first (cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; -var - entropy : phuff_entropy_ptr; - {register} temp, temp2 : int; - {register} nbits : int; - blkn, ci : int; - Al : int; - block : JBLOCK_PTR; - compptr : jpeg_component_info_ptr; - ishift_temp : int; -begin - entropy := phuff_entropy_ptr (cinfo^.entropy); - Al := cinfo^.Al; - - entropy^.next_output_byte := cinfo^.dest^.next_output_byte; - entropy^.free_in_buffer := cinfo^.dest^.free_in_buffer; - - { Emit restart marker if needed } - if (cinfo^.restart_interval <> 0) then - if (entropy^.restarts_to_go = 0) then - emit_restart(entropy, entropy^.next_restart_num); - - { Encode the MCU data blocks } - for blkn := 0 to pred(cinfo^.blocks_in_MCU) do - begin - block := JBLOCK_PTR(MCU_data[blkn]); - ci := cinfo^.MCU_membership[blkn]; - compptr := cinfo^.cur_comp_info[ci]; - - { Compute the DC value after the required point transform by Al. - This is simply an arithmetic right shift. } - - {temp2 := IRIGHT_SHIFT( int(block^[0]), Al);} - {IRIGHT_SHIFT_IS_UNSIGNED} - ishift_temp := int(block^[0]); - if ishift_temp < 0 then - temp2 := (ishift_temp shr Al) or ((not 0) shl (16-Al)) - else - temp2 := ishift_temp shr Al; - - - { DC differences are figured on the point-transformed values. } - temp := temp2 - entropy^.last_dc_val[ci]; - entropy^.last_dc_val[ci] := temp2; - - { Encode the DC coefficient difference per section G.1.2.1 } - temp2 := temp; - if (temp < 0) then - begin - temp := -temp; { temp is abs value of input } - { For a negative input, want temp2 := bitwise complement of abs(input) } - { This code assumes we are on a two's complement machine } - Dec(temp2); - end; - - { Find the number of bits needed for the magnitude of the coefficient } - nbits := 0; - while (temp <> 0) do - begin - Inc(nbits); - temp := temp shr 1; - end; - - { Check for out-of-range coefficient values. - Since we're encoding a difference, the range limit is twice as much. } - - if (nbits > MAX_COEF_BITS+1) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_DCT_COEF); - - { Count/emit the Huffman-coded symbol for the number of bits } - emit_symbol(entropy, compptr^.dc_tbl_no, nbits); - - { Emit that number of bits of the value, if positive, } - { or the complement of its magnitude, if negative. } - if (nbits <> 0) then { emit_bits rejects calls with size 0 } - emit_bits(entropy, uInt(temp2), nbits); - end; - - cinfo^.dest^.next_output_byte := entropy^.next_output_byte; - cinfo^.dest^.free_in_buffer := entropy^.free_in_buffer; - - { Update restart-interval state too } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - begin - entropy^.restarts_to_go := cinfo^.restart_interval; - Inc(entropy^.next_restart_num); - with entropy^ do - next_restart_num := next_restart_num and 7; - end; - Dec(entropy^.restarts_to_go); - end; - - encode_mcu_DC_first := TRUE; -end; - - -{ MCU encoding for AC initial scan (either spectral selection, - or first pass of successive approximation). } - -{METHODDEF} -function encode_mcu_AC_first (cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; -var - entropy : phuff_entropy_ptr; - {register} temp, temp2 : int; - {register} nbits : int; - {register} r, k : int; - Se : int; - Al : int; - block : JBLOCK_PTR; -begin - entropy := phuff_entropy_ptr (cinfo^.entropy); - Se := cinfo^.Se; - Al := cinfo^.Al; - - entropy^.next_output_byte := cinfo^.dest^.next_output_byte; - entropy^.free_in_buffer := cinfo^.dest^.free_in_buffer; - - { Emit restart marker if needed } - if (cinfo^.restart_interval <> 0) then - if (entropy^.restarts_to_go = 0) then - emit_restart(entropy, entropy^.next_restart_num); - - { Encode the MCU data block } - block := JBLOCK_PTR(MCU_data[0]); - - { Encode the AC coefficients per section G.1.2.2, fig. G.3 } - - r := 0; { r := run length of zeros } - - for k := cinfo^.Ss to Se do - begin - temp := (block^[jpeg_natural_order[k]]); - if (temp = 0) then - begin - Inc(r); - continue; - end; - { We must apply the point transform by Al. For AC coefficients this - is an integer division with rounding towards 0. To do this portably - in C, we shift after obtaining the absolute value; so the code is - interwoven with finding the abs value (temp) and output bits (temp2). } - - if (temp < 0) then - begin - temp := -temp; { temp is abs value of input } - temp := temp shr Al; { apply the point transform } - { For a negative coef, want temp2 := bitwise complement of abs(coef) } - temp2 := not temp; - end - else - begin - temp := temp shr Al; { apply the point transform } - temp2 := temp; - end; - { Watch out for case that nonzero coef is zero after point transform } - if (temp = 0) then - begin - Inc(r); - continue; - end; - - { Emit any pending EOBRUN } - if (entropy^.EOBRUN > 0) then - emit_eobrun(entropy); - { if run length > 15, must emit special run-length-16 codes ($F0) } - while (r > 15) do - begin - emit_symbol(entropy, entropy^.ac_tbl_no, $F0); - Dec(r, 16); - end; - - { Find the number of bits needed for the magnitude of the coefficient } - nbits := 0; { there must be at least one 1 bit } - repeat - Inc(nbits); - temp := temp shr 1; - until (temp = 0); - - { Check for out-of-range coefficient values } - if (nbits > MAX_COEF_BITS) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_DCT_COEF); - - { Count/emit Huffman symbol for run length / number of bits } - emit_symbol(entropy, entropy^.ac_tbl_no, (r shl 4) + nbits); - - { Emit that number of bits of the value, if positive, } - { or the complement of its magnitude, if negative. } - emit_bits(entropy, uInt(temp2), nbits); - - r := 0; { reset zero run length } - end; - - if (r > 0) then - begin { If there are trailing zeroes, } - Inc(entropy^.EOBRUN); { count an EOB } - if (entropy^.EOBRUN = $7FFF) then - emit_eobrun(entropy); { force it out to avoid overflow } - end; - - cinfo^.dest^.next_output_byte := entropy^.next_output_byte; - cinfo^.dest^.free_in_buffer := entropy^.free_in_buffer; - - { Update restart-interval state too } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - begin - entropy^.restarts_to_go := cinfo^.restart_interval; - Inc(entropy^.next_restart_num); - with entropy^ do - next_restart_num := next_restart_num and 7; - end; - Dec(entropy^.restarts_to_go); - end; - - encode_mcu_AC_first := TRUE; -end; - - -{ MCU encoding for DC successive approximation refinement scan. - Note: we assume such scans can be multi-component, although the spec - is not very clear on the point. } - -{METHODDEF} -function encode_mcu_DC_refine (cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; -var - entropy : phuff_entropy_ptr; - {register} temp : int; - blkn : int; - Al : int; - block : JBLOCK_PTR; -begin - entropy := phuff_entropy_ptr (cinfo^.entropy); - Al := cinfo^.Al; - - entropy^.next_output_byte := cinfo^.dest^.next_output_byte; - entropy^.free_in_buffer := cinfo^.dest^.free_in_buffer; - - { Emit restart marker if needed } - if (cinfo^.restart_interval <> 0) then - if (entropy^.restarts_to_go = 0) then - emit_restart(entropy, entropy^.next_restart_num); - - { Encode the MCU data blocks } - for blkn := 0 to pred(cinfo^.blocks_in_MCU) do - begin - block := JBLOCK_PTR(MCU_data[blkn]); - - { We simply emit the Al'th bit of the DC coefficient value. } - temp := block^[0]; - emit_bits(entropy, uInt(temp shr Al), 1); - end; - - cinfo^.dest^.next_output_byte := entropy^.next_output_byte; - cinfo^.dest^.free_in_buffer := entropy^.free_in_buffer; - - { Update restart-interval state too } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - begin - entropy^.restarts_to_go := cinfo^.restart_interval; - Inc(entropy^.next_restart_num); - with entropy^ do - next_restart_num := next_restart_num and 7; - end; - Dec(entropy^.restarts_to_go); - end; - - encode_mcu_DC_refine := TRUE; -end; - - -{ MCU encoding for AC successive approximation refinement scan. } - -{METHODDEF} -function encode_mcu_AC_refine (cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; - -var - entropy : phuff_entropy_ptr; - {register} temp : int; - {register} r, k : int; - EOB : int; - BR_buffer : JBytePtr; - BR : uInt; - Se : int; - Al : int; - block : JBLOCK_PTR; - absvalues : array[0..DCTSIZE2-1] of int; -begin - entropy := phuff_entropy_ptr(cinfo^.entropy); - Se := cinfo^.Se; - Al := cinfo^.Al; - - entropy^.next_output_byte := cinfo^.dest^.next_output_byte; - entropy^.free_in_buffer := cinfo^.dest^.free_in_buffer; - - { Emit restart marker if needed } - if (cinfo^.restart_interval <> 0) then - if (entropy^.restarts_to_go = 0) then - emit_restart(entropy, entropy^.next_restart_num); - - { Encode the MCU data block } - block := JBLOCK_PTR(MCU_data[0]); - - { It is convenient to make a pre-pass to determine the transformed - coefficients' absolute values and the EOB position. } - - EOB := 0; - for k := cinfo^.Ss to Se do - begin - temp := block^[jpeg_natural_order[k]]; - { We must apply the point transform by Al. For AC coefficients this - is an integer division with rounding towards 0. To do this portably - in C, we shift after obtaining the absolute value. } - - if (temp < 0) then - temp := -temp; { temp is abs value of input } - temp := temp shr Al; { apply the point transform } - absvalues[k] := temp; { save abs value for main pass } - if (temp = 1) then - EOB := k; { EOB := index of last newly-nonzero coef } - end; - - { Encode the AC coefficients per section G.1.2.3, fig. G.7 } - - r := 0; { r := run length of zeros } - BR := 0; { BR := count of buffered bits added now } - BR_buffer := JBytePtr(@(entropy^.bit_buffer^[entropy^.BE])); - { Append bits to buffer } - - for k := cinfo^.Ss to Se do - begin - temp := absvalues[k]; - if (temp = 0) then - begin - Inc(r); - continue; - end; - - { Emit any required ZRLs, but not if they can be folded into EOB } - while (r > 15) and (k <= EOB) do - begin - { emit any pending EOBRUN and the BE correction bits } - emit_eobrun(entropy); - { Emit ZRL } - emit_symbol(entropy, entropy^.ac_tbl_no, $F0); - Dec(r, 16); - { Emit buffered correction bits that must be associated with ZRL } - emit_buffered_bits(entropy, BR_buffer, BR); - BR_buffer := entropy^.bit_buffer; { BE bits are gone now } - BR := 0; - end; - - { If the coef was previously nonzero, it only needs a correction bit. - NOTE: a straight translation of the spec's figure G.7 would suggest - that we also need to test r > 15. But if r > 15, we can only get here - if k > EOB, which implies that this coefficient is not 1. } - if (temp > 1) then - begin - { The correction bit is the next bit of the absolute value. } - BR_buffer^[BR] := byte (temp and 1); - Inc(BR); - continue; - end; - - { Emit any pending EOBRUN and the BE correction bits } - emit_eobrun(entropy); - - { Count/emit Huffman symbol for run length / number of bits } - emit_symbol(entropy, entropy^.ac_tbl_no, (r shl 4) + 1); - - { Emit output bit for newly-nonzero coef } - if (block^[jpeg_natural_order[k]] < 0) then - temp := 0 - else - temp := 1; - emit_bits(entropy, uInt(temp), 1); - - { Emit buffered correction bits that must be associated with this code } - emit_buffered_bits(entropy, BR_buffer, BR); - BR_buffer := entropy^.bit_buffer; { BE bits are gone now } - BR := 0; - r := 0; { reset zero run length } - end; - - if (r > 0) or (BR > 0) then - begin { If there are trailing zeroes, } - Inc(entropy^.EOBRUN); { count an EOB } - Inc(entropy^.BE, BR); { concat my correction bits to older ones } - { We force out the EOB if we risk either: - 1. overflow of the EOB counter; - 2. overflow of the correction bit buffer during the next MCU. } - - if (entropy^.EOBRUN = $7FFF) or - (entropy^.BE > (MAX_CORR_BITS-DCTSIZE2+1)) then - emit_eobrun(entropy); - end; - - cinfo^.dest^.next_output_byte := entropy^.next_output_byte; - cinfo^.dest^.free_in_buffer := entropy^.free_in_buffer; - - { Update restart-interval state too } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - begin - entropy^.restarts_to_go := cinfo^.restart_interval; - Inc(entropy^.next_restart_num); - with entropy^ do - next_restart_num := next_restart_num and 7; - end; - Dec(entropy^.restarts_to_go); - end; - - encode_mcu_AC_refine := TRUE; -end; - - -{ Finish up at the end of a Huffman-compressed progressive scan. } - -{METHODDEF} -procedure finish_pass_phuff (cinfo : j_compress_ptr); -var - entropy : phuff_entropy_ptr; -begin - entropy := phuff_entropy_ptr (cinfo^.entropy); - - entropy^.next_output_byte := cinfo^.dest^.next_output_byte; - entropy^.free_in_buffer := cinfo^.dest^.free_in_buffer; - - { Flush out any buffered data } - emit_eobrun(entropy); - flush_bits(entropy); - - cinfo^.dest^.next_output_byte := entropy^.next_output_byte; - cinfo^.dest^.free_in_buffer := entropy^.free_in_buffer; -end; - - -{ Finish up a statistics-gathering pass and create the new Huffman tables. } - -{METHODDEF} -procedure finish_pass_gather_phuff (cinfo : j_compress_ptr); -var - entropy : phuff_entropy_ptr; - is_DC_band : boolean; - ci, tbl : int; - compptr : jpeg_component_info_ptr; - htblptr : ^JHUFF_TBL_PTR; - did : array[0..NUM_HUFF_TBLS-1] of boolean; -begin - tbl := 0; - entropy := phuff_entropy_ptr (cinfo^.entropy); - - { Flush out buffered data (all we care about is counting the EOB symbol) } - emit_eobrun(entropy); - - is_DC_band := (cinfo^.Ss = 0); - - { It's important not to apply jpeg_gen_optimal_table more than once - per table, because it clobbers the input frequency counts! } - - MEMZERO(@did, SIZEOF(did)); - - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - if (is_DC_band) then - begin - if (cinfo^.Ah <> 0) then { DC refinement needs no table } - continue; - tbl := compptr^.dc_tbl_no; - end - else - begin - tbl := compptr^.ac_tbl_no; - end; - if (not did[tbl]) then - begin - if (is_DC_band) then - htblptr := @(cinfo^.dc_huff_tbl_ptrs[tbl]) - else - htblptr := @(cinfo^.ac_huff_tbl_ptrs[tbl]); - if (htblptr^ = NIL) then - htblptr^ := jpeg_alloc_huff_table(j_common_ptr(cinfo)); - jpeg_gen_optimal_table(cinfo, htblptr^, entropy^.count_ptrs[tbl]^); - did[tbl] := TRUE; - end; - end; -end; - - -{ Module initialization routine for progressive Huffman entropy encoding. } - -{GLOBAL} -procedure jinit_phuff_encoder (cinfo : j_compress_ptr); -var - entropy : phuff_entropy_ptr; - i : int; -begin - entropy := phuff_entropy_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(phuff_entropy_encoder)) ); - cinfo^.entropy := jpeg_entropy_encoder_ptr(entropy); - entropy^.pub.start_pass := start_pass_phuff; - - { Mark tables unallocated } - for i := 0 to pred(NUM_HUFF_TBLS) do - begin - entropy^.derived_tbls[i] := NIL; - entropy^.count_ptrs[i] := NIL; - end; - entropy^.bit_buffer := NIL; { needed only in AC refinement scan } -end; - -end. +unit imjcphuff; + +{ This file contains Huffman entropy encoding routines for progressive JPEG. + + We do not support output suspension in this module, since the library + currently does not allow multiple-scan files to be written with output + suspension. } + +{ Original: jcphuff.c; Copyright (C) 1995-1997, Thomas G. Lane. } + +interface + +{$I imjconfig.inc} + +uses + imjmorecfg, + imjinclude, + imjpeglib, + imjdeferr, + imjerror, + imjutils, + imjcomapi, + imjchuff; { Declarations shared with jchuff.c } + +{ Module initialization routine for progressive Huffman entropy encoding. } + +{GLOBAL} +procedure jinit_phuff_encoder (cinfo : j_compress_ptr); + +implementation + +{ Expanded entropy encoder object for progressive Huffman encoding. } +type + phuff_entropy_ptr = ^phuff_entropy_encoder; + phuff_entropy_encoder = record + pub : jpeg_entropy_encoder; { public fields } + + { Mode flag: TRUE for optimization, FALSE for actual data output } + gather_statistics : boolean; + + { Bit-level coding status. + next_output_byte/free_in_buffer are local copies of cinfo^.dest fields.} + + next_output_byte : JOCTETptr; { => next byte to write in buffer } + free_in_buffer : size_t; { # of byte spaces remaining in buffer } + put_buffer : INT32; { current bit-accumulation buffer } + put_bits : int; { # of bits now in it } + cinfo : j_compress_ptr; { link to cinfo (needed for dump_buffer) } + + { Coding status for DC components } + last_dc_val : array[0..MAX_COMPS_IN_SCAN-1] of int; + { last DC coef for each component } + + { Coding status for AC components } + ac_tbl_no : int; { the table number of the single component } + EOBRUN : uInt; { run length of EOBs } + BE : uInt; { # of buffered correction bits before MCU } + bit_buffer : JBytePtr; { buffer for correction bits (1 per char) } + { packing correction bits tightly would save some space but cost time... } + + restarts_to_go : uInt; { MCUs left in this restart interval } + next_restart_num : int; { next restart number to write (0-7) } + + { Pointers to derived tables (these workspaces have image lifespan). + Since any one scan codes only DC or only AC, we only need one set + of tables, not one for DC and one for AC. } + + derived_tbls : array[0..NUM_HUFF_TBLS-1] of c_derived_tbl_ptr; + + { Statistics tables for optimization; again, one set is enough } + count_ptrs : array[0..NUM_HUFF_TBLS-1] of TLongTablePtr; + end; + + +{ MAX_CORR_BITS is the number of bits the AC refinement correction-bit + buffer can hold. Larger sizes may slightly improve compression, but + 1000 is already well into the realm of overkill. + The minimum safe size is 64 bits. } + +const + MAX_CORR_BITS = 1000; { Max # of correction bits I can buffer } + + +{ Forward declarations } +{METHODDEF} +function encode_mcu_DC_first (cinfo : j_compress_ptr; + const MCU_data: array of JBLOCKROW) : boolean; + forward; +{METHODDEF} +function encode_mcu_AC_first (cinfo : j_compress_ptr; + const MCU_data: array of JBLOCKROW) : boolean; + forward; +{METHODDEF} +function encode_mcu_DC_refine (cinfo : j_compress_ptr; + const MCU_data: array of JBLOCKROW) : boolean; + forward; +{METHODDEF} +function encode_mcu_AC_refine (cinfo : j_compress_ptr; + const MCU_data: array of JBLOCKROW) : boolean; + forward; + +{METHODDEF} +procedure finish_pass_phuff (cinfo : j_compress_ptr); forward; + +{METHODDEF} +procedure finish_pass_gather_phuff (cinfo : j_compress_ptr); forward; + + +{ Initialize for a Huffman-compressed scan using progressive JPEG. } + +{METHODDEF} +procedure start_pass_phuff (cinfo : j_compress_ptr; + gather_statistics : boolean); +var + entropy : phuff_entropy_ptr; + is_DC_band : boolean; + ci, tbl : int; + compptr : jpeg_component_info_ptr; +begin + tbl := 0; + entropy := phuff_entropy_ptr (cinfo^.entropy); + + entropy^.cinfo := cinfo; + entropy^.gather_statistics := gather_statistics; + + is_DC_band := (cinfo^.Ss = 0); + + { We assume jcmaster.c already validated the scan parameters. } + + { Select execution routines } + if (cinfo^.Ah = 0) then + begin + if (is_DC_band) then + entropy^.pub.encode_mcu := encode_mcu_DC_first + else + entropy^.pub.encode_mcu := encode_mcu_AC_first; + end + else + begin + if (is_DC_band) then + entropy^.pub.encode_mcu := encode_mcu_DC_refine + else + begin + entropy^.pub.encode_mcu := encode_mcu_AC_refine; + { AC refinement needs a correction bit buffer } + if (entropy^.bit_buffer = NIL) then + entropy^.bit_buffer := JBytePtr( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + MAX_CORR_BITS * SIZEOF(byte)) ); + end; + end; + if (gather_statistics) then + entropy^.pub.finish_pass := finish_pass_gather_phuff + else + entropy^.pub.finish_pass := finish_pass_phuff; + + { Only DC coefficients may be interleaved, so cinfo^.comps_in_scan = 1 + for AC coefficients. } + + for ci := 0 to pred(cinfo^.comps_in_scan) do + begin + compptr := cinfo^.cur_comp_info[ci]; + { Initialize DC predictions to 0 } + entropy^.last_dc_val[ci] := 0; + { Get table index } + if (is_DC_band) then + begin + if (cinfo^.Ah <> 0) then { DC refinement needs no table } + continue; + tbl := compptr^.dc_tbl_no; + end + else + begin + tbl := compptr^.ac_tbl_no; + entropy^.ac_tbl_no := tbl; + end; + if (gather_statistics) then + begin + { Check for invalid table index } + { (make_c_derived_tbl does this in the other path) } + if (tbl < 0) or (tbl >= NUM_HUFF_TBLS) then + ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, tbl); + { Allocate and zero the statistics tables } + { Note that jpeg_gen_optimal_table expects 257 entries in each table! } + if (entropy^.count_ptrs[tbl] = NIL) then + entropy^.count_ptrs[tbl] := TLongTablePtr( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + 257 * SIZEOF(long)) ); + MEMZERO(entropy^.count_ptrs[tbl], 257 * SIZEOF(long)); + end else + begin + { Compute derived values for Huffman table } + { We may do this more than once for a table, but it's not expensive } + jpeg_make_c_derived_tbl(cinfo, is_DC_band, tbl, + entropy^.derived_tbls[tbl]); + end; + end; + + { Initialize AC stuff } + entropy^.EOBRUN := 0; + entropy^.BE := 0; + + { Initialize bit buffer to empty } + entropy^.put_buffer := 0; + entropy^.put_bits := 0; + + { Initialize restart stuff } + entropy^.restarts_to_go := cinfo^.restart_interval; + entropy^.next_restart_num := 0; +end; + + + + +{LOCAL} +procedure dump_buffer (entropy : phuff_entropy_ptr); +{ Empty the output buffer; we do not support suspension in this module. } +var + dest : jpeg_destination_mgr_ptr; +begin + dest := entropy^.cinfo^.dest; + + if (not dest^.empty_output_buffer (entropy^.cinfo)) then + ERREXIT(j_common_ptr(entropy^.cinfo), JERR_CANT_SUSPEND); + { After a successful buffer dump, must reset buffer pointers } + entropy^.next_output_byte := dest^.next_output_byte; + entropy^.free_in_buffer := dest^.free_in_buffer; +end; + + +{ Outputting bits to the file } + +{ Only the right 24 bits of put_buffer are used; the valid bits are + left-justified in this part. At most 16 bits can be passed to emit_bits + in one call, and we never retain more than 7 bits in put_buffer + between calls, so 24 bits are sufficient. } + + +{LOCAL} +procedure emit_bits (entropy : phuff_entropy_ptr; + code : uInt; + size : int); {INLINE} +{ Emit some bits, unless we are in gather mode } +var + {register} put_buffer : INT32; + {register} put_bits : int; +var + c : int; +begin + { This routine is heavily used, so it's worth coding tightly. } + put_buffer := INT32 (code); + put_bits := entropy^.put_bits; + + { if size is 0, caller used an invalid Huffman table entry } + if (size = 0) then + ERREXIT(j_common_ptr(entropy^.cinfo), JERR_HUFF_MISSING_CODE); + + if (entropy^.gather_statistics) then + exit; { do nothing if we're only getting stats } + + put_buffer := put_buffer and ((INT32(1) shl size) - 1); + { mask off any extra bits in code } + + Inc(put_bits, size); { new number of bits in buffer } + + put_buffer := put_buffer shl (24 - put_bits); { align incoming bits } + + put_buffer := put_buffer or entropy^.put_buffer; + { and merge with old buffer contents } + + while (put_bits >= 8) do + begin + c := int ((put_buffer shr 16) and $FF); + + {emit_byte(entropy, c);} + { Outputting bytes to the file. + NB: these must be called only when actually outputting, + that is, entropy^.gather_statistics = FALSE. } + { Emit a byte } + entropy^.next_output_byte^ := JOCTET(c); + Inc(entropy^.next_output_byte); + Dec(entropy^.free_in_buffer); + if (entropy^.free_in_buffer = 0) then + dump_buffer(entropy); + + if (c = $FF) then + begin { need to stuff a zero byte? } + {emit_byte(entropy, 0);} + entropy^.next_output_byte^ := JOCTET(0); + Inc(entropy^.next_output_byte); + Dec(entropy^.free_in_buffer); + if (entropy^.free_in_buffer = 0) then + dump_buffer(entropy); + end; + put_buffer := put_buffer shl 8; + Dec(put_bits, 8); + end; + + entropy^.put_buffer := put_buffer; { update variables } + entropy^.put_bits := put_bits; +end; + + +{LOCAL} +procedure flush_bits (entropy : phuff_entropy_ptr); +begin + emit_bits(entropy, $7F, 7); { fill any partial byte with ones } + entropy^.put_buffer := 0; { and reset bit-buffer to empty } + entropy^.put_bits := 0; +end; + +{ Emit (or just count) a Huffman symbol. } + + +{LOCAL} +procedure emit_symbol (entropy : phuff_entropy_ptr; + tbl_no : int; + symbol : int); {INLINE} +var + tbl : c_derived_tbl_ptr; +begin + if (entropy^.gather_statistics) then + Inc(entropy^.count_ptrs[tbl_no]^[symbol]) + else + begin + tbl := entropy^.derived_tbls[tbl_no]; + emit_bits(entropy, tbl^.ehufco[symbol], tbl^.ehufsi[symbol]); + end; +end; + + +{ Emit bits from a correction bit buffer. } + +{LOCAL} +procedure emit_buffered_bits (entropy : phuff_entropy_ptr; + bufstart : JBytePtr; + nbits : uInt); +var + bufptr : byteptr; +begin + if (entropy^.gather_statistics) then + exit; { no real work } + + bufptr := byteptr(bufstart); + while (nbits > 0) do + begin + emit_bits(entropy, uInt(bufptr^), 1); + Inc(bufptr); + Dec(nbits); + end; +end; + + +{ Emit any pending EOBRUN symbol. } + +{LOCAL} +procedure emit_eobrun (entropy : phuff_entropy_ptr); +var + {register} temp, nbits : int; +begin + if (entropy^.EOBRUN > 0) then + begin { if there is any pending EOBRUN } + temp := entropy^.EOBRUN; + nbits := 0; + temp := temp shr 1; + while (temp <> 0) do + begin + Inc(nbits); + temp := temp shr 1; + end; + + { safety check: shouldn't happen given limited correction-bit buffer } + if (nbits > 14) then + ERREXIT(j_common_ptr(entropy^.cinfo), JERR_HUFF_MISSING_CODE); + + emit_symbol(entropy, entropy^.ac_tbl_no, nbits shl 4); + if (nbits <> 0) then + emit_bits(entropy, entropy^.EOBRUN, nbits); + + entropy^.EOBRUN := 0; + + { Emit any buffered correction bits } + emit_buffered_bits(entropy, entropy^.bit_buffer, entropy^.BE); + entropy^.BE := 0; + end; +end; + + +{ Emit a restart marker & resynchronize predictions. } + +{LOCAL} +procedure emit_restart (entropy : phuff_entropy_ptr; + restart_num : int); +var + ci : int; +begin + emit_eobrun(entropy); + + if (not entropy^.gather_statistics) then + begin + flush_bits(entropy); + {emit_byte(entropy, $FF);} + { Outputting bytes to the file. + NB: these must be called only when actually outputting, + that is, entropy^.gather_statistics = FALSE. } + + entropy^.next_output_byte^ := JOCTET($FF); + Inc(entropy^.next_output_byte); + Dec(entropy^.free_in_buffer); + if (entropy^.free_in_buffer = 0) then + dump_buffer(entropy); + + {emit_byte(entropy, JPEG_RST0 + restart_num);} + entropy^.next_output_byte^ := JOCTET(JPEG_RST0 + restart_num); + Inc(entropy^.next_output_byte); + Dec(entropy^.free_in_buffer); + if (entropy^.free_in_buffer = 0) then + dump_buffer(entropy); + end; + + if (entropy^.cinfo^.Ss = 0) then + begin + { Re-initialize DC predictions to 0 } + for ci := 0 to pred(entropy^.cinfo^.comps_in_scan) do + entropy^.last_dc_val[ci] := 0; + end + else + begin + { Re-initialize all AC-related fields to 0 } + entropy^.EOBRUN := 0; + entropy^.BE := 0; + end; +end; + + +{ MCU encoding for DC initial scan (either spectral selection, + or first pass of successive approximation). } + +{METHODDEF} +function encode_mcu_DC_first (cinfo : j_compress_ptr; + const MCU_data: array of JBLOCKROW) : boolean; +var + entropy : phuff_entropy_ptr; + {register} temp, temp2 : int; + {register} nbits : int; + blkn, ci : int; + Al : int; + block : JBLOCK_PTR; + compptr : jpeg_component_info_ptr; + ishift_temp : int; +begin + entropy := phuff_entropy_ptr (cinfo^.entropy); + Al := cinfo^.Al; + + entropy^.next_output_byte := cinfo^.dest^.next_output_byte; + entropy^.free_in_buffer := cinfo^.dest^.free_in_buffer; + + { Emit restart marker if needed } + if (cinfo^.restart_interval <> 0) then + if (entropy^.restarts_to_go = 0) then + emit_restart(entropy, entropy^.next_restart_num); + + { Encode the MCU data blocks } + for blkn := 0 to pred(cinfo^.blocks_in_MCU) do + begin + block := JBLOCK_PTR(MCU_data[blkn]); + ci := cinfo^.MCU_membership[blkn]; + compptr := cinfo^.cur_comp_info[ci]; + + { Compute the DC value after the required point transform by Al. + This is simply an arithmetic right shift. } + + {temp2 := IRIGHT_SHIFT( int(block^[0]), Al);} + {IRIGHT_SHIFT_IS_UNSIGNED} + ishift_temp := int(block^[0]); + if ishift_temp < 0 then + temp2 := (ishift_temp shr Al) or ((not 0) shl (16-Al)) + else + temp2 := ishift_temp shr Al; + + + { DC differences are figured on the point-transformed values. } + temp := temp2 - entropy^.last_dc_val[ci]; + entropy^.last_dc_val[ci] := temp2; + + { Encode the DC coefficient difference per section G.1.2.1 } + temp2 := temp; + if (temp < 0) then + begin + temp := -temp; { temp is abs value of input } + { For a negative input, want temp2 := bitwise complement of abs(input) } + { This code assumes we are on a two's complement machine } + Dec(temp2); + end; + + { Find the number of bits needed for the magnitude of the coefficient } + nbits := 0; + while (temp <> 0) do + begin + Inc(nbits); + temp := temp shr 1; + end; + + { Check for out-of-range coefficient values. + Since we're encoding a difference, the range limit is twice as much. } + + if (nbits > MAX_COEF_BITS+1) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_DCT_COEF); + + { Count/emit the Huffman-coded symbol for the number of bits } + emit_symbol(entropy, compptr^.dc_tbl_no, nbits); + + { Emit that number of bits of the value, if positive, } + { or the complement of its magnitude, if negative. } + if (nbits <> 0) then { emit_bits rejects calls with size 0 } + emit_bits(entropy, uInt(temp2), nbits); + end; + + cinfo^.dest^.next_output_byte := entropy^.next_output_byte; + cinfo^.dest^.free_in_buffer := entropy^.free_in_buffer; + + { Update restart-interval state too } + if (cinfo^.restart_interval <> 0) then + begin + if (entropy^.restarts_to_go = 0) then + begin + entropy^.restarts_to_go := cinfo^.restart_interval; + Inc(entropy^.next_restart_num); + with entropy^ do + next_restart_num := next_restart_num and 7; + end; + Dec(entropy^.restarts_to_go); + end; + + encode_mcu_DC_first := TRUE; +end; + + +{ MCU encoding for AC initial scan (either spectral selection, + or first pass of successive approximation). } + +{METHODDEF} +function encode_mcu_AC_first (cinfo : j_compress_ptr; + const MCU_data: array of JBLOCKROW) : boolean; +var + entropy : phuff_entropy_ptr; + {register} temp, temp2 : int; + {register} nbits : int; + {register} r, k : int; + Se : int; + Al : int; + block : JBLOCK_PTR; +begin + entropy := phuff_entropy_ptr (cinfo^.entropy); + Se := cinfo^.Se; + Al := cinfo^.Al; + + entropy^.next_output_byte := cinfo^.dest^.next_output_byte; + entropy^.free_in_buffer := cinfo^.dest^.free_in_buffer; + + { Emit restart marker if needed } + if (cinfo^.restart_interval <> 0) then + if (entropy^.restarts_to_go = 0) then + emit_restart(entropy, entropy^.next_restart_num); + + { Encode the MCU data block } + block := JBLOCK_PTR(MCU_data[0]); + + { Encode the AC coefficients per section G.1.2.2, fig. G.3 } + + r := 0; { r := run length of zeros } + + for k := cinfo^.Ss to Se do + begin + temp := (block^[jpeg_natural_order[k]]); + if (temp = 0) then + begin + Inc(r); + continue; + end; + { We must apply the point transform by Al. For AC coefficients this + is an integer division with rounding towards 0. To do this portably + in C, we shift after obtaining the absolute value; so the code is + interwoven with finding the abs value (temp) and output bits (temp2). } + + if (temp < 0) then + begin + temp := -temp; { temp is abs value of input } + temp := temp shr Al; { apply the point transform } + { For a negative coef, want temp2 := bitwise complement of abs(coef) } + temp2 := not temp; + end + else + begin + temp := temp shr Al; { apply the point transform } + temp2 := temp; + end; + { Watch out for case that nonzero coef is zero after point transform } + if (temp = 0) then + begin + Inc(r); + continue; + end; + + { Emit any pending EOBRUN } + if (entropy^.EOBRUN > 0) then + emit_eobrun(entropy); + { if run length > 15, must emit special run-length-16 codes ($F0) } + while (r > 15) do + begin + emit_symbol(entropy, entropy^.ac_tbl_no, $F0); + Dec(r, 16); + end; + + { Find the number of bits needed for the magnitude of the coefficient } + nbits := 0; { there must be at least one 1 bit } + repeat + Inc(nbits); + temp := temp shr 1; + until (temp = 0); + + { Check for out-of-range coefficient values } + if (nbits > MAX_COEF_BITS) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_DCT_COEF); + + { Count/emit Huffman symbol for run length / number of bits } + emit_symbol(entropy, entropy^.ac_tbl_no, (r shl 4) + nbits); + + { Emit that number of bits of the value, if positive, } + { or the complement of its magnitude, if negative. } + emit_bits(entropy, uInt(temp2), nbits); + + r := 0; { reset zero run length } + end; + + if (r > 0) then + begin { If there are trailing zeroes, } + Inc(entropy^.EOBRUN); { count an EOB } + if (entropy^.EOBRUN = $7FFF) then + emit_eobrun(entropy); { force it out to avoid overflow } + end; + + cinfo^.dest^.next_output_byte := entropy^.next_output_byte; + cinfo^.dest^.free_in_buffer := entropy^.free_in_buffer; + + { Update restart-interval state too } + if (cinfo^.restart_interval <> 0) then + begin + if (entropy^.restarts_to_go = 0) then + begin + entropy^.restarts_to_go := cinfo^.restart_interval; + Inc(entropy^.next_restart_num); + with entropy^ do + next_restart_num := next_restart_num and 7; + end; + Dec(entropy^.restarts_to_go); + end; + + encode_mcu_AC_first := TRUE; +end; + + +{ MCU encoding for DC successive approximation refinement scan. + Note: we assume such scans can be multi-component, although the spec + is not very clear on the point. } + +{METHODDEF} +function encode_mcu_DC_refine (cinfo : j_compress_ptr; + const MCU_data: array of JBLOCKROW) : boolean; +var + entropy : phuff_entropy_ptr; + {register} temp : int; + blkn : int; + Al : int; + block : JBLOCK_PTR; +begin + entropy := phuff_entropy_ptr (cinfo^.entropy); + Al := cinfo^.Al; + + entropy^.next_output_byte := cinfo^.dest^.next_output_byte; + entropy^.free_in_buffer := cinfo^.dest^.free_in_buffer; + + { Emit restart marker if needed } + if (cinfo^.restart_interval <> 0) then + if (entropy^.restarts_to_go = 0) then + emit_restart(entropy, entropy^.next_restart_num); + + { Encode the MCU data blocks } + for blkn := 0 to pred(cinfo^.blocks_in_MCU) do + begin + block := JBLOCK_PTR(MCU_data[blkn]); + + { We simply emit the Al'th bit of the DC coefficient value. } + temp := block^[0]; + emit_bits(entropy, uInt(temp shr Al), 1); + end; + + cinfo^.dest^.next_output_byte := entropy^.next_output_byte; + cinfo^.dest^.free_in_buffer := entropy^.free_in_buffer; + + { Update restart-interval state too } + if (cinfo^.restart_interval <> 0) then + begin + if (entropy^.restarts_to_go = 0) then + begin + entropy^.restarts_to_go := cinfo^.restart_interval; + Inc(entropy^.next_restart_num); + with entropy^ do + next_restart_num := next_restart_num and 7; + end; + Dec(entropy^.restarts_to_go); + end; + + encode_mcu_DC_refine := TRUE; +end; + + +{ MCU encoding for AC successive approximation refinement scan. } + +{METHODDEF} +function encode_mcu_AC_refine (cinfo : j_compress_ptr; + const MCU_data: array of JBLOCKROW) : boolean; + +var + entropy : phuff_entropy_ptr; + {register} temp : int; + {register} r, k : int; + EOB : int; + BR_buffer : JBytePtr; + BR : uInt; + Se : int; + Al : int; + block : JBLOCK_PTR; + absvalues : array[0..DCTSIZE2-1] of int; +begin + entropy := phuff_entropy_ptr(cinfo^.entropy); + Se := cinfo^.Se; + Al := cinfo^.Al; + + entropy^.next_output_byte := cinfo^.dest^.next_output_byte; + entropy^.free_in_buffer := cinfo^.dest^.free_in_buffer; + + { Emit restart marker if needed } + if (cinfo^.restart_interval <> 0) then + if (entropy^.restarts_to_go = 0) then + emit_restart(entropy, entropy^.next_restart_num); + + { Encode the MCU data block } + block := JBLOCK_PTR(MCU_data[0]); + + { It is convenient to make a pre-pass to determine the transformed + coefficients' absolute values and the EOB position. } + + EOB := 0; + for k := cinfo^.Ss to Se do + begin + temp := block^[jpeg_natural_order[k]]; + { We must apply the point transform by Al. For AC coefficients this + is an integer division with rounding towards 0. To do this portably + in C, we shift after obtaining the absolute value. } + + if (temp < 0) then + temp := -temp; { temp is abs value of input } + temp := temp shr Al; { apply the point transform } + absvalues[k] := temp; { save abs value for main pass } + if (temp = 1) then + EOB := k; { EOB := index of last newly-nonzero coef } + end; + + { Encode the AC coefficients per section G.1.2.3, fig. G.7 } + + r := 0; { r := run length of zeros } + BR := 0; { BR := count of buffered bits added now } + BR_buffer := JBytePtr(@(entropy^.bit_buffer^[entropy^.BE])); + { Append bits to buffer } + + for k := cinfo^.Ss to Se do + begin + temp := absvalues[k]; + if (temp = 0) then + begin + Inc(r); + continue; + end; + + { Emit any required ZRLs, but not if they can be folded into EOB } + while (r > 15) and (k <= EOB) do + begin + { emit any pending EOBRUN and the BE correction bits } + emit_eobrun(entropy); + { Emit ZRL } + emit_symbol(entropy, entropy^.ac_tbl_no, $F0); + Dec(r, 16); + { Emit buffered correction bits that must be associated with ZRL } + emit_buffered_bits(entropy, BR_buffer, BR); + BR_buffer := entropy^.bit_buffer; { BE bits are gone now } + BR := 0; + end; + + { If the coef was previously nonzero, it only needs a correction bit. + NOTE: a straight translation of the spec's figure G.7 would suggest + that we also need to test r > 15. But if r > 15, we can only get here + if k > EOB, which implies that this coefficient is not 1. } + if (temp > 1) then + begin + { The correction bit is the next bit of the absolute value. } + BR_buffer^[BR] := byte (temp and 1); + Inc(BR); + continue; + end; + + { Emit any pending EOBRUN and the BE correction bits } + emit_eobrun(entropy); + + { Count/emit Huffman symbol for run length / number of bits } + emit_symbol(entropy, entropy^.ac_tbl_no, (r shl 4) + 1); + + { Emit output bit for newly-nonzero coef } + if (block^[jpeg_natural_order[k]] < 0) then + temp := 0 + else + temp := 1; + emit_bits(entropy, uInt(temp), 1); + + { Emit buffered correction bits that must be associated with this code } + emit_buffered_bits(entropy, BR_buffer, BR); + BR_buffer := entropy^.bit_buffer; { BE bits are gone now } + BR := 0; + r := 0; { reset zero run length } + end; + + if (r > 0) or (BR > 0) then + begin { If there are trailing zeroes, } + Inc(entropy^.EOBRUN); { count an EOB } + Inc(entropy^.BE, BR); { concat my correction bits to older ones } + { We force out the EOB if we risk either: + 1. overflow of the EOB counter; + 2. overflow of the correction bit buffer during the next MCU. } + + if (entropy^.EOBRUN = $7FFF) or + (entropy^.BE > (MAX_CORR_BITS-DCTSIZE2+1)) then + emit_eobrun(entropy); + end; + + cinfo^.dest^.next_output_byte := entropy^.next_output_byte; + cinfo^.dest^.free_in_buffer := entropy^.free_in_buffer; + + { Update restart-interval state too } + if (cinfo^.restart_interval <> 0) then + begin + if (entropy^.restarts_to_go = 0) then + begin + entropy^.restarts_to_go := cinfo^.restart_interval; + Inc(entropy^.next_restart_num); + with entropy^ do + next_restart_num := next_restart_num and 7; + end; + Dec(entropy^.restarts_to_go); + end; + + encode_mcu_AC_refine := TRUE; +end; + + +{ Finish up at the end of a Huffman-compressed progressive scan. } + +{METHODDEF} +procedure finish_pass_phuff (cinfo : j_compress_ptr); +var + entropy : phuff_entropy_ptr; +begin + entropy := phuff_entropy_ptr (cinfo^.entropy); + + entropy^.next_output_byte := cinfo^.dest^.next_output_byte; + entropy^.free_in_buffer := cinfo^.dest^.free_in_buffer; + + { Flush out any buffered data } + emit_eobrun(entropy); + flush_bits(entropy); + + cinfo^.dest^.next_output_byte := entropy^.next_output_byte; + cinfo^.dest^.free_in_buffer := entropy^.free_in_buffer; +end; + + +{ Finish up a statistics-gathering pass and create the new Huffman tables. } + +{METHODDEF} +procedure finish_pass_gather_phuff (cinfo : j_compress_ptr); +var + entropy : phuff_entropy_ptr; + is_DC_band : boolean; + ci, tbl : int; + compptr : jpeg_component_info_ptr; + htblptr : ^JHUFF_TBL_PTR; + did : array[0..NUM_HUFF_TBLS-1] of boolean; +begin + tbl := 0; + entropy := phuff_entropy_ptr (cinfo^.entropy); + + { Flush out buffered data (all we care about is counting the EOB symbol) } + emit_eobrun(entropy); + + is_DC_band := (cinfo^.Ss = 0); + + { It's important not to apply jpeg_gen_optimal_table more than once + per table, because it clobbers the input frequency counts! } + + MEMZERO(@did, SIZEOF(did)); + + for ci := 0 to pred(cinfo^.comps_in_scan) do + begin + compptr := cinfo^.cur_comp_info[ci]; + if (is_DC_band) then + begin + if (cinfo^.Ah <> 0) then { DC refinement needs no table } + continue; + tbl := compptr^.dc_tbl_no; + end + else + begin + tbl := compptr^.ac_tbl_no; + end; + if (not did[tbl]) then + begin + if (is_DC_band) then + htblptr := @(cinfo^.dc_huff_tbl_ptrs[tbl]) + else + htblptr := @(cinfo^.ac_huff_tbl_ptrs[tbl]); + if (htblptr^ = NIL) then + htblptr^ := jpeg_alloc_huff_table(j_common_ptr(cinfo)); + jpeg_gen_optimal_table(cinfo, htblptr^, entropy^.count_ptrs[tbl]^); + did[tbl] := TRUE; + end; + end; +end; + + +{ Module initialization routine for progressive Huffman entropy encoding. } + +{GLOBAL} +procedure jinit_phuff_encoder (cinfo : j_compress_ptr); +var + entropy : phuff_entropy_ptr; + i : int; +begin + entropy := phuff_entropy_ptr( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + SIZEOF(phuff_entropy_encoder)) ); + cinfo^.entropy := jpeg_entropy_encoder_ptr(entropy); + entropy^.pub.start_pass := start_pass_phuff; + + { Mark tables unallocated } + for i := 0 to pred(NUM_HUFF_TBLS) do + begin + entropy^.derived_tbls[i] := NIL; + entropy^.count_ptrs[i] := NIL; + end; + entropy^.bit_buffer := NIL; { needed only in AC refinement scan } +end; + +end. diff --git a/Imaging/JpegLib/imjcprepct.pas b/Imaging/JpegLib/imjcprepct.pas index c05ac8b..9750652 100644 --- a/Imaging/JpegLib/imjcprepct.pas +++ b/Imaging/JpegLib/imjcprepct.pas @@ -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. diff --git a/Imaging/JpegLib/imjcsample.pas b/Imaging/JpegLib/imjcsample.pas index 8cce199..5be2e80 100644 --- a/Imaging/JpegLib/imjcsample.pas +++ b/Imaging/JpegLib/imjcsample.pas @@ -1,631 +1,631 @@ -unit imjcsample; - -{ This file contains downsampling routines. - - Downsampling input data is counted in "row groups". A row group - is defined to be max_v_samp_factor pixel rows of each component, - from which the downsampler produces v_samp_factor sample rows. - A single row group is processed in each call to the downsampler module. - - The downsampler is responsible for edge-expansion of its output data - to fill an integral number of DCT blocks horizontally. The source buffer - may be modified if it is helpful for this purpose (the source buffer is - allocated wide enough to correspond to the desired output width). - The caller (the prep controller) is responsible for vertical padding. - - The downsampler may request "context rows" by setting need_context_rows - during startup. In this case, the input arrays will contain at least - one row group's worth of pixels above and below the passed-in data; - the caller will create dummy rows at image top and bottom by replicating - the first or last real pixel row. - - An excellent reference for image resampling is - Digital Image Warping, George Wolberg, 1990. - Pub. by IEEE Computer Society Press, Los Alamitos, CA. ISBN 0-8186-8944-7. - - The downsampling algorithm used here is a simple average of the source - pixels covered by the output pixel. The hi-falutin sampling literature - refers to this as a "box filter". In general the characteristics of a box - filter are not very good, but for the specific cases we normally use (1:1 - and 2:1 ratios) the box is equivalent to a "triangle filter" which is not - nearly so bad. If you intend to use other sampling ratios, you'd be well - advised to improve this code. - - A simple input-smoothing capability is provided. This is mainly intended - for cleaning up color-dithered GIF input files (if you find it inadequate, - we suggest using an external filtering program such as pnmconvol). When - enabled, each input pixel P is replaced by a weighted sum of itself and its - eight neighbors. P's weight is 1-8*SF and each neighbor's weight is SF, - where SF := (smoothing_factor / 1024). - Currently, smoothing is only supported for 2h2v sampling factors. } - -{ Original: jcsample.c ; Copyright (C) 1991-1996, Thomas G. Lane. } - - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjutils, - imjdeferr, - imjerror, - imjpeglib; - - -{ Module initialization routine for downsampling. - Note that we must select a routine for each component. } - -{GLOBAL} -procedure jinit_downsampler (cinfo : j_compress_ptr); - -implementation - -{ Pointer to routine to downsample a single component } -type - downsample1_ptr = procedure(cinfo : j_compress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - output_data : JSAMPARRAY); - -{ Private subobject } - -type - my_downsample_ptr = ^my_downsampler; - my_downsampler = record - pub : jpeg_downsampler; { public fields } - - { Downsampling method pointers, one per component } - methods : array[0..MAX_COMPONENTS-1] of downsample1_ptr; - end; - -{ Initialize for a downsampling pass. } - -{METHODDEF} -procedure start_pass_downsample (cinfo : j_compress_ptr); -begin - { no work for now } -end; - - -{ Expand a component horizontally from width input_cols to width output_cols, - by duplicating the rightmost samples. } - -{LOCAL} -procedure expand_right_edge (image_data : JSAMPARRAY; - num_rows : int; - input_cols : JDIMENSION; - output_cols : JDIMENSION); -var - {register} ptr : JSAMPLE_PTR; - {register} pixval : JSAMPLE; - {register} count : int; - row : int; - numcols : int; -begin - numcols := int (output_cols - input_cols); - - if (numcols > 0) then - begin - for row := 0 to pred(num_rows) do - begin - ptr := JSAMPLE_PTR(@(image_data^[row]^[input_cols-1])); - pixval := ptr^; { don't need GETJSAMPLE() here } - for count := pred(numcols) downto 0 do - begin - Inc(ptr); - ptr^ := pixval; - end; - end; - end; -end; - - -{ Do downsampling for a whole row group (all components). - - In this version we simply downsample each component independently. } - -{METHODDEF} -procedure sep_downsample (cinfo : j_compress_ptr; - input_buf : JSAMPIMAGE; - in_row_index : JDIMENSION; - output_buf : JSAMPIMAGE; - out_row_group_index : JDIMENSION); -var - downsample : my_downsample_ptr; - ci : int; - compptr : jpeg_component_info_ptr; - in_ptr, out_ptr : JSAMPARRAY; -begin - downsample := my_downsample_ptr (cinfo^.downsample); - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - in_ptr := JSAMPARRAY(@ input_buf^[ci]^[in_row_index]); - out_ptr := JSAMPARRAY(@ output_buf^[ci]^ - [out_row_group_index * JDIMENSION(compptr^.v_samp_factor)]); - downsample^.methods[ci] (cinfo, compptr, in_ptr, out_ptr); - Inc(compptr); - end; -end; - - -{ Downsample pixel values of a single component. - One row group is processed per call. - This version handles arbitrary integral sampling ratios, without smoothing. - Note that this version is not actually used for customary sampling ratios. } - -{METHODDEF} -procedure int_downsample (cinfo : j_compress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - output_data : JSAMPARRAY); -var - inrow, outrow, h_expand, v_expand, numpix, numpix2, h, v : int; - outcol, outcol_h : JDIMENSION; { outcol_h = outcol*h_expand } - output_cols : JDIMENSION; - inptr, - outptr : JSAMPLE_PTR; - outvalue : INT32; -begin - output_cols := compptr^.width_in_blocks * DCTSIZE; - - h_expand := cinfo^.max_h_samp_factor div compptr^.h_samp_factor; - v_expand := cinfo^.max_v_samp_factor div compptr^.v_samp_factor; - numpix := h_expand * v_expand; - numpix2 := numpix div 2; - - { Expand input data enough to let all the output samples be generated - by the standard loop. Special-casing padded output would be more - efficient. } - - expand_right_edge(input_data, cinfo^.max_v_samp_factor, - cinfo^.image_width, output_cols * JDIMENSION(h_expand)); - - inrow := 0; - for outrow := 0 to pred(compptr^.v_samp_factor) do - begin - outptr := JSAMPLE_PTR(output_data^[outrow]); - outcol_h := 0; - for outcol := 0 to pred(output_cols) do - begin - outvalue := 0; - for v := 0 to pred(v_expand) do - begin - inptr := @(input_data^[inrow+v]^[outcol_h]); - for h := 0 to pred(h_expand) do - begin - Inc(outvalue, INT32 (GETJSAMPLE(inptr^)) ); - Inc(inptr); - end; - end; - outptr^ := JSAMPLE ((outvalue + numpix2) div numpix); - Inc(outptr); - Inc(outcol_h, h_expand); - end; - Inc(inrow, v_expand); - end; -end; - - -{ Downsample pixel values of a single component. - This version handles the special case of a full-size component, - without smoothing. } - -{METHODDEF} -procedure fullsize_downsample (cinfo : j_compress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - output_data : JSAMPARRAY); -begin - { Copy the data } - jcopy_sample_rows(input_data, 0, output_data, 0, - cinfo^.max_v_samp_factor, cinfo^.image_width); - { Edge-expand } - expand_right_edge(output_data, cinfo^.max_v_samp_factor, - cinfo^.image_width, compptr^.width_in_blocks * DCTSIZE); -end; - - -{ Downsample pixel values of a single component. - This version handles the common case of 2:1 horizontal and 1:1 vertical, - without smoothing. - - A note about the "bias" calculations: when rounding fractional values to - integer, we do not want to always round 0.5 up to the next integer. - If we did that, we'd introduce a noticeable bias towards larger values. - Instead, this code is arranged so that 0.5 will be rounded up or down at - alternate pixel locations (a simple ordered dither pattern). } - -{METHODDEF} -procedure h2v1_downsample (cinfo : j_compress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - output_data : JSAMPARRAY); -var - outrow : int; - outcol : JDIMENSION; - output_cols : JDIMENSION; - {register} inptr, outptr : JSAMPLE_PTR; - {register} bias : int; -begin - output_cols := compptr^.width_in_blocks * DCTSIZE; - - { Expand input data enough to let all the output samples be generated - by the standard loop. Special-casing padded output would be more - efficient. } - - expand_right_edge(input_data, cinfo^.max_v_samp_factor, - cinfo^.image_width, output_cols * 2); - - for outrow := 0 to pred(compptr^.v_samp_factor) do - begin - outptr := JSAMPLE_PTR(output_data^[outrow]); - inptr := JSAMPLE_PTR(input_data^[outrow]); - bias := 0; { bias := 0,1,0,1,... for successive samples } - for outcol := 0 to pred(output_cols) do - begin - outptr^ := JSAMPLE ((GETJSAMPLE(inptr^) + - GETJSAMPLE(JSAMPROW(inptr)^[1]) + bias) shr 1); - Inc(outptr); - bias := bias xor 1; { 0=>1, 1=>0 } - Inc(inptr, 2); - end; - end; -end; - - -{ Downsample pixel values of a single component. - This version handles the standard case of 2:1 horizontal and 2:1 vertical, - without smoothing. } - -{METHODDEF} -procedure h2v2_downsample (cinfo : j_compress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - output_data : JSAMPARRAY); -var - inrow, outrow : int; - outcol : JDIMENSION; - output_cols : JDIMENSION; - {register} inptr0, inptr1, outptr : JSAMPLE_PTR; - {register} bias : int; -begin - output_cols := compptr^.width_in_blocks * DCTSIZE; - - { Expand input data enough to let all the output samples be generated - by the standard loop. Special-casing padded output would be more - efficient. } - - expand_right_edge(input_data, cinfo^.max_v_samp_factor, - cinfo^.image_width, output_cols * 2); - - inrow := 0; - for outrow := 0 to pred(compptr^.v_samp_factor) do - begin - outptr := JSAMPLE_PTR(output_data^[outrow]); - inptr0 := JSAMPLE_PTR(input_data^[inrow]); - inptr1 := JSAMPLE_PTR(input_data^[inrow+1]); - bias := 1; { bias := 1,2,1,2,... for successive samples } - for outcol := 0 to pred(output_cols) do - begin - outptr^ := JSAMPLE ((GETJSAMPLE(inptr0^) + - GETJSAMPLE(JSAMPROW(inptr0)^[1]) + - GETJSAMPLE(inptr1^) + - GETJSAMPLE(JSAMPROW(inptr1)^[1]) + bias) shr 2); - Inc(outptr); - bias := bias xor 3; { 1=>2, 2=>1 } - Inc(inptr0, 2); - Inc(inptr1, 2); - end; - Inc(inrow, 2); - end; -end; - - -{$ifdef INPUT_SMOOTHING_SUPPORTED} - -{ Downsample pixel values of a single component. - This version handles the standard case of 2:1 horizontal and 2:1 vertical, - with smoothing. One row of context is required. } - -{METHODDEF} -procedure h2v2_smooth_downsample (cinfo : j_compress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - output_data : JSAMPARRAY); -var - inrow, outrow : int; - colctr : JDIMENSION; - output_cols : JDIMENSION; - {register} inptr0, inptr1, above_ptr, below_ptr, outptr : JSAMPLE_PTR; - membersum, neighsum, memberscale, neighscale : INT32; -var - prev_input_data : JSAMPARRAY; - prev_inptr0, prev_inptr1, prev_above_ptr, prev_below_ptr : JSAMPLE_PTR; -begin - output_cols := compptr^.width_in_blocks * DCTSIZE; - - { Expand input data enough to let all the output samples be generated - by the standard loop. Special-casing padded output would be more - efficient. } - - prev_input_data := input_data; - Dec(JSAMPROW_PTR(prev_input_data)); - expand_right_edge(prev_input_data, cinfo^.max_v_samp_factor + 2, - cinfo^.image_width, output_cols * 2); - - { We don't bother to form the individual "smoothed" input pixel values; - we can directly compute the output which is the average of the four - smoothed values. Each of the four member pixels contributes a fraction - (1-8*SF) to its own smoothed image and a fraction SF to each of the three - other smoothed pixels, therefore a total fraction (1-5*SF)/4 to the final - output. The four corner-adjacent neighbor pixels contribute a fraction - SF to just one smoothed pixel, or SF/4 to the final output; while the - eight edge-adjacent neighbors contribute SF to each of two smoothed - pixels, or SF/2 overall. In order to use integer arithmetic, these - factors are scaled by 2^16 := 65536. - Also recall that SF := smoothing_factor / 1024. } - - memberscale := 16384 - cinfo^.smoothing_factor * 80; { scaled (1-5*SF)/4 } - neighscale := cinfo^.smoothing_factor * 16; { scaled SF/4 } - - inrow := 0; - for outrow := 0 to pred(compptr^.v_samp_factor) do - begin - outptr := JSAMPLE_PTR(output_data^[outrow]); - inptr0 := JSAMPLE_PTR(input_data^[inrow]); - inptr1 := JSAMPLE_PTR(input_data^[inrow+1]); - above_ptr := JSAMPLE_PTR(input_data^[inrow-1]); - below_ptr := JSAMPLE_PTR(input_data^[inrow+2]); - - { Special case for first column: pretend column -1 is same as column 0 } - membersum := GETJSAMPLE(inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[1]) + - GETJSAMPLE(inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[1]); - neighsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(JSAMPROW(above_ptr)^[1]) + - GETJSAMPLE(below_ptr^) + GETJSAMPLE(JSAMPROW(below_ptr)^[1]) + - GETJSAMPLE(inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[2]) + - GETJSAMPLE(inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[2]); - Inc(neighsum, neighsum); - Inc(neighsum, GETJSAMPLE(above_ptr^) + - GETJSAMPLE(JSAMPROW(above_ptr)^[2]) + - GETJSAMPLE(below_ptr^) + - GETJSAMPLE(JSAMPROW(below_ptr)^[2]) ); - membersum := membersum * memberscale + neighsum * neighscale; - outptr^ := JSAMPLE ((membersum + 32768) shr 16); - Inc(outptr); - prev_inptr0 := inptr0; - prev_inptr1 := inptr1; - Inc(prev_inptr0); - Inc(prev_inptr1); - Inc(inptr0, 2); - Inc(inptr1, 2); - prev_above_ptr := above_ptr; - prev_below_ptr := below_ptr; - Inc(above_ptr, 2); - Inc(below_ptr, 2); - Inc(prev_above_ptr, 1); - Inc(prev_below_ptr, 1); - - for colctr := pred(output_cols - 2) downto 0 do - begin - { sum of pixels directly mapped to this output element } - membersum := GETJSAMPLE(inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[1]) + - GETJSAMPLE(inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[1]); - { sum of edge-neighbor pixels } - neighsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(JSAMPROW(above_ptr)^[1]) + - GETJSAMPLE(below_ptr^) + GETJSAMPLE(JSAMPROW(below_ptr)^[1]) + - GETJSAMPLE(prev_inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[2]) + - GETJSAMPLE(prev_inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[2]); - { The edge-neighbors count twice as much as corner-neighbors } - Inc(neighsum, neighsum); - { Add in the corner-neighbors } - Inc(neighsum, GETJSAMPLE(prev_above_ptr^) + - GETJSAMPLE(JSAMPROW(above_ptr)^[2]) + - GETJSAMPLE(prev_below_ptr^) + - GETJSAMPLE(JSAMPROW(below_ptr)^[2]) ); - { form final output scaled up by 2^16 } - membersum := membersum * memberscale + neighsum * neighscale; - { round, descale and output it } - outptr^ := JSAMPLE ((membersum + 32768) shr 16); - Inc(outptr); - Inc(inptr0, 2); - Inc(inptr1, 2); - Inc(prev_inptr0, 2); - Inc(prev_inptr1, 2); - Inc(above_ptr, 2); - Inc(below_ptr, 2); - Inc(prev_above_ptr, 2); - Inc(prev_below_ptr, 2); - end; - - { Special case for last column } - membersum := GETJSAMPLE(inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[1]) + - GETJSAMPLE(inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[1]); - neighsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(JSAMPROW(above_ptr)^[1]) + - GETJSAMPLE(below_ptr^) + GETJSAMPLE(JSAMPROW(below_ptr)^[1]) + - GETJSAMPLE(prev_inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[1]) + - GETJSAMPLE(prev_inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[1]); - Inc(neighsum, neighsum); - Inc(neighsum, GETJSAMPLE(prev_above_ptr^) + - GETJSAMPLE(JSAMPROW(above_ptr)^[1]) + - GETJSAMPLE(prev_below_ptr^) + - GETJSAMPLE(JSAMPROW(below_ptr)^[1]) ); - membersum := membersum * memberscale + neighsum * neighscale; - outptr^ := JSAMPLE ((membersum + 32768) shr 16); - - Inc(inrow, 2); - end; -end; - - -{ Downsample pixel values of a single component. - This version handles the special case of a full-size component, - with smoothing. One row of context is required. } - -{METHODDEF} -procedure fullsize_smooth_downsample (cinfo : j_compress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - output_data : JSAMPARRAY); -var - outrow : int; - colctr : JDIMENSION; - output_cols : JDIMENSION; - {register} inptr, above_ptr, below_ptr, outptr : JSAMPLE_PTR; - membersum, neighsum, memberscale, neighscale : INT32; - colsum, lastcolsum, nextcolsum : int; -var - prev_input_data : JSAMPARRAY; -begin - output_cols := compptr^.width_in_blocks * DCTSIZE; - - { Expand input data enough to let all the output samples be generated - by the standard loop. Special-casing padded output would be more - efficient. } - - prev_input_data := input_data; - Dec(JSAMPROW_PTR(prev_input_data)); - expand_right_edge(prev_input_data, cinfo^.max_v_samp_factor + 2, - cinfo^.image_width, output_cols); - - { Each of the eight neighbor pixels contributes a fraction SF to the - smoothed pixel, while the main pixel contributes (1-8*SF). In order - to use integer arithmetic, these factors are multiplied by 2^16 := 65536. - Also recall that SF := smoothing_factor / 1024. } - - memberscale := long(65536) - cinfo^.smoothing_factor * long(512); { scaled 1-8*SF } - neighscale := cinfo^.smoothing_factor * 64; { scaled SF } - - for outrow := 0 to pred(compptr^.v_samp_factor) do - begin - outptr := JSAMPLE_PTR(output_data^[outrow]); - inptr := JSAMPLE_PTR(input_data^[outrow]); - above_ptr := JSAMPLE_PTR(input_data^[outrow-1]); - below_ptr := JSAMPLE_PTR(input_data^[outrow+1]); - - { Special case for first column } - colsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(below_ptr^) + - GETJSAMPLE(inptr^); - Inc(above_ptr); - Inc(below_ptr); - membersum := GETJSAMPLE(inptr^); - Inc(inptr); - nextcolsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(below_ptr^) + - GETJSAMPLE(inptr^); - neighsum := colsum + (colsum - membersum) + nextcolsum; - membersum := membersum * memberscale + neighsum * neighscale; - outptr^ := JSAMPLE ((membersum + 32768) shr 16); - Inc(outptr); - lastcolsum := colsum; colsum := nextcolsum; - - for colctr := pred(output_cols - 2) downto 0 do - begin - membersum := GETJSAMPLE(inptr^); - Inc(inptr); - Inc(above_ptr); - Inc(below_ptr); - nextcolsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(below_ptr^) + - GETJSAMPLE(inptr^); - neighsum := lastcolsum + (colsum - membersum) + nextcolsum; - membersum := membersum * memberscale + neighsum * neighscale; - outptr^ := JSAMPLE ((membersum + 32768) shr 16); - Inc(outptr); - lastcolsum := colsum; colsum := nextcolsum; - end; - - { Special case for last column } - membersum := GETJSAMPLE(inptr^); - neighsum := lastcolsum + (colsum - membersum) + colsum; - membersum := membersum * memberscale + neighsum * neighscale; - outptr^ := JSAMPLE ((membersum + 32768) shr 16); - end; -end; - -{$endif} { INPUT_SMOOTHING_SUPPORTED } - - -{ Module initialization routine for downsampling. - Note that we must select a routine for each component. } - -{GLOBAL} -procedure jinit_downsampler (cinfo : j_compress_ptr); -var - downsample : my_downsample_ptr; - ci : int; - compptr : jpeg_component_info_ptr; - smoothok : boolean; -begin - smoothok := TRUE; - - downsample := my_downsample_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_downsampler)) ); - cinfo^.downsample := jpeg_downsampler_ptr (downsample); - downsample^.pub.start_pass := start_pass_downsample; - downsample^.pub.downsample := sep_downsample; - downsample^.pub.need_context_rows := FALSE; - - if (cinfo^.CCIR601_sampling) then - ERREXIT(j_common_ptr(cinfo), JERR_CCIR601_NOTIMPL); - - { Verify we can handle the sampling factors, and set up method pointers } - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - if (compptr^.h_samp_factor = cinfo^.max_h_samp_factor) and - (compptr^.v_samp_factor = cinfo^.max_v_samp_factor) then - begin -{$ifdef INPUT_SMOOTHING_SUPPORTED} - if (cinfo^.smoothing_factor <> 0) then - begin - downsample^.methods[ci] := fullsize_smooth_downsample; - downsample^.pub.need_context_rows := TRUE; - end - else -{$endif} - downsample^.methods[ci] := fullsize_downsample; - end - else - if (compptr^.h_samp_factor * 2 = cinfo^.max_h_samp_factor) and - (compptr^.v_samp_factor = cinfo^.max_v_samp_factor) then - begin - smoothok := FALSE; - downsample^.methods[ci] := h2v1_downsample; - end - else - if (compptr^.h_samp_factor * 2 = cinfo^.max_h_samp_factor) and - (compptr^.v_samp_factor * 2 = cinfo^.max_v_samp_factor) then - begin - {$ifdef INPUT_SMOOTHING_SUPPORTED} - if (cinfo^.smoothing_factor <> 0) then - begin - downsample^.methods[ci] := h2v2_smooth_downsample; - downsample^.pub.need_context_rows := TRUE; - end - else - {$endif} - downsample^.methods[ci] := h2v2_downsample; - end - else - if ((cinfo^.max_h_samp_factor mod compptr^.h_samp_factor) = 0) and - ((cinfo^.max_v_samp_factor mod compptr^.v_samp_factor) = 0) then - begin - smoothok := FALSE; - downsample^.methods[ci] := int_downsample; - end - else - ERREXIT(j_common_ptr(cinfo), JERR_FRACT_SAMPLE_NOTIMPL); - Inc(compptr); - end; - -{$ifdef INPUT_SMOOTHING_SUPPORTED} - if (cinfo^.smoothing_factor <> 0) and (not smoothok) then - TRACEMS(j_common_ptr(cinfo), 0, JTRC_SMOOTH_NOTIMPL); -{$endif} -end; - -end. +unit imjcsample; + +{ This file contains downsampling routines. + + Downsampling input data is counted in "row groups". A row group + is defined to be max_v_samp_factor pixel rows of each component, + from which the downsampler produces v_samp_factor sample rows. + A single row group is processed in each call to the downsampler module. + + The downsampler is responsible for edge-expansion of its output data + to fill an integral number of DCT blocks horizontally. The source buffer + may be modified if it is helpful for this purpose (the source buffer is + allocated wide enough to correspond to the desired output width). + The caller (the prep controller) is responsible for vertical padding. + + The downsampler may request "context rows" by setting need_context_rows + during startup. In this case, the input arrays will contain at least + one row group's worth of pixels above and below the passed-in data; + the caller will create dummy rows at image top and bottom by replicating + the first or last real pixel row. + + An excellent reference for image resampling is + Digital Image Warping, George Wolberg, 1990. + Pub. by IEEE Computer Society Press, Los Alamitos, CA. ISBN 0-8186-8944-7. + + The downsampling algorithm used here is a simple average of the source + pixels covered by the output pixel. The hi-falutin sampling literature + refers to this as a "box filter". In general the characteristics of a box + filter are not very good, but for the specific cases we normally use (1:1 + and 2:1 ratios) the box is equivalent to a "triangle filter" which is not + nearly so bad. If you intend to use other sampling ratios, you'd be well + advised to improve this code. + + A simple input-smoothing capability is provided. This is mainly intended + for cleaning up color-dithered GIF input files (if you find it inadequate, + we suggest using an external filtering program such as pnmconvol). When + enabled, each input pixel P is replaced by a weighted sum of itself and its + eight neighbors. P's weight is 1-8*SF and each neighbor's weight is SF, + where SF := (smoothing_factor / 1024). + Currently, smoothing is only supported for 2h2v sampling factors. } + +{ Original: jcsample.c ; Copyright (C) 1991-1996, Thomas G. Lane. } + + +interface + +{$I imjconfig.inc} + +uses + imjmorecfg, + imjinclude, + imjutils, + imjdeferr, + imjerror, + imjpeglib; + + +{ Module initialization routine for downsampling. + Note that we must select a routine for each component. } + +{GLOBAL} +procedure jinit_downsampler (cinfo : j_compress_ptr); + +implementation + +{ Pointer to routine to downsample a single component } +type + downsample1_ptr = procedure(cinfo : j_compress_ptr; + compptr : jpeg_component_info_ptr; + input_data : JSAMPARRAY; + output_data : JSAMPARRAY); + +{ Private subobject } + +type + my_downsample_ptr = ^my_downsampler; + my_downsampler = record + pub : jpeg_downsampler; { public fields } + + { Downsampling method pointers, one per component } + methods : array[0..MAX_COMPONENTS-1] of downsample1_ptr; + end; + +{ Initialize for a downsampling pass. } + +{METHODDEF} +procedure start_pass_downsample (cinfo : j_compress_ptr); +begin + { no work for now } +end; + + +{ Expand a component horizontally from width input_cols to width output_cols, + by duplicating the rightmost samples. } + +{LOCAL} +procedure expand_right_edge (image_data : JSAMPARRAY; + num_rows : int; + input_cols : JDIMENSION; + output_cols : JDIMENSION); +var + {register} ptr : JSAMPLE_PTR; + {register} pixval : JSAMPLE; + {register} count : int; + row : int; + numcols : int; +begin + numcols := int (output_cols - input_cols); + + if (numcols > 0) then + begin + for row := 0 to pred(num_rows) do + begin + ptr := JSAMPLE_PTR(@(image_data^[row]^[input_cols-1])); + pixval := ptr^; { don't need GETJSAMPLE() here } + for count := pred(numcols) downto 0 do + begin + Inc(ptr); + ptr^ := pixval; + end; + end; + end; +end; + + +{ Do downsampling for a whole row group (all components). + + In this version we simply downsample each component independently. } + +{METHODDEF} +procedure sep_downsample (cinfo : j_compress_ptr; + input_buf : JSAMPIMAGE; + in_row_index : JDIMENSION; + output_buf : JSAMPIMAGE; + out_row_group_index : JDIMENSION); +var + downsample : my_downsample_ptr; + ci : int; + compptr : jpeg_component_info_ptr; + in_ptr, out_ptr : JSAMPARRAY; +begin + downsample := my_downsample_ptr (cinfo^.downsample); + + compptr := jpeg_component_info_ptr(cinfo^.comp_info); + for ci := 0 to pred(cinfo^.num_components) do + begin + in_ptr := JSAMPARRAY(@ input_buf^[ci]^[in_row_index]); + out_ptr := JSAMPARRAY(@ output_buf^[ci]^ + [out_row_group_index * JDIMENSION(compptr^.v_samp_factor)]); + downsample^.methods[ci] (cinfo, compptr, in_ptr, out_ptr); + Inc(compptr); + end; +end; + + +{ Downsample pixel values of a single component. + One row group is processed per call. + This version handles arbitrary integral sampling ratios, without smoothing. + Note that this version is not actually used for customary sampling ratios. } + +{METHODDEF} +procedure int_downsample (cinfo : j_compress_ptr; + compptr : jpeg_component_info_ptr; + input_data : JSAMPARRAY; + output_data : JSAMPARRAY); +var + inrow, outrow, h_expand, v_expand, numpix, numpix2, h, v : int; + outcol, outcol_h : JDIMENSION; { outcol_h = outcol*h_expand } + output_cols : JDIMENSION; + inptr, + outptr : JSAMPLE_PTR; + outvalue : INT32; +begin + output_cols := compptr^.width_in_blocks * DCTSIZE; + + h_expand := cinfo^.max_h_samp_factor div compptr^.h_samp_factor; + v_expand := cinfo^.max_v_samp_factor div compptr^.v_samp_factor; + numpix := h_expand * v_expand; + numpix2 := numpix div 2; + + { Expand input data enough to let all the output samples be generated + by the standard loop. Special-casing padded output would be more + efficient. } + + expand_right_edge(input_data, cinfo^.max_v_samp_factor, + cinfo^.image_width, output_cols * JDIMENSION(h_expand)); + + inrow := 0; + for outrow := 0 to pred(compptr^.v_samp_factor) do + begin + outptr := JSAMPLE_PTR(output_data^[outrow]); + outcol_h := 0; + for outcol := 0 to pred(output_cols) do + begin + outvalue := 0; + for v := 0 to pred(v_expand) do + begin + inptr := @(input_data^[inrow+v]^[outcol_h]); + for h := 0 to pred(h_expand) do + begin + Inc(outvalue, INT32 (GETJSAMPLE(inptr^)) ); + Inc(inptr); + end; + end; + outptr^ := JSAMPLE ((outvalue + numpix2) div numpix); + Inc(outptr); + Inc(outcol_h, h_expand); + end; + Inc(inrow, v_expand); + end; +end; + + +{ Downsample pixel values of a single component. + This version handles the special case of a full-size component, + without smoothing. } + +{METHODDEF} +procedure fullsize_downsample (cinfo : j_compress_ptr; + compptr : jpeg_component_info_ptr; + input_data : JSAMPARRAY; + output_data : JSAMPARRAY); +begin + { Copy the data } + jcopy_sample_rows(input_data, 0, output_data, 0, + cinfo^.max_v_samp_factor, cinfo^.image_width); + { Edge-expand } + expand_right_edge(output_data, cinfo^.max_v_samp_factor, + cinfo^.image_width, compptr^.width_in_blocks * DCTSIZE); +end; + + +{ Downsample pixel values of a single component. + This version handles the common case of 2:1 horizontal and 1:1 vertical, + without smoothing. + + A note about the "bias" calculations: when rounding fractional values to + integer, we do not want to always round 0.5 up to the next integer. + If we did that, we'd introduce a noticeable bias towards larger values. + Instead, this code is arranged so that 0.5 will be rounded up or down at + alternate pixel locations (a simple ordered dither pattern). } + +{METHODDEF} +procedure h2v1_downsample (cinfo : j_compress_ptr; + compptr : jpeg_component_info_ptr; + input_data : JSAMPARRAY; + output_data : JSAMPARRAY); +var + outrow : int; + outcol : JDIMENSION; + output_cols : JDIMENSION; + {register} inptr, outptr : JSAMPLE_PTR; + {register} bias : int; +begin + output_cols := compptr^.width_in_blocks * DCTSIZE; + + { Expand input data enough to let all the output samples be generated + by the standard loop. Special-casing padded output would be more + efficient. } + + expand_right_edge(input_data, cinfo^.max_v_samp_factor, + cinfo^.image_width, output_cols * 2); + + for outrow := 0 to pred(compptr^.v_samp_factor) do + begin + outptr := JSAMPLE_PTR(output_data^[outrow]); + inptr := JSAMPLE_PTR(input_data^[outrow]); + bias := 0; { bias := 0,1,0,1,... for successive samples } + for outcol := 0 to pred(output_cols) do + begin + outptr^ := JSAMPLE ((GETJSAMPLE(inptr^) + + GETJSAMPLE(JSAMPROW(inptr)^[1]) + bias) shr 1); + Inc(outptr); + bias := bias xor 1; { 0=>1, 1=>0 } + Inc(inptr, 2); + end; + end; +end; + + +{ Downsample pixel values of a single component. + This version handles the standard case of 2:1 horizontal and 2:1 vertical, + without smoothing. } + +{METHODDEF} +procedure h2v2_downsample (cinfo : j_compress_ptr; + compptr : jpeg_component_info_ptr; + input_data : JSAMPARRAY; + output_data : JSAMPARRAY); +var + inrow, outrow : int; + outcol : JDIMENSION; + output_cols : JDIMENSION; + {register} inptr0, inptr1, outptr : JSAMPLE_PTR; + {register} bias : int; +begin + output_cols := compptr^.width_in_blocks * DCTSIZE; + + { Expand input data enough to let all the output samples be generated + by the standard loop. Special-casing padded output would be more + efficient. } + + expand_right_edge(input_data, cinfo^.max_v_samp_factor, + cinfo^.image_width, output_cols * 2); + + inrow := 0; + for outrow := 0 to pred(compptr^.v_samp_factor) do + begin + outptr := JSAMPLE_PTR(output_data^[outrow]); + inptr0 := JSAMPLE_PTR(input_data^[inrow]); + inptr1 := JSAMPLE_PTR(input_data^[inrow+1]); + bias := 1; { bias := 1,2,1,2,... for successive samples } + for outcol := 0 to pred(output_cols) do + begin + outptr^ := JSAMPLE ((GETJSAMPLE(inptr0^) + + GETJSAMPLE(JSAMPROW(inptr0)^[1]) + + GETJSAMPLE(inptr1^) + + GETJSAMPLE(JSAMPROW(inptr1)^[1]) + bias) shr 2); + Inc(outptr); + bias := bias xor 3; { 1=>2, 2=>1 } + Inc(inptr0, 2); + Inc(inptr1, 2); + end; + Inc(inrow, 2); + end; +end; + + +{$ifdef INPUT_SMOOTHING_SUPPORTED} + +{ Downsample pixel values of a single component. + This version handles the standard case of 2:1 horizontal and 2:1 vertical, + with smoothing. One row of context is required. } + +{METHODDEF} +procedure h2v2_smooth_downsample (cinfo : j_compress_ptr; + compptr : jpeg_component_info_ptr; + input_data : JSAMPARRAY; + output_data : JSAMPARRAY); +var + inrow, outrow : int; + colctr : JDIMENSION; + output_cols : JDIMENSION; + {register} inptr0, inptr1, above_ptr, below_ptr, outptr : JSAMPLE_PTR; + membersum, neighsum, memberscale, neighscale : INT32; +var + prev_input_data : JSAMPARRAY; + prev_inptr0, prev_inptr1, prev_above_ptr, prev_below_ptr : JSAMPLE_PTR; +begin + output_cols := compptr^.width_in_blocks * DCTSIZE; + + { Expand input data enough to let all the output samples be generated + by the standard loop. Special-casing padded output would be more + efficient. } + + prev_input_data := input_data; + Dec(JSAMPROW_PTR(prev_input_data)); + expand_right_edge(prev_input_data, cinfo^.max_v_samp_factor + 2, + cinfo^.image_width, output_cols * 2); + + { We don't bother to form the individual "smoothed" input pixel values; + we can directly compute the output which is the average of the four + smoothed values. Each of the four member pixels contributes a fraction + (1-8*SF) to its own smoothed image and a fraction SF to each of the three + other smoothed pixels, therefore a total fraction (1-5*SF)/4 to the final + output. The four corner-adjacent neighbor pixels contribute a fraction + SF to just one smoothed pixel, or SF/4 to the final output; while the + eight edge-adjacent neighbors contribute SF to each of two smoothed + pixels, or SF/2 overall. In order to use integer arithmetic, these + factors are scaled by 2^16 := 65536. + Also recall that SF := smoothing_factor / 1024. } + + memberscale := 16384 - cinfo^.smoothing_factor * 80; { scaled (1-5*SF)/4 } + neighscale := cinfo^.smoothing_factor * 16; { scaled SF/4 } + + inrow := 0; + for outrow := 0 to pred(compptr^.v_samp_factor) do + begin + outptr := JSAMPLE_PTR(output_data^[outrow]); + inptr0 := JSAMPLE_PTR(input_data^[inrow]); + inptr1 := JSAMPLE_PTR(input_data^[inrow+1]); + above_ptr := JSAMPLE_PTR(input_data^[inrow-1]); + below_ptr := JSAMPLE_PTR(input_data^[inrow+2]); + + { Special case for first column: pretend column -1 is same as column 0 } + membersum := GETJSAMPLE(inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[1]) + + GETJSAMPLE(inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[1]); + neighsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(JSAMPROW(above_ptr)^[1]) + + GETJSAMPLE(below_ptr^) + GETJSAMPLE(JSAMPROW(below_ptr)^[1]) + + GETJSAMPLE(inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[2]) + + GETJSAMPLE(inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[2]); + Inc(neighsum, neighsum); + Inc(neighsum, GETJSAMPLE(above_ptr^) + + GETJSAMPLE(JSAMPROW(above_ptr)^[2]) + + GETJSAMPLE(below_ptr^) + + GETJSAMPLE(JSAMPROW(below_ptr)^[2]) ); + membersum := membersum * memberscale + neighsum * neighscale; + outptr^ := JSAMPLE ((membersum + 32768) shr 16); + Inc(outptr); + prev_inptr0 := inptr0; + prev_inptr1 := inptr1; + Inc(prev_inptr0); + Inc(prev_inptr1); + Inc(inptr0, 2); + Inc(inptr1, 2); + prev_above_ptr := above_ptr; + prev_below_ptr := below_ptr; + Inc(above_ptr, 2); + Inc(below_ptr, 2); + Inc(prev_above_ptr, 1); + Inc(prev_below_ptr, 1); + + for colctr := pred(output_cols - 2) downto 0 do + begin + { sum of pixels directly mapped to this output element } + membersum := GETJSAMPLE(inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[1]) + + GETJSAMPLE(inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[1]); + { sum of edge-neighbor pixels } + neighsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(JSAMPROW(above_ptr)^[1]) + + GETJSAMPLE(below_ptr^) + GETJSAMPLE(JSAMPROW(below_ptr)^[1]) + + GETJSAMPLE(prev_inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[2]) + + GETJSAMPLE(prev_inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[2]); + { The edge-neighbors count twice as much as corner-neighbors } + Inc(neighsum, neighsum); + { Add in the corner-neighbors } + Inc(neighsum, GETJSAMPLE(prev_above_ptr^) + + GETJSAMPLE(JSAMPROW(above_ptr)^[2]) + + GETJSAMPLE(prev_below_ptr^) + + GETJSAMPLE(JSAMPROW(below_ptr)^[2]) ); + { form final output scaled up by 2^16 } + membersum := membersum * memberscale + neighsum * neighscale; + { round, descale and output it } + outptr^ := JSAMPLE ((membersum + 32768) shr 16); + Inc(outptr); + Inc(inptr0, 2); + Inc(inptr1, 2); + Inc(prev_inptr0, 2); + Inc(prev_inptr1, 2); + Inc(above_ptr, 2); + Inc(below_ptr, 2); + Inc(prev_above_ptr, 2); + Inc(prev_below_ptr, 2); + end; + + { Special case for last column } + membersum := GETJSAMPLE(inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[1]) + + GETJSAMPLE(inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[1]); + neighsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(JSAMPROW(above_ptr)^[1]) + + GETJSAMPLE(below_ptr^) + GETJSAMPLE(JSAMPROW(below_ptr)^[1]) + + GETJSAMPLE(prev_inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[1]) + + GETJSAMPLE(prev_inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[1]); + Inc(neighsum, neighsum); + Inc(neighsum, GETJSAMPLE(prev_above_ptr^) + + GETJSAMPLE(JSAMPROW(above_ptr)^[1]) + + GETJSAMPLE(prev_below_ptr^) + + GETJSAMPLE(JSAMPROW(below_ptr)^[1]) ); + membersum := membersum * memberscale + neighsum * neighscale; + outptr^ := JSAMPLE ((membersum + 32768) shr 16); + + Inc(inrow, 2); + end; +end; + + +{ Downsample pixel values of a single component. + This version handles the special case of a full-size component, + with smoothing. One row of context is required. } + +{METHODDEF} +procedure fullsize_smooth_downsample (cinfo : j_compress_ptr; + compptr : jpeg_component_info_ptr; + input_data : JSAMPARRAY; + output_data : JSAMPARRAY); +var + outrow : int; + colctr : JDIMENSION; + output_cols : JDIMENSION; + {register} inptr, above_ptr, below_ptr, outptr : JSAMPLE_PTR; + membersum, neighsum, memberscale, neighscale : INT32; + colsum, lastcolsum, nextcolsum : int; +var + prev_input_data : JSAMPARRAY; +begin + output_cols := compptr^.width_in_blocks * DCTSIZE; + + { Expand input data enough to let all the output samples be generated + by the standard loop. Special-casing padded output would be more + efficient. } + + prev_input_data := input_data; + Dec(JSAMPROW_PTR(prev_input_data)); + expand_right_edge(prev_input_data, cinfo^.max_v_samp_factor + 2, + cinfo^.image_width, output_cols); + + { Each of the eight neighbor pixels contributes a fraction SF to the + smoothed pixel, while the main pixel contributes (1-8*SF). In order + to use integer arithmetic, these factors are multiplied by 2^16 := 65536. + Also recall that SF := smoothing_factor / 1024. } + + memberscale := long(65536) - cinfo^.smoothing_factor * long(512); { scaled 1-8*SF } + neighscale := cinfo^.smoothing_factor * 64; { scaled SF } + + for outrow := 0 to pred(compptr^.v_samp_factor) do + begin + outptr := JSAMPLE_PTR(output_data^[outrow]); + inptr := JSAMPLE_PTR(input_data^[outrow]); + above_ptr := JSAMPLE_PTR(input_data^[outrow-1]); + below_ptr := JSAMPLE_PTR(input_data^[outrow+1]); + + { Special case for first column } + colsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(below_ptr^) + + GETJSAMPLE(inptr^); + Inc(above_ptr); + Inc(below_ptr); + membersum := GETJSAMPLE(inptr^); + Inc(inptr); + nextcolsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(below_ptr^) + + GETJSAMPLE(inptr^); + neighsum := colsum + (colsum - membersum) + nextcolsum; + membersum := membersum * memberscale + neighsum * neighscale; + outptr^ := JSAMPLE ((membersum + 32768) shr 16); + Inc(outptr); + lastcolsum := colsum; colsum := nextcolsum; + + for colctr := pred(output_cols - 2) downto 0 do + begin + membersum := GETJSAMPLE(inptr^); + Inc(inptr); + Inc(above_ptr); + Inc(below_ptr); + nextcolsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(below_ptr^) + + GETJSAMPLE(inptr^); + neighsum := lastcolsum + (colsum - membersum) + nextcolsum; + membersum := membersum * memberscale + neighsum * neighscale; + outptr^ := JSAMPLE ((membersum + 32768) shr 16); + Inc(outptr); + lastcolsum := colsum; colsum := nextcolsum; + end; + + { Special case for last column } + membersum := GETJSAMPLE(inptr^); + neighsum := lastcolsum + (colsum - membersum) + colsum; + membersum := membersum * memberscale + neighsum * neighscale; + outptr^ := JSAMPLE ((membersum + 32768) shr 16); + end; +end; + +{$endif} { INPUT_SMOOTHING_SUPPORTED } + + +{ Module initialization routine for downsampling. + Note that we must select a routine for each component. } + +{GLOBAL} +procedure jinit_downsampler (cinfo : j_compress_ptr); +var + downsample : my_downsample_ptr; + ci : int; + compptr : jpeg_component_info_ptr; + smoothok : boolean; +begin + smoothok := TRUE; + + downsample := my_downsample_ptr( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + SIZEOF(my_downsampler)) ); + cinfo^.downsample := jpeg_downsampler_ptr (downsample); + downsample^.pub.start_pass := start_pass_downsample; + downsample^.pub.downsample := sep_downsample; + downsample^.pub.need_context_rows := FALSE; + + if (cinfo^.CCIR601_sampling) then + ERREXIT(j_common_ptr(cinfo), JERR_CCIR601_NOTIMPL); + + { Verify we can handle the sampling factors, and set up method pointers } + compptr := jpeg_component_info_ptr(cinfo^.comp_info); + for ci := 0 to pred(cinfo^.num_components) do + begin + if (compptr^.h_samp_factor = cinfo^.max_h_samp_factor) and + (compptr^.v_samp_factor = cinfo^.max_v_samp_factor) then + begin +{$ifdef INPUT_SMOOTHING_SUPPORTED} + if (cinfo^.smoothing_factor <> 0) then + begin + downsample^.methods[ci] := fullsize_smooth_downsample; + downsample^.pub.need_context_rows := TRUE; + end + else +{$endif} + downsample^.methods[ci] := fullsize_downsample; + end + else + if (compptr^.h_samp_factor * 2 = cinfo^.max_h_samp_factor) and + (compptr^.v_samp_factor = cinfo^.max_v_samp_factor) then + begin + smoothok := FALSE; + downsample^.methods[ci] := h2v1_downsample; + end + else + if (compptr^.h_samp_factor * 2 = cinfo^.max_h_samp_factor) and + (compptr^.v_samp_factor * 2 = cinfo^.max_v_samp_factor) then + begin + {$ifdef INPUT_SMOOTHING_SUPPORTED} + if (cinfo^.smoothing_factor <> 0) then + begin + downsample^.methods[ci] := h2v2_smooth_downsample; + downsample^.pub.need_context_rows := TRUE; + end + else + {$endif} + downsample^.methods[ci] := h2v2_downsample; + end + else + if ((cinfo^.max_h_samp_factor mod compptr^.h_samp_factor) = 0) and + ((cinfo^.max_v_samp_factor mod compptr^.v_samp_factor) = 0) then + begin + smoothok := FALSE; + downsample^.methods[ci] := int_downsample; + end + else + ERREXIT(j_common_ptr(cinfo), JERR_FRACT_SAMPLE_NOTIMPL); + Inc(compptr); + end; + +{$ifdef INPUT_SMOOTHING_SUPPORTED} + if (cinfo^.smoothing_factor <> 0) and (not smoothok) then + TRACEMS(j_common_ptr(cinfo), 0, JTRC_SMOOTH_NOTIMPL); +{$endif} +end; + +end. diff --git a/Imaging/JpegLib/imjdapimin.pas b/Imaging/JpegLib/imjdapimin.pas index 781c6f5..367128e 100644 --- a/Imaging/JpegLib/imjdapimin.pas +++ b/Imaging/JpegLib/imjdapimin.pas @@ -1,505 +1,505 @@ -unit imjdapimin; - -{$N+} { Nomssi: cinfo^.output_gamma } - -{ This file contains application interface code for the decompression half - of the JPEG library. These are the "minimum" API routines that may be - needed in either the normal full-decompression case or the - transcoding-only case. - - Most of the routines intended to be called directly by an application - are in this file or in jdapistd.c. But also see jcomapi.c for routines - shared by compression and decompression, and jdtrans.c for the transcoding - case. } - -{ Original : jdapimin.c ; Copyright (C) 1994-1998, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjdeferr, - imjerror, - imjpeglib, - imjmemmgr, imjdmarker, imjdinput, imjcomapi; - -{ Nomssi } -procedure jpeg_create_decompress(cinfo : j_decompress_ptr); - -{ Initialization of a JPEG decompression object. - The error manager must already be set up (in case memory manager fails). } - -{GLOBAL} -procedure jpeg_CreateDecompress (cinfo : j_decompress_ptr; - version : int; - structsize : size_t); - -{ Destruction of a JPEG decompression object } - -{GLOBAL} -procedure jpeg_destroy_decompress (cinfo : j_decompress_ptr); - - -{ Decompression startup: read start of JPEG datastream to see what's there. - Need only initialize JPEG object and supply a data source before calling. - - This routine will read as far as the first SOS marker (ie, actual start of - compressed data), and will save all tables and parameters in the JPEG - object. It will also initialize the decompression parameters to default - values, and finally return JPEG_HEADER_OK. On return, the application may - adjust the decompression parameters and then call jpeg_start_decompress. - (Or, if the application only wanted to determine the image parameters, - the data need not be decompressed. In that case, call jpeg_abort or - jpeg_destroy to release any temporary space.) - If an abbreviated (tables only) datastream is presented, the routine will - return JPEG_HEADER_TABLES_ONLY upon reaching EOI. The application may then - re-use the JPEG object to read the abbreviated image datastream(s). - It is unnecessary (but OK) to call jpeg_abort in this case. - The JPEG_SUSPENDED return code only occurs if the data source module - requests suspension of the decompressor. In this case the application - should load more source data and then re-call jpeg_read_header to resume - processing. - If a non-suspending data source is used and require_image is TRUE, then the - return code need not be inspected since only JPEG_HEADER_OK is possible. - - This routine is now just a front end to jpeg_consume_input, with some - extra error checking. } - -{GLOBAL} -function jpeg_read_header (cinfo : j_decompress_ptr; - require_image : boolean) : int; - -{ Consume data in advance of what the decompressor requires. - This can be called at any time once the decompressor object has - been created and a data source has been set up. - - This routine is essentially a state machine that handles a couple - of critical state-transition actions, namely initial setup and - transition from header scanning to ready-for-start_decompress. - All the actual input is done via the input controller's consume_input - method. } - -{GLOBAL} -function jpeg_consume_input (cinfo : j_decompress_ptr) : int; - -{ Have we finished reading the input file? } - -{GLOBAL} -function jpeg_input_complete (cinfo : j_decompress_ptr) : boolean; - -{ Is there more than one scan? } - -{GLOBAL} -function jpeg_has_multiple_scans (cinfo : j_decompress_ptr) : boolean; - - -{ Finish JPEG decompression. - - This will normally just verify the file trailer and release temp storage. - - Returns FALSE if suspended. The return value need be inspected only if - a suspending data source is used. } - -{GLOBAL} -function jpeg_finish_decompress (cinfo : j_decompress_ptr) : boolean; - -implementation - -procedure jpeg_create_decompress(cinfo : j_decompress_ptr); -begin - jpeg_CreateDecompress(cinfo, JPEG_LIB_VERSION, - size_t(sizeof(jpeg_decompress_struct))); -end; - -{ Initialization of a JPEG decompression object. - The error manager must already be set up (in case memory manager fails). } - -{GLOBAL} -procedure jpeg_CreateDecompress (cinfo : j_decompress_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_decompress_struct)) then - ERREXIT2(j_common_ptr(cinfo), JERR_BAD_STRUCT_SIZE, - int(SIZEOF(jpeg_decompress_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. } - begin - err := cinfo^.err; - client_data := cinfo^.client_data; { ignore Purify complaint here } - MEMZERO(j_common_ptr(cinfo), SIZEOF(jpeg_decompress_struct)); - cinfo^.err := err; - cinfo^.client_data := client_data; - end; - cinfo^.is_decompressor := TRUE; - - { 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^.src := 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; - - { Initialize marker processor so application can override methods - for COM, APPn markers before calling jpeg_read_header. } - cinfo^.marker_list := NIL; - jinit_marker_reader(cinfo); - - { And initialize the overall input controller. } - jinit_input_controller(cinfo); - - { OK, I'm ready } - cinfo^.global_state := DSTATE_START; -end; - - -{ Destruction of a JPEG decompression object } - -{GLOBAL} -procedure jpeg_destroy_decompress (cinfo : j_decompress_ptr); -begin - jpeg_destroy(j_common_ptr(cinfo)); { use common routine } -end; - - -{ Abort processing of a JPEG decompression operation, - but don't destroy the object itself. } - -{GLOBAL} -procedure jpeg_abort_decompress (cinfo : j_decompress_ptr); -begin - jpeg_abort(j_common_ptr(cinfo)); { use common routine } -end; - - -{ Set default decompression parameters. } - -{LOCAL} -procedure default_decompress_parms (cinfo : j_decompress_ptr); -var - cid0 : int; - cid1 : int; - cid2 : int; -begin - { Guess the input colorspace, and set output colorspace accordingly. } - { (Wish JPEG committee had provided a real way to specify this...) } - { Note application may override our guesses. } - case (cinfo^.num_components) of - 1: begin - cinfo^.jpeg_color_space := JCS_GRAYSCALE; - cinfo^.out_color_space := JCS_GRAYSCALE; - end; - - 3: begin - if (cinfo^.saw_JFIF_marker) then - begin - cinfo^.jpeg_color_space := JCS_YCbCr; { JFIF implies YCbCr } - end - else - if (cinfo^.saw_Adobe_marker) then - begin - case (cinfo^.Adobe_transform) of - 0: cinfo^.jpeg_color_space := JCS_RGB; - 1: cinfo^.jpeg_color_space := JCS_YCbCr; - else - begin - WARNMS1(j_common_ptr(cinfo), JWRN_ADOBE_XFORM, cinfo^.Adobe_transform); - cinfo^.jpeg_color_space := JCS_YCbCr; { assume it's YCbCr } - end; - end; - end - else - begin - { Saw no special markers, try to guess from the component IDs } - cid0 := cinfo^.comp_info^[0].component_id; - cid1 := cinfo^.comp_info^[1].component_id; - cid2 := cinfo^.comp_info^[2].component_id; - - if (cid0 = 1) and (cid1 = 2) and (cid2 = 3) then - cinfo^.jpeg_color_space := JCS_YCbCr { assume JFIF w/out marker } - else - if (cid0 = 82) and (cid1 = 71) and (cid2 = 66) then - cinfo^.jpeg_color_space := JCS_RGB { ASCII 'R', 'G', 'B' } - else - begin - {$IFDEF DEBUG} - TRACEMS3(j_common_ptr(cinfo), 1, JTRC_UNKNOWN_IDS, cid0, cid1, cid2); - {$ENDIF} - cinfo^.jpeg_color_space := JCS_YCbCr; { assume it's YCbCr } - end; - end; - { Always guess RGB is proper output colorspace. } - cinfo^.out_color_space := JCS_RGB; - end; - - 4: begin - if (cinfo^.saw_Adobe_marker) then - begin - case (cinfo^.Adobe_transform) of - 0: cinfo^.jpeg_color_space := JCS_CMYK; - 2: cinfo^.jpeg_color_space := JCS_YCCK; - else - begin - WARNMS1(j_common_ptr(cinfo), JWRN_ADOBE_XFORM, cinfo^.Adobe_transform); - cinfo^.jpeg_color_space := JCS_YCCK; { assume it's YCCK } - end; - end; - end - else - begin - { No special markers, assume straight CMYK. } - cinfo^.jpeg_color_space := JCS_CMYK; - end; - cinfo^.out_color_space := JCS_CMYK; - end; - - else - begin - cinfo^.jpeg_color_space := JCS_UNKNOWN; - cinfo^.out_color_space := JCS_UNKNOWN; - end; - end; - - { Set defaults for other decompression parameters. } - cinfo^.scale_num := 1; { 1:1 scaling } - cinfo^.scale_denom := 1; - cinfo^.output_gamma := 1.0; - cinfo^.buffered_image := FALSE; - cinfo^.raw_data_out := FALSE; - cinfo^.dct_method := JDCT_DEFAULT; - cinfo^.do_fancy_upsampling := TRUE; - cinfo^.do_block_smoothing := TRUE; - cinfo^.quantize_colors := FALSE; - { We set these in case application only sets quantize_colors. } - cinfo^.dither_mode := JDITHER_FS; -{$ifdef QUANT_2PASS_SUPPORTED} - cinfo^.two_pass_quantize := TRUE; -{$else} - cinfo^.two_pass_quantize := FALSE; -{$endif} - cinfo^.desired_number_of_colors := 256; - cinfo^.colormap := NIL; - { Initialize for no mode change in buffered-image mode. } - cinfo^.enable_1pass_quant := FALSE; - cinfo^.enable_external_quant := FALSE; - cinfo^.enable_2pass_quant := FALSE; -end; - - -{ Decompression startup: read start of JPEG datastream to see what's there. - Need only initialize JPEG object and supply a data source before calling. - - This routine will read as far as the first SOS marker (ie, actual start of - compressed data), and will save all tables and parameters in the JPEG - object. It will also initialize the decompression parameters to default - values, and finally return JPEG_HEADER_OK. On return, the application may - adjust the decompression parameters and then call jpeg_start_decompress. - (Or, if the application only wanted to determine the image parameters, - the data need not be decompressed. In that case, call jpeg_abort or - jpeg_destroy to release any temporary space.) - If an abbreviated (tables only) datastream is presented, the routine will - return JPEG_HEADER_TABLES_ONLY upon reaching EOI. The application may then - re-use the JPEG object to read the abbreviated image datastream(s). - It is unnecessary (but OK) to call jpeg_abort in this case. - The JPEG_SUSPENDED return code only occurs if the data source module - requests suspension of the decompressor. In this case the application - should load more source data and then re-call jpeg_read_header to resume - processing. - If a non-suspending data source is used and require_image is TRUE, then the - return code need not be inspected since only JPEG_HEADER_OK is possible. - - This routine is now just a front end to jpeg_consume_input, with some - extra error checking. } - -{GLOBAL} -function jpeg_read_header (cinfo : j_decompress_ptr; - require_image : boolean) : int; -var - retcode : int; -begin - if (cinfo^.global_state <> DSTATE_START) and - (cinfo^.global_state <> DSTATE_INHEADER) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - - retcode := jpeg_consume_input(cinfo); - - case (retcode) of - JPEG_REACHED_SOS: - retcode := JPEG_HEADER_OK; - JPEG_REACHED_EOI: - begin - if (require_image) then { Complain if application wanted an image } - ERREXIT(j_common_ptr(cinfo), JERR_NO_IMAGE); - { Reset to start state; it would be safer to require the application to - call jpeg_abort, but we can't change it now for compatibility reasons. - A side effect is to free any temporary memory (there shouldn't be any). } - - jpeg_abort(j_common_ptr(cinfo)); { sets state := DSTATE_START } - retcode := JPEG_HEADER_TABLES_ONLY; - end; - JPEG_SUSPENDED: ; { no work } - end; - - jpeg_read_header := retcode; -end; - - -{ Consume data in advance of what the decompressor requires. - This can be called at any time once the decompressor object has - been created and a data source has been set up. - - This routine is essentially a state machine that handles a couple - of critical state-transition actions, namely initial setup and - transition from header scanning to ready-for-start_decompress. - All the actual input is done via the input controller's consume_input - method. } - -{GLOBAL} -function jpeg_consume_input (cinfo : j_decompress_ptr) : int; -var - retcode : int; -begin - retcode := JPEG_SUSPENDED; - - { NB: every possible DSTATE value should be listed in this switch } - - if (cinfo^.global_state) = DSTATE_START then - begin {work around the FALLTHROUGH} - { Start-of-datastream actions: reset appropriate modules } - cinfo^.inputctl^.reset_input_controller (cinfo); - { Initialize application's data source module } - cinfo^.src^.init_source (cinfo); - cinfo^.global_state := DSTATE_INHEADER; - end; - - case (cinfo^.global_state) of - DSTATE_START, - DSTATE_INHEADER: - begin - retcode := cinfo^.inputctl^.consume_input (cinfo); - if (retcode = JPEG_REACHED_SOS) then - begin { Found SOS, prepare to decompress } - { Set up default parameters based on header data } - default_decompress_parms(cinfo); - { Set global state: ready for start_decompress } - cinfo^.global_state := DSTATE_READY; - end; - end; - DSTATE_READY: - { Can't advance past first SOS until start_decompress is called } - retcode := JPEG_REACHED_SOS; - - DSTATE_PRELOAD, - DSTATE_PRESCAN, - DSTATE_SCANNING, - DSTATE_RAW_OK, - DSTATE_BUFIMAGE, - DSTATE_BUFPOST, - DSTATE_STOPPING: - retcode := cinfo^.inputctl^.consume_input (cinfo); - else - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - end; - jpeg_consume_input := retcode; -end; - - -{ Have we finished reading the input file? } - -{GLOBAL} -function jpeg_input_complete (cinfo : j_decompress_ptr) : boolean; -begin - { Check for valid jpeg object } - if (cinfo^.global_state < DSTATE_START) or - (cinfo^.global_state > DSTATE_STOPPING) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - jpeg_input_complete := cinfo^.inputctl^.eoi_reached; -end; - - -{ Is there more than one scan? } - -{GLOBAL} -function jpeg_has_multiple_scans (cinfo : j_decompress_ptr) : boolean; -begin - { Only valid after jpeg_read_header completes } - if (cinfo^.global_state < DSTATE_READY) or - (cinfo^.global_state > DSTATE_STOPPING) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - jpeg_has_multiple_scans := cinfo^.inputctl^.has_multiple_scans; -end; - - -{ Finish JPEG decompression. - - This will normally just verify the file trailer and release temp storage. - - Returns FALSE if suspended. The return value need be inspected only if - a suspending data source is used. } - -{GLOBAL} -function jpeg_finish_decompress (cinfo : j_decompress_ptr) : boolean; -begin - if ((cinfo^.global_state = DSTATE_SCANNING) or - (cinfo^.global_state = DSTATE_RAW_OK) and (not cinfo^.buffered_image)) then - begin - { Terminate final pass of non-buffered mode } - if (cinfo^.output_scanline < cinfo^.output_height) then - ERREXIT(j_common_ptr(cinfo), JERR_TOO_LITTLE_DATA); - cinfo^.master^.finish_output_pass (cinfo); - cinfo^.global_state := DSTATE_STOPPING; - end - else - if (cinfo^.global_state = DSTATE_BUFIMAGE) then - begin - { Finishing after a buffered-image operation } - cinfo^.global_state := DSTATE_STOPPING; - end - else - if (cinfo^.global_state <> DSTATE_STOPPING) then - begin - { STOPPING := repeat call after a suspension, anything else is error } - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - end; - { Read until EOI } - while (not cinfo^.inputctl^.eoi_reached) do - begin - if (cinfo^.inputctl^.consume_input (cinfo) = JPEG_SUSPENDED) then - begin - jpeg_finish_decompress := FALSE; { Suspend, come back later } - exit; - end; - end; - { Do final cleanup } - cinfo^.src^.term_source (cinfo); - { We can use jpeg_abort to release memory and reset global_state } - jpeg_abort(j_common_ptr(cinfo)); - jpeg_finish_decompress := TRUE; -end; - -end. +unit imjdapimin; + +{$N+} { Nomssi: cinfo^.output_gamma } + +{ This file contains application interface code for the decompression half + of the JPEG library. These are the "minimum" API routines that may be + needed in either the normal full-decompression case or the + transcoding-only case. + + Most of the routines intended to be called directly by an application + are in this file or in jdapistd.c. But also see jcomapi.c for routines + shared by compression and decompression, and jdtrans.c for the transcoding + case. } + +{ Original : jdapimin.c ; Copyright (C) 1994-1998, Thomas G. Lane. } + +interface + +{$I imjconfig.inc} + +uses + imjmorecfg, + imjinclude, + imjdeferr, + imjerror, + imjpeglib, + imjmemmgr, imjdmarker, imjdinput, imjcomapi; + +{ Nomssi } +procedure jpeg_create_decompress(cinfo : j_decompress_ptr); + +{ Initialization of a JPEG decompression object. + The error manager must already be set up (in case memory manager fails). } + +{GLOBAL} +procedure jpeg_CreateDecompress (cinfo : j_decompress_ptr; + version : int; + structsize : size_t); + +{ Destruction of a JPEG decompression object } + +{GLOBAL} +procedure jpeg_destroy_decompress (cinfo : j_decompress_ptr); + + +{ Decompression startup: read start of JPEG datastream to see what's there. + Need only initialize JPEG object and supply a data source before calling. + + This routine will read as far as the first SOS marker (ie, actual start of + compressed data), and will save all tables and parameters in the JPEG + object. It will also initialize the decompression parameters to default + values, and finally return JPEG_HEADER_OK. On return, the application may + adjust the decompression parameters and then call jpeg_start_decompress. + (Or, if the application only wanted to determine the image parameters, + the data need not be decompressed. In that case, call jpeg_abort or + jpeg_destroy to release any temporary space.) + If an abbreviated (tables only) datastream is presented, the routine will + return JPEG_HEADER_TABLES_ONLY upon reaching EOI. The application may then + re-use the JPEG object to read the abbreviated image datastream(s). + It is unnecessary (but OK) to call jpeg_abort in this case. + The JPEG_SUSPENDED return code only occurs if the data source module + requests suspension of the decompressor. In this case the application + should load more source data and then re-call jpeg_read_header to resume + processing. + If a non-suspending data source is used and require_image is TRUE, then the + return code need not be inspected since only JPEG_HEADER_OK is possible. + + This routine is now just a front end to jpeg_consume_input, with some + extra error checking. } + +{GLOBAL} +function jpeg_read_header (cinfo : j_decompress_ptr; + require_image : boolean) : int; + +{ Consume data in advance of what the decompressor requires. + This can be called at any time once the decompressor object has + been created and a data source has been set up. + + This routine is essentially a state machine that handles a couple + of critical state-transition actions, namely initial setup and + transition from header scanning to ready-for-start_decompress. + All the actual input is done via the input controller's consume_input + method. } + +{GLOBAL} +function jpeg_consume_input (cinfo : j_decompress_ptr) : int; + +{ Have we finished reading the input file? } + +{GLOBAL} +function jpeg_input_complete (cinfo : j_decompress_ptr) : boolean; + +{ Is there more than one scan? } + +{GLOBAL} +function jpeg_has_multiple_scans (cinfo : j_decompress_ptr) : boolean; + + +{ Finish JPEG decompression. + + This will normally just verify the file trailer and release temp storage. + + Returns FALSE if suspended. The return value need be inspected only if + a suspending data source is used. } + +{GLOBAL} +function jpeg_finish_decompress (cinfo : j_decompress_ptr) : boolean; + +implementation + +procedure jpeg_create_decompress(cinfo : j_decompress_ptr); +begin + jpeg_CreateDecompress(cinfo, JPEG_LIB_VERSION, + size_t(sizeof(jpeg_decompress_struct))); +end; + +{ Initialization of a JPEG decompression object. + The error manager must already be set up (in case memory manager fails). } + +{GLOBAL} +procedure jpeg_CreateDecompress (cinfo : j_decompress_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_decompress_struct)) then + ERREXIT2(j_common_ptr(cinfo), JERR_BAD_STRUCT_SIZE, + int(SIZEOF(jpeg_decompress_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. } + begin + err := cinfo^.err; + client_data := cinfo^.client_data; { ignore Purify complaint here } + MEMZERO(j_common_ptr(cinfo), SIZEOF(jpeg_decompress_struct)); + cinfo^.err := err; + cinfo^.client_data := client_data; + end; + cinfo^.is_decompressor := TRUE; + + { 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^.src := 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; + + { Initialize marker processor so application can override methods + for COM, APPn markers before calling jpeg_read_header. } + cinfo^.marker_list := NIL; + jinit_marker_reader(cinfo); + + { And initialize the overall input controller. } + jinit_input_controller(cinfo); + + { OK, I'm ready } + cinfo^.global_state := DSTATE_START; +end; + + +{ Destruction of a JPEG decompression object } + +{GLOBAL} +procedure jpeg_destroy_decompress (cinfo : j_decompress_ptr); +begin + jpeg_destroy(j_common_ptr(cinfo)); { use common routine } +end; + + +{ Abort processing of a JPEG decompression operation, + but don't destroy the object itself. } + +{GLOBAL} +procedure jpeg_abort_decompress (cinfo : j_decompress_ptr); +begin + jpeg_abort(j_common_ptr(cinfo)); { use common routine } +end; + + +{ Set default decompression parameters. } + +{LOCAL} +procedure default_decompress_parms (cinfo : j_decompress_ptr); +var + cid0 : int; + cid1 : int; + cid2 : int; +begin + { Guess the input colorspace, and set output colorspace accordingly. } + { (Wish JPEG committee had provided a real way to specify this...) } + { Note application may override our guesses. } + case (cinfo^.num_components) of + 1: begin + cinfo^.jpeg_color_space := JCS_GRAYSCALE; + cinfo^.out_color_space := JCS_GRAYSCALE; + end; + + 3: begin + if (cinfo^.saw_JFIF_marker) then + begin + cinfo^.jpeg_color_space := JCS_YCbCr; { JFIF implies YCbCr } + end + else + if (cinfo^.saw_Adobe_marker) then + begin + case (cinfo^.Adobe_transform) of + 0: cinfo^.jpeg_color_space := JCS_RGB; + 1: cinfo^.jpeg_color_space := JCS_YCbCr; + else + begin + WARNMS1(j_common_ptr(cinfo), JWRN_ADOBE_XFORM, cinfo^.Adobe_transform); + cinfo^.jpeg_color_space := JCS_YCbCr; { assume it's YCbCr } + end; + end; + end + else + begin + { Saw no special markers, try to guess from the component IDs } + cid0 := cinfo^.comp_info^[0].component_id; + cid1 := cinfo^.comp_info^[1].component_id; + cid2 := cinfo^.comp_info^[2].component_id; + + if (cid0 = 1) and (cid1 = 2) and (cid2 = 3) then + cinfo^.jpeg_color_space := JCS_YCbCr { assume JFIF w/out marker } + else + if (cid0 = 82) and (cid1 = 71) and (cid2 = 66) then + cinfo^.jpeg_color_space := JCS_RGB { ASCII 'R', 'G', 'B' } + else + begin + {$IFDEF DEBUG} + TRACEMS3(j_common_ptr(cinfo), 1, JTRC_UNKNOWN_IDS, cid0, cid1, cid2); + {$ENDIF} + cinfo^.jpeg_color_space := JCS_YCbCr; { assume it's YCbCr } + end; + end; + { Always guess RGB is proper output colorspace. } + cinfo^.out_color_space := JCS_RGB; + end; + + 4: begin + if (cinfo^.saw_Adobe_marker) then + begin + case (cinfo^.Adobe_transform) of + 0: cinfo^.jpeg_color_space := JCS_CMYK; + 2: cinfo^.jpeg_color_space := JCS_YCCK; + else + begin + WARNMS1(j_common_ptr(cinfo), JWRN_ADOBE_XFORM, cinfo^.Adobe_transform); + cinfo^.jpeg_color_space := JCS_YCCK; { assume it's YCCK } + end; + end; + end + else + begin + { No special markers, assume straight CMYK. } + cinfo^.jpeg_color_space := JCS_CMYK; + end; + cinfo^.out_color_space := JCS_CMYK; + end; + + else + begin + cinfo^.jpeg_color_space := JCS_UNKNOWN; + cinfo^.out_color_space := JCS_UNKNOWN; + end; + end; + + { Set defaults for other decompression parameters. } + cinfo^.scale_num := 1; { 1:1 scaling } + cinfo^.scale_denom := 1; + cinfo^.output_gamma := 1.0; + cinfo^.buffered_image := FALSE; + cinfo^.raw_data_out := FALSE; + cinfo^.dct_method := JDCT_DEFAULT; + cinfo^.do_fancy_upsampling := TRUE; + cinfo^.do_block_smoothing := TRUE; + cinfo^.quantize_colors := FALSE; + { We set these in case application only sets quantize_colors. } + cinfo^.dither_mode := JDITHER_FS; +{$ifdef QUANT_2PASS_SUPPORTED} + cinfo^.two_pass_quantize := TRUE; +{$else} + cinfo^.two_pass_quantize := FALSE; +{$endif} + cinfo^.desired_number_of_colors := 256; + cinfo^.colormap := NIL; + { Initialize for no mode change in buffered-image mode. } + cinfo^.enable_1pass_quant := FALSE; + cinfo^.enable_external_quant := FALSE; + cinfo^.enable_2pass_quant := FALSE; +end; + + +{ Decompression startup: read start of JPEG datastream to see what's there. + Need only initialize JPEG object and supply a data source before calling. + + This routine will read as far as the first SOS marker (ie, actual start of + compressed data), and will save all tables and parameters in the JPEG + object. It will also initialize the decompression parameters to default + values, and finally return JPEG_HEADER_OK. On return, the application may + adjust the decompression parameters and then call jpeg_start_decompress. + (Or, if the application only wanted to determine the image parameters, + the data need not be decompressed. In that case, call jpeg_abort or + jpeg_destroy to release any temporary space.) + If an abbreviated (tables only) datastream is presented, the routine will + return JPEG_HEADER_TABLES_ONLY upon reaching EOI. The application may then + re-use the JPEG object to read the abbreviated image datastream(s). + It is unnecessary (but OK) to call jpeg_abort in this case. + The JPEG_SUSPENDED return code only occurs if the data source module + requests suspension of the decompressor. In this case the application + should load more source data and then re-call jpeg_read_header to resume + processing. + If a non-suspending data source is used and require_image is TRUE, then the + return code need not be inspected since only JPEG_HEADER_OK is possible. + + This routine is now just a front end to jpeg_consume_input, with some + extra error checking. } + +{GLOBAL} +function jpeg_read_header (cinfo : j_decompress_ptr; + require_image : boolean) : int; +var + retcode : int; +begin + if (cinfo^.global_state <> DSTATE_START) and + (cinfo^.global_state <> DSTATE_INHEADER) then + ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); + + retcode := jpeg_consume_input(cinfo); + + case (retcode) of + JPEG_REACHED_SOS: + retcode := JPEG_HEADER_OK; + JPEG_REACHED_EOI: + begin + if (require_image) then { Complain if application wanted an image } + ERREXIT(j_common_ptr(cinfo), JERR_NO_IMAGE); + { Reset to start state; it would be safer to require the application to + call jpeg_abort, but we can't change it now for compatibility reasons. + A side effect is to free any temporary memory (there shouldn't be any). } + + jpeg_abort(j_common_ptr(cinfo)); { sets state := DSTATE_START } + retcode := JPEG_HEADER_TABLES_ONLY; + end; + JPEG_SUSPENDED: ; { no work } + end; + + jpeg_read_header := retcode; +end; + + +{ Consume data in advance of what the decompressor requires. + This can be called at any time once the decompressor object has + been created and a data source has been set up. + + This routine is essentially a state machine that handles a couple + of critical state-transition actions, namely initial setup and + transition from header scanning to ready-for-start_decompress. + All the actual input is done via the input controller's consume_input + method. } + +{GLOBAL} +function jpeg_consume_input (cinfo : j_decompress_ptr) : int; +var + retcode : int; +begin + retcode := JPEG_SUSPENDED; + + { NB: every possible DSTATE value should be listed in this switch } + + if (cinfo^.global_state) = DSTATE_START then + begin {work around the FALLTHROUGH} + { Start-of-datastream actions: reset appropriate modules } + cinfo^.inputctl^.reset_input_controller (cinfo); + { Initialize application's data source module } + cinfo^.src^.init_source (cinfo); + cinfo^.global_state := DSTATE_INHEADER; + end; + + case (cinfo^.global_state) of + DSTATE_START, + DSTATE_INHEADER: + begin + retcode := cinfo^.inputctl^.consume_input (cinfo); + if (retcode = JPEG_REACHED_SOS) then + begin { Found SOS, prepare to decompress } + { Set up default parameters based on header data } + default_decompress_parms(cinfo); + { Set global state: ready for start_decompress } + cinfo^.global_state := DSTATE_READY; + end; + end; + DSTATE_READY: + { Can't advance past first SOS until start_decompress is called } + retcode := JPEG_REACHED_SOS; + + DSTATE_PRELOAD, + DSTATE_PRESCAN, + DSTATE_SCANNING, + DSTATE_RAW_OK, + DSTATE_BUFIMAGE, + DSTATE_BUFPOST, + DSTATE_STOPPING: + retcode := cinfo^.inputctl^.consume_input (cinfo); + else + ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); + end; + jpeg_consume_input := retcode; +end; + + +{ Have we finished reading the input file? } + +{GLOBAL} +function jpeg_input_complete (cinfo : j_decompress_ptr) : boolean; +begin + { Check for valid jpeg object } + if (cinfo^.global_state < DSTATE_START) or + (cinfo^.global_state > DSTATE_STOPPING) then + ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); + jpeg_input_complete := cinfo^.inputctl^.eoi_reached; +end; + + +{ Is there more than one scan? } + +{GLOBAL} +function jpeg_has_multiple_scans (cinfo : j_decompress_ptr) : boolean; +begin + { Only valid after jpeg_read_header completes } + if (cinfo^.global_state < DSTATE_READY) or + (cinfo^.global_state > DSTATE_STOPPING) then + ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); + jpeg_has_multiple_scans := cinfo^.inputctl^.has_multiple_scans; +end; + + +{ Finish JPEG decompression. + + This will normally just verify the file trailer and release temp storage. + + Returns FALSE if suspended. The return value need be inspected only if + a suspending data source is used. } + +{GLOBAL} +function jpeg_finish_decompress (cinfo : j_decompress_ptr) : boolean; +begin + if ((cinfo^.global_state = DSTATE_SCANNING) or + (cinfo^.global_state = DSTATE_RAW_OK) and (not cinfo^.buffered_image)) then + begin + { Terminate final pass of non-buffered mode } + if (cinfo^.output_scanline < cinfo^.output_height) then + ERREXIT(j_common_ptr(cinfo), JERR_TOO_LITTLE_DATA); + cinfo^.master^.finish_output_pass (cinfo); + cinfo^.global_state := DSTATE_STOPPING; + end + else + if (cinfo^.global_state = DSTATE_BUFIMAGE) then + begin + { Finishing after a buffered-image operation } + cinfo^.global_state := DSTATE_STOPPING; + end + else + if (cinfo^.global_state <> DSTATE_STOPPING) then + begin + { STOPPING := repeat call after a suspension, anything else is error } + ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); + end; + { Read until EOI } + while (not cinfo^.inputctl^.eoi_reached) do + begin + if (cinfo^.inputctl^.consume_input (cinfo) = JPEG_SUSPENDED) then + begin + jpeg_finish_decompress := FALSE; { Suspend, come back later } + exit; + end; + end; + { Do final cleanup } + cinfo^.src^.term_source (cinfo); + { We can use jpeg_abort to release memory and reset global_state } + jpeg_abort(j_common_ptr(cinfo)); + jpeg_finish_decompress := TRUE; +end; + +end. diff --git a/Imaging/JpegLib/imjdapistd.pas b/Imaging/JpegLib/imjdapistd.pas index 04bf666..cef249b 100644 --- a/Imaging/JpegLib/imjdapistd.pas +++ b/Imaging/JpegLib/imjdapistd.pas @@ -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. + diff --git a/Imaging/JpegLib/imjdcoefct.pas b/Imaging/JpegLib/imjdcoefct.pas index d488dec..caa69a2 100644 --- a/Imaging/JpegLib/imjdcoefct.pas +++ b/Imaging/JpegLib/imjdcoefct.pas @@ -1,895 +1,895 @@ -unit imjdcoefct; - -{ This file contains the coefficient buffer controller for decompression. - This controller is the top level of the JPEG decompressor proper. - The coefficient buffer lies between entropy decoding and inverse-DCT steps. - - In buffered-image mode, this controller is the interface between - input-oriented processing and output-oriented processing. - Also, the input side (only) is used when reading a file for transcoding. } - -{ Original: jdcoefct.c ; Copyright (C) 1994-1997, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjdeferr, - imjerror, - imjutils, - imjpeglib; - -{GLOBAL} -procedure jinit_d_coef_controller (cinfo : j_decompress_ptr; - need_full_buffer : boolean); - - -implementation - - -{ Block smoothing is only applicable for progressive JPEG, so: } -{$ifndef D_PROGRESSIVE_SUPPORTED} -{$undef BLOCK_SMOOTHING_SUPPORTED} -{$endif} - -{ Private buffer controller object } - -{$ifdef BLOCK_SMOOTHING_SUPPORTED} -const - SAVED_COEFS = 6; { we save coef_bits[0..5] } -type - Latch = array[0..SAVED_COEFS-1] of int; - Latch_ptr = ^Latch; -{$endif} - -type - my_coef_ptr = ^my_coef_controller; - my_coef_controller = record - pub : jpeg_d_coef_controller; { public fields } - - { These variables keep track of the current location of the input side. } - { cinfo^.input_iMCU_row is also used for this. } - MCU_ctr : JDIMENSION; { counts MCUs processed in current row } - MCU_vert_offset : int; { counts MCU rows within iMCU row } - MCU_rows_per_iMCU_row : int; { number of such rows needed } - - { The output side's location is represented by cinfo^.output_iMCU_row. } - - { In single-pass modes, it's sufficient to buffer just one MCU. - We allocate a workspace of D_MAX_BLOCKS_IN_MCU coefficient blocks, - and let the entropy decoder write into that workspace each time. - (On 80x86, the workspace is FAR even though it's not really very big; - this is to keep the module interfaces unchanged when a large coefficient - buffer is necessary.) - In multi-pass modes, this array points to the current MCU's blocks - within the virtual arrays; it is used only by the input side. } - - MCU_buffer : array[0..D_MAX_BLOCKS_IN_MCU-1] of JBLOCKROW; - - {$ifdef D_MULTISCAN_FILES_SUPPORTED} - { In multi-pass modes, we need a virtual block array for each component. } - whole_image : jvirt_barray_tbl; - {$endif} - - {$ifdef BLOCK_SMOOTHING_SUPPORTED} - { When doing block smoothing, we latch coefficient Al values here } - coef_bits_latch : Latch_Ptr; - {$endif} - end; - -{ Forward declarations } -{METHODDEF} -function decompress_onepass (cinfo : j_decompress_ptr; - output_buf : JSAMPIMAGE) : int; forward; -{$ifdef D_MULTISCAN_FILES_SUPPORTED} -{METHODDEF} -function decompress_data (cinfo : j_decompress_ptr; - output_buf : JSAMPIMAGE) : int; forward; -{$endif} -{$ifdef BLOCK_SMOOTHING_SUPPORTED} -{LOCAL} -function smoothing_ok (cinfo : j_decompress_ptr) : boolean; forward; - -{METHODDEF} -function decompress_smooth_data (cinfo : j_decompress_ptr; - output_buf : JSAMPIMAGE) : int; forward; -{$endif} - - -{LOCAL} -procedure start_iMCU_row (cinfo : j_decompress_ptr); -{ Reset within-iMCU-row counters for a new row (input side) } -var - coef : my_coef_ptr; -begin - coef := my_coef_ptr (cinfo^.coef); - - { In an interleaved scan, an MCU row is the same as an iMCU row. - In a noninterleaved scan, an iMCU row has v_samp_factor MCU rows. - But at the bottom of the image, process only what's left. } - - if (cinfo^.comps_in_scan > 1) then - begin - coef^.MCU_rows_per_iMCU_row := 1; - end - else - begin - if (cinfo^.input_iMCU_row < (cinfo^.total_iMCU_rows-1)) then - coef^.MCU_rows_per_iMCU_row := cinfo^.cur_comp_info[0]^.v_samp_factor - else - coef^.MCU_rows_per_iMCU_row := cinfo^.cur_comp_info[0]^.last_row_height; - end; - - coef^.MCU_ctr := 0; - coef^.MCU_vert_offset := 0; -end; - - -{ Initialize for an input processing pass. } - -{METHODDEF} -procedure start_input_pass (cinfo : j_decompress_ptr); -begin - cinfo^.input_iMCU_row := 0; - start_iMCU_row(cinfo); -end; - - -{ Initialize for an output processing pass. } - -{METHODDEF} -procedure start_output_pass (cinfo : j_decompress_ptr); -var - coef : my_coef_ptr; -begin -{$ifdef BLOCK_SMOOTHING_SUPPORTED} - coef := my_coef_ptr (cinfo^.coef); - - { If multipass, check to see whether to use block smoothing on this pass } - if (coef^.pub.coef_arrays <> NIL) then - begin - if (cinfo^.do_block_smoothing) and smoothing_ok(cinfo) then - coef^.pub.decompress_data := decompress_smooth_data - else - coef^.pub.decompress_data := decompress_data; - end; -{$endif} - cinfo^.output_iMCU_row := 0; -end; - - -{ Decompress and return some data in the single-pass case. - Always attempts to emit one fully interleaved MCU row ("iMCU" row). - Input and output must run in lockstep since we have only a one-MCU buffer. - Return value is JPEG_ROW_COMPLETED, JPEG_SCAN_COMPLETED, or JPEG_SUSPENDED. - - NB: output_buf contains a plane for each component in image, - which we index according to the component's SOF position.} - -{METHODDEF} -function decompress_onepass (cinfo : j_decompress_ptr; - output_buf : JSAMPIMAGE) : int; -var - coef : my_coef_ptr; - MCU_col_num : JDIMENSION; { index of current MCU within row } - last_MCU_col : JDIMENSION; - last_iMCU_row : JDIMENSION; - blkn, ci, xindex, yindex, yoffset, useful_width : int; - output_ptr : JSAMPARRAY; - start_col, output_col : JDIMENSION; - compptr : jpeg_component_info_ptr; - inverse_DCT : inverse_DCT_method_ptr; -begin - coef := my_coef_ptr (cinfo^.coef); - last_MCU_col := cinfo^.MCUs_per_row - 1; - last_iMCU_row := cinfo^.total_iMCU_rows - 1; - - { Loop to process as much as one whole iMCU row } - for yoffset := coef^.MCU_vert_offset to pred(coef^.MCU_rows_per_iMCU_row) do - begin - for MCU_col_num := coef^.MCU_ctr to last_MCU_col do - begin - { Try to fetch an MCU. Entropy decoder expects buffer to be zeroed. } - jzero_far( coef^.MCU_buffer[0], - size_t (cinfo^.blocks_in_MCU * SIZEOF(JBLOCK))); - if (not cinfo^.entropy^.decode_mcu (cinfo, coef^.MCU_buffer)) then - begin - { Suspension forced; update state counters and exit } - coef^.MCU_vert_offset := yoffset; - coef^.MCU_ctr := MCU_col_num; - decompress_onepass := JPEG_SUSPENDED; - exit; - end; - { Determine where data should go in output_buf and do the IDCT thing. - We skip dummy blocks at the right and bottom edges (but blkn gets - incremented past them!). Note the inner loop relies on having - allocated the MCU_buffer[] blocks sequentially. } - - blkn := 0; { index of current DCT block within MCU } - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - { Don't bother to IDCT an uninteresting component. } - if (not compptr^.component_needed) then - begin - Inc(blkn, compptr^.MCU_blocks); - continue; - end; - inverse_DCT := cinfo^.idct^.inverse_DCT[compptr^.component_index]; - if (MCU_col_num < last_MCU_col) then - useful_width := compptr^.MCU_width - else - useful_width := compptr^.last_col_width; - - output_ptr := JSAMPARRAY(@ output_buf^[compptr^.component_index]^ - [yoffset * compptr^.DCT_scaled_size]); - start_col := LongInt(MCU_col_num) * compptr^.MCU_sample_width; - for yindex := 0 to pred(compptr^.MCU_height) do - begin - if (cinfo^.input_iMCU_row < last_iMCU_row) or - (yoffset+yindex < compptr^.last_row_height) then - begin - output_col := start_col; - for xindex := 0 to pred(useful_width) do - begin - inverse_DCT (cinfo, compptr, - JCOEFPTR(coef^.MCU_buffer[blkn+xindex]), - output_ptr, output_col); - Inc(output_col, compptr^.DCT_scaled_size); - end; - end; - Inc(blkn, compptr^.MCU_width); - Inc(JSAMPROW_PTR(output_ptr), compptr^.DCT_scaled_size); - end; - end; - end; - { Completed an MCU row, but perhaps not an iMCU row } - coef^.MCU_ctr := 0; - end; - { Completed the iMCU row, advance counters for next one } - Inc(cinfo^.output_iMCU_row); - - Inc(cinfo^.input_iMCU_row); - if (cinfo^.input_iMCU_row < cinfo^.total_iMCU_rows) then - begin - start_iMCU_row(cinfo); - decompress_onepass := JPEG_ROW_COMPLETED; - exit; - end; - { Completed the scan } - cinfo^.inputctl^.finish_input_pass (cinfo); - decompress_onepass := JPEG_SCAN_COMPLETED; -end; - -{ Dummy consume-input routine for single-pass operation. } - -{METHODDEF} -function dummy_consume_data (cinfo : j_decompress_ptr) : int; -begin - dummy_consume_data := JPEG_SUSPENDED; { Always indicate nothing was done } -end; - - -{$ifdef D_MULTISCAN_FILES_SUPPORTED} - -{ Consume input data and store it in the full-image coefficient buffer. - We read as much as one fully interleaved MCU row ("iMCU" row) per call, - ie, v_samp_factor block rows for each component in the scan. - Return value is JPEG_ROW_COMPLETED, JPEG_SCAN_COMPLETED, or JPEG_SUSPENDED.} - -{METHODDEF} -function consume_data (cinfo : j_decompress_ptr) : int; -var - coef : my_coef_ptr; - MCU_col_num : JDIMENSION; { index of current MCU within row } - blkn, ci, xindex, yindex, yoffset : int; - start_col : JDIMENSION; - buffer : array[0..MAX_COMPS_IN_SCAN-1] of JBLOCKARRAY; - buffer_ptr : JBLOCKROW; - compptr : jpeg_component_info_ptr; -begin - coef := my_coef_ptr (cinfo^.coef); - - { Align the virtual buffers for the components used in this scan. } - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - buffer[ci] := cinfo^.mem^.access_virt_barray - (j_common_ptr (cinfo), coef^.whole_image[compptr^.component_index], - LongInt(cinfo^.input_iMCU_row) * compptr^.v_samp_factor, - JDIMENSION (compptr^.v_samp_factor), TRUE); - { Note: entropy decoder expects buffer to be zeroed, - but this is handled automatically by the memory manager - because we requested a pre-zeroed array. } - - end; - - { Loop to process one whole iMCU row } - for yoffset := coef^.MCU_vert_offset to pred(coef^.MCU_rows_per_iMCU_row) do - begin - for MCU_col_num := coef^.MCU_ctr to pred(cinfo^.MCUs_per_row) do - begin - { Construct list of pointers to DCT blocks belonging to this MCU } - blkn := 0; { index of current DCT block within MCU } - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - start_col := LongInt(MCU_col_num) * compptr^.MCU_width; - for yindex := 0 to pred(compptr^.MCU_height) do - begin - buffer_ptr := JBLOCKROW(@ buffer[ci]^[yindex+yoffset]^[start_col]); - for xindex := 0 to pred(compptr^.MCU_width) do - begin - coef^.MCU_buffer[blkn] := buffer_ptr; - Inc(blkn); - Inc(JBLOCK_PTR(buffer_ptr)); - end; - end; - end; - { Try to fetch the MCU. } - if (not cinfo^.entropy^.decode_mcu (cinfo, coef^.MCU_buffer)) then - begin - { Suspension forced; update state counters and exit } - coef^.MCU_vert_offset := yoffset; - coef^.MCU_ctr := MCU_col_num; - consume_data := JPEG_SUSPENDED; - exit; - end; - end; - { Completed an MCU row, but perhaps not an iMCU row } - coef^.MCU_ctr := 0; - end; - { Completed the iMCU row, advance counters for next one } - Inc(cinfo^.input_iMCU_row); - if (cinfo^.input_iMCU_row < cinfo^.total_iMCU_rows) then - begin - start_iMCU_row(cinfo); - consume_data := JPEG_ROW_COMPLETED; - exit; - end; - { Completed the scan } - cinfo^.inputctl^.finish_input_pass (cinfo); - consume_data := JPEG_SCAN_COMPLETED; -end; - - -{ Decompress and return some data in the multi-pass case. - Always attempts to emit one fully interleaved MCU row ("iMCU" row). - Return value is JPEG_ROW_COMPLETED, JPEG_SCAN_COMPLETED, or JPEG_SUSPENDED. - - NB: output_buf contains a plane for each component in image. } - -{METHODDEF} -function decompress_data (cinfo : j_decompress_ptr; - output_buf : JSAMPIMAGE) : int; -var - coef : my_coef_ptr; - last_iMCU_row : JDIMENSION; - block_num : JDIMENSION; - ci, block_row, block_rows : int; - buffer : JBLOCKARRAY; - buffer_ptr : JBLOCKROW; - output_ptr : JSAMPARRAY; - output_col : JDIMENSION; - compptr : jpeg_component_info_ptr; - inverse_DCT : inverse_DCT_method_ptr; -begin - coef := my_coef_ptr (cinfo^.coef); - last_iMCU_row := cinfo^.total_iMCU_rows - 1; - - { Force some input to be done if we are getting ahead of the input. } - while (cinfo^.input_scan_number < cinfo^.output_scan_number) or - ((cinfo^.input_scan_number = cinfo^.output_scan_number) and - (LongInt(cinfo^.input_iMCU_row) <= cinfo^.output_iMCU_row)) do - begin - if (cinfo^.inputctl^.consume_input(cinfo) = JPEG_SUSPENDED) then - begin - decompress_data := JPEG_SUSPENDED; - exit; - end; - end; - - { OK, output from the virtual arrays. } - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - { Don't bother to IDCT an uninteresting component. } - if (not compptr^.component_needed) then - continue; - { Align the virtual buffer for this component. } - buffer := cinfo^.mem^.access_virt_barray - (j_common_ptr (cinfo), coef^.whole_image[ci], - cinfo^.output_iMCU_row * compptr^.v_samp_factor, - JDIMENSION (compptr^.v_samp_factor), FALSE); - { Count non-dummy DCT block rows in this iMCU row. } - if (cinfo^.output_iMCU_row < LongInt(last_iMCU_row)) then - block_rows := compptr^.v_samp_factor - else - begin - { NB: can't use last_row_height here; it is input-side-dependent! } - block_rows := int(LongInt(compptr^.height_in_blocks) mod compptr^.v_samp_factor); - if (block_rows = 0) then - block_rows := compptr^.v_samp_factor; - end; - inverse_DCT := cinfo^.idct^.inverse_DCT[ci]; - output_ptr := output_buf^[ci]; - { Loop over all DCT blocks to be processed. } - for block_row := 0 to pred(block_rows) do - begin - buffer_ptr := buffer^[block_row]; - output_col := 0; - for block_num := 0 to pred(compptr^.width_in_blocks) do - begin - inverse_DCT (cinfo, compptr, JCOEFPTR (buffer_ptr), - output_ptr, output_col); - Inc(JBLOCK_PTR(buffer_ptr)); - Inc(output_col, compptr^.DCT_scaled_size); - end; - Inc(JSAMPROW_PTR(output_ptr), compptr^.DCT_scaled_size); - end; - Inc(compptr); - end; - - Inc(cinfo^.output_iMCU_row); - if (cinfo^.output_iMCU_row < LongInt(cinfo^.total_iMCU_rows)) then - begin - decompress_data := JPEG_ROW_COMPLETED; - exit; - end; - decompress_data := JPEG_SCAN_COMPLETED; -end; - -{$endif} { D_MULTISCAN_FILES_SUPPORTED } - - -{$ifdef BLOCK_SMOOTHING_SUPPORTED} - -{ This code applies interblock smoothing as described by section K.8 - of the JPEG standard: the first 5 AC coefficients are estimated from - the DC values of a DCT block and its 8 neighboring blocks. - We apply smoothing only for progressive JPEG decoding, and only if - the coefficients it can estimate are not yet known to full precision. } - -{ Natural-order array positions of the first 5 zigzag-order coefficients } -const - Q01_POS = 1; - Q10_POS = 8; - Q20_POS = 16; - Q11_POS = 9; - Q02_POS = 2; - -{ Determine whether block smoothing is applicable and safe. - We also latch the current states of the coef_bits[] entries for the - AC coefficients; otherwise, if the input side of the decompressor - advances into a new scan, we might think the coefficients are known - more accurately than they really are. } - -{LOCAL} -function smoothing_ok (cinfo : j_decompress_ptr) : boolean; -var - coef : my_coef_ptr; - smoothing_useful : boolean; - ci, coefi : int; - compptr : jpeg_component_info_ptr; - qtable : JQUANT_TBL_PTR; - coef_bits : coef_bits_ptr; - coef_bits_latch : Latch_Ptr; -begin - coef := my_coef_ptr (cinfo^.coef); - smoothing_useful := FALSE; - - if (not cinfo^.progressive_mode) or (cinfo^.coef_bits = NIL) then - begin - smoothing_ok := FALSE; - exit; - end; - - { Allocate latch area if not already done } - if (coef^.coef_bits_latch = NIL) then - coef^.coef_bits_latch := Latch_Ptr( - cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE, - cinfo^.num_components * - (SAVED_COEFS * SIZEOF(int))) ); - coef_bits_latch := (coef^.coef_bits_latch); - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - { All components' quantization values must already be latched. } - qtable := compptr^.quant_table; - if (qtable = NIL) then - begin - smoothing_ok := FALSE; - exit; - end; - { Verify DC & first 5 AC quantizers are nonzero to avoid zero-divide. } - if (qtable^.quantval[0] = 0) or - (qtable^.quantval[Q01_POS] = 0) or - (qtable^.quantval[Q10_POS] = 0) or - (qtable^.quantval[Q20_POS] = 0) or - (qtable^.quantval[Q11_POS] = 0) or - (qtable^.quantval[Q02_POS] = 0) then - begin - smoothing_ok := FALSE; - exit; - end; - { DC values must be at least partly known for all components. } - coef_bits := @cinfo^.coef_bits^[ci]; { Nomssi } - if (coef_bits^[0] < 0) then - begin - smoothing_ok := FALSE; - exit; - end; - { Block smoothing is helpful if some AC coefficients remain inaccurate. } - for coefi := 1 to 5 do - begin - coef_bits_latch^[coefi] := coef_bits^[coefi]; - if (coef_bits^[coefi] <> 0) then - smoothing_useful := TRUE; - end; - Inc(coef_bits_latch {SAVED_COEFS}); - Inc(compptr); - end; - - smoothing_ok := smoothing_useful; -end; - - -{ Variant of decompress_data for use when doing block smoothing. } - -{METHODDEF} -function decompress_smooth_data (cinfo : j_decompress_ptr; - output_buf : JSAMPIMAGE) : int; -var - coef : my_coef_ptr; - last_iMCU_row : JDIMENSION; - block_num, last_block_column : JDIMENSION; - ci, block_row, block_rows, access_rows : int; - buffer : JBLOCKARRAY; - buffer_ptr, prev_block_row, next_block_row : JBLOCKROW; - output_ptr : JSAMPARRAY; - output_col : JDIMENSION; - compptr : jpeg_component_info_ptr; - inverse_DCT : inverse_DCT_method_ptr; - first_row, last_row : boolean; - workspace : JBLOCK; - coef_bits : Latch_Ptr; { coef_bits_ptr; } - quanttbl : JQUANT_TBL_PTR; - Q00,Q01,Q02,Q10,Q11,Q20, num : INT32; - DC1,DC2,DC3,DC4,DC5,DC6,DC7,DC8,DC9 : int; - Al, pred : int; -var - delta : JDIMENSION; -begin - coef := my_coef_ptr (cinfo^.coef); - last_iMCU_row := cinfo^.total_iMCU_rows - 1; - - { Force some input to be done if we are getting ahead of the input. } - while (cinfo^.input_scan_number <= cinfo^.output_scan_number) and - (not cinfo^.inputctl^.eoi_reached) do - begin - if (cinfo^.input_scan_number = cinfo^.output_scan_number) then - begin - { If input is working on current scan, we ordinarily want it to - have completed the current row. But if input scan is DC, - we want it to keep one row ahead so that next block row's DC - values are up to date. } - - if (cinfo^.Ss = 0) then - delta := 1 - else - delta := 0; - if (LongInt(cinfo^.input_iMCU_row) > cinfo^.output_iMCU_row+LongInt(delta)) then - break; - end; - if (cinfo^.inputctl^.consume_input(cinfo) = JPEG_SUSPENDED) then - begin - decompress_smooth_data := JPEG_SUSPENDED; - exit; - end; - end; - - { OK, output from the virtual arrays. } - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to (cinfo^.num_components-1) do - begin - { Don't bother to IDCT an uninteresting component. } - if (not compptr^.component_needed) then - continue; - { Count non-dummy DCT block rows in this iMCU row. } - if (cinfo^.output_iMCU_row < LongInt(last_iMCU_row)) then - begin - block_rows := compptr^.v_samp_factor; - access_rows := block_rows * 2; { this and next iMCU row } - last_row := FALSE; - end - else - begin - { NB: can't use last_row_height here; it is input-side-dependent! } - block_rows := int (compptr^.height_in_blocks) mod compptr^.v_samp_factor; - if (block_rows = 0) then - block_rows := compptr^.v_samp_factor; - access_rows := block_rows; { this iMCU row only } - last_row := TRUE; - end; - { Align the virtual buffer for this component. } - if (cinfo^.output_iMCU_row > 0) then - begin - Inc(access_rows, compptr^.v_samp_factor); { prior iMCU row too } - buffer := cinfo^.mem^.access_virt_barray - (j_common_ptr (cinfo), coef^.whole_image[ci], - (cinfo^.output_iMCU_row - 1) * compptr^.v_samp_factor, - JDIMENSION (access_rows), FALSE); - Inc(JBLOCKROW_PTR(buffer), compptr^.v_samp_factor); { point to current iMCU row } - first_row := FALSE; - end - else - begin - buffer := cinfo^.mem^.access_virt_barray - (j_common_ptr (cinfo), coef^.whole_image[ci], - JDIMENSION (0), JDIMENSION (access_rows), FALSE); - first_row := TRUE; - end; - { Fetch component-dependent info } - coef_bits := coef^.coef_bits_latch; - Inc(coef_bits, ci); { ci * SAVED_COEFS} - quanttbl := compptr^.quant_table; - Q00 := quanttbl^.quantval[0]; - Q01 := quanttbl^.quantval[Q01_POS]; - Q10 := quanttbl^.quantval[Q10_POS]; - Q20 := quanttbl^.quantval[Q20_POS]; - Q11 := quanttbl^.quantval[Q11_POS]; - Q02 := quanttbl^.quantval[Q02_POS]; - inverse_DCT := cinfo^.idct^.inverse_DCT[ci]; - output_ptr := output_buf^[ci]; - { Loop over all DCT blocks to be processed. } - for block_row := 0 to (block_rows-1) do - begin - buffer_ptr := buffer^[block_row]; - if (first_row) and (block_row = 0) then - prev_block_row := buffer_ptr - else - prev_block_row := buffer^[block_row-1]; - if (last_row) and (block_row = block_rows-1) then - next_block_row := buffer_ptr - else - next_block_row := buffer^[block_row+1]; - { We fetch the surrounding DC values using a sliding-register approach. - Initialize all nine here so as to do the right thing on narrow pics.} - - DC3 := int(prev_block_row^[0][0]); - DC2 := DC3; - DC1 := DC2; - DC6 := int(buffer_ptr^[0][0]); - DC5 := DC6; - DC4 := DC5; - DC9 := int(next_block_row^[0][0]); - DC8 := DC9; - DC7 := DC8 ; - output_col := 0; - last_block_column := compptr^.width_in_blocks - 1; - for block_num := 0 to last_block_column do - begin - { Fetch current DCT block into workspace so we can modify it. } - jcopy_block_row(buffer_ptr, JBLOCKROW (@workspace), JDIMENSION(1)); - { Update DC values } - if (block_num < last_block_column) then - begin - DC3 := int (prev_block_row^[1][0]); - DC6 := int (buffer_ptr^[1][0]); - DC9 := int (next_block_row^[1][0]); - end; - { Compute coefficient estimates per K.8. - An estimate is applied only if coefficient is still zero, - and is not known to be fully accurate. } - - { AC01 } - Al := coef_bits^[1]; - if (Al <> 0) and (workspace[1] = 0) then - begin - num := 36 * Q00 * (DC4 - DC6); - if (num >= 0) then - begin - pred := int (((Q01 shl 7) + num) div (Q01 shl 8)); - if (Al > 0) and (pred >= (1 shl Al)) then - pred := (1 shl Al)-1; - end - else - begin - pred := int (((Q01 shl 7) - num) div (Q01 shl 8)); - if (Al > 0) and (pred >= (1 shl Al)) then - pred := (1 shl Al)-1; - pred := -pred; - end; - workspace[1] := JCOEF (pred); - end; - { AC10 } - Al := coef_bits^[2]; - if (Al <> 0) and (workspace[8] = 0) then - begin - num := 36 * Q00 * (DC2 - DC8); - if (num >= 0) then - begin - pred := int (((Q10 shl 7) + num) div (Q10 shl 8)); - if (Al > 0) and (pred >= (1 shl Al)) then - pred := (1 shl Al)-1; - end - else - begin - pred := int (((Q10 shl 7) - num) div (Q10 shl 8)); - if (Al > 0) and (pred >= (1 shl Al)) then - pred := (1 shl Al)-1; - pred := -pred; - end; - workspace[8] := JCOEF (pred); - end; - { AC20 } - Al := coef_bits^[3]; - if (Al <> 0) and (workspace[16] = 0) then - begin - num := 9 * Q00 * (DC2 + DC8 - 2*DC5); - if (num >= 0) then - begin - pred := int (((Q20 shl 7) + num) div (Q20 shl 8)); - if (Al > 0) and (pred >= (1 shl Al)) then - pred := (1 shl Al)-1; - end - else - begin - pred := int (((Q20 shl 7) - num) div (Q20 shl 8)); - if (Al > 0) and (pred >= (1 shl Al)) then - pred := (1 shl Al)-1; - pred := -pred; - end; - workspace[16] := JCOEF (pred); - end; - { AC11 } - Al := coef_bits^[4]; - if (Al <> 0) and (workspace[9] = 0) then - begin - num := 5 * Q00 * (DC1 - DC3 - DC7 + DC9); - if (num >= 0) then - begin - pred := int (((Q11 shl 7) + num) div (Q11 shl 8)); - if (Al > 0) and (pred >= (1 shl Al)) then - pred := (1 shl Al)-1; - end - else - begin - pred := int (((Q11 shl 7) - num) div (Q11 shl 8)); - if (Al > 0) and (pred >= (1 shl Al)) then - pred := (1 shl Al)-1; - pred := -pred; - end; - workspace[9] := JCOEF (pred); - end; - { AC02 } - Al := coef_bits^[5]; - if (Al <> 0) and (workspace[2] = 0) then - begin - num := 9 * Q00 * (DC4 + DC6 - 2*DC5); - if (num >= 0) then - begin - pred := int (((Q02 shl 7) + num) div (Q02 shl 8)); - if (Al > 0) and (pred >= (1 shl Al)) then - pred := (1 shl Al)-1; - end - else - begin - pred := int (((Q02 shl 7) - num) div (Q02 shl 8)); - if (Al > 0) and (pred >= (1 shl Al)) then - pred := (1 shl Al)-1; - pred := -pred; - end; - workspace[2] := JCOEF (pred); - end; - { OK, do the IDCT } - inverse_DCT (cinfo, compptr, JCOEFPTR (@workspace), - output_ptr, output_col); - { Advance for next column } - DC1 := DC2; DC2 := DC3; - DC4 := DC5; DC5 := DC6; - DC7 := DC8; DC8 := DC9; - Inc(JBLOCK_PTR(buffer_ptr)); - Inc(JBLOCK_PTR(prev_block_row)); - Inc(JBLOCK_PTR(next_block_row)); - Inc(output_col, compptr^.DCT_scaled_size); - end; - Inc(JSAMPROW_PTR(output_ptr), compptr^.DCT_scaled_size); - end; - Inc(compptr); - end; - - Inc(cinfo^.output_iMCU_row); - if (cinfo^.output_iMCU_row < LongInt(cinfo^.total_iMCU_rows)) then - begin - decompress_smooth_data := JPEG_ROW_COMPLETED; - exit; - end; - decompress_smooth_data := JPEG_SCAN_COMPLETED; -end; - -{$endif} { BLOCK_SMOOTHING_SUPPORTED } - - -{ Initialize coefficient buffer controller. } - -{GLOBAL} -procedure jinit_d_coef_controller (cinfo : j_decompress_ptr; - need_full_buffer : boolean); -var - coef : my_coef_ptr; -{$ifdef D_MULTISCAN_FILES_SUPPORTED} -var - ci, access_rows : int; - compptr : jpeg_component_info_ptr; -{$endif} -var - buffer : JBLOCK_PTR; - i : int; -begin - coef := my_coef_ptr( - cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE, - SIZEOF(my_coef_controller)) ); - cinfo^.coef := jpeg_d_coef_controller_ptr(coef); - coef^.pub.start_input_pass := start_input_pass; - coef^.pub.start_output_pass := start_output_pass; -{$ifdef BLOCK_SMOOTHING_SUPPORTED} - coef^.coef_bits_latch := NIL; -{$endif} - - { Create the coefficient buffer. } - if (need_full_buffer) then - begin -{$ifdef D_MULTISCAN_FILES_SUPPORTED} - { Allocate a full-image virtual array for each component, } - { padded to a multiple of samp_factor DCT blocks in each direction. } - { Note we ask for a pre-zeroed array. } - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - access_rows := compptr^.v_samp_factor; -{$ifdef BLOCK_SMOOTHING_SUPPORTED} - { If block smoothing could be used, need a bigger window } - if (cinfo^.progressive_mode) then - access_rows := access_rows * 3; -{$endif} - coef^.whole_image[ci] := cinfo^.mem^.request_virt_barray - (j_common_ptr (cinfo), JPOOL_IMAGE, TRUE, - JDIMENSION (jround_up( long(compptr^.width_in_blocks), - long(compptr^.h_samp_factor) )), - JDIMENSION (jround_up( long(compptr^.height_in_blocks), - long(compptr^.v_samp_factor) )), - JDIMENSION (access_rows)); - Inc(compptr); - end; - coef^.pub.consume_data := consume_data; - coef^.pub.decompress_data := decompress_data; - coef^.pub.coef_arrays := @(coef^.whole_image); - { link to virtual arrays } -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); -{$endif} - end - else - begin - { We only need a single-MCU buffer. } - buffer := JBLOCK_PTR ( - cinfo^.mem^.alloc_large (j_common_ptr (cinfo), JPOOL_IMAGE, - D_MAX_BLOCKS_IN_MCU * SIZEOF(JBLOCK)) ); - for i := 0 to pred(D_MAX_BLOCKS_IN_MCU) do - begin - coef^.MCU_buffer[i] := JBLOCKROW(buffer); - Inc(buffer); - end; - coef^.pub.consume_data := dummy_consume_data; - coef^.pub.decompress_data := decompress_onepass; - coef^.pub.coef_arrays := NIL; { flag for no virtual arrays } - end; -end; - -end. +unit imjdcoefct; + +{ This file contains the coefficient buffer controller for decompression. + This controller is the top level of the JPEG decompressor proper. + The coefficient buffer lies between entropy decoding and inverse-DCT steps. + + In buffered-image mode, this controller is the interface between + input-oriented processing and output-oriented processing. + Also, the input side (only) is used when reading a file for transcoding. } + +{ Original: jdcoefct.c ; Copyright (C) 1994-1997, Thomas G. Lane. } + +interface + +{$I imjconfig.inc} + +uses + imjmorecfg, + imjinclude, + imjdeferr, + imjerror, + imjutils, + imjpeglib; + +{GLOBAL} +procedure jinit_d_coef_controller (cinfo : j_decompress_ptr; + need_full_buffer : boolean); + + +implementation + + +{ Block smoothing is only applicable for progressive JPEG, so: } +{$ifndef D_PROGRESSIVE_SUPPORTED} +{$undef BLOCK_SMOOTHING_SUPPORTED} +{$endif} + +{ Private buffer controller object } + +{$ifdef BLOCK_SMOOTHING_SUPPORTED} +const + SAVED_COEFS = 6; { we save coef_bits[0..5] } +type + Latch = array[0..SAVED_COEFS-1] of int; + Latch_ptr = ^Latch; +{$endif} + +type + my_coef_ptr = ^my_coef_controller; + my_coef_controller = record + pub : jpeg_d_coef_controller; { public fields } + + { These variables keep track of the current location of the input side. } + { cinfo^.input_iMCU_row is also used for this. } + MCU_ctr : JDIMENSION; { counts MCUs processed in current row } + MCU_vert_offset : int; { counts MCU rows within iMCU row } + MCU_rows_per_iMCU_row : int; { number of such rows needed } + + { The output side's location is represented by cinfo^.output_iMCU_row. } + + { In single-pass modes, it's sufficient to buffer just one MCU. + We allocate a workspace of D_MAX_BLOCKS_IN_MCU coefficient blocks, + and let the entropy decoder write into that workspace each time. + (On 80x86, the workspace is FAR even though it's not really very big; + this is to keep the module interfaces unchanged when a large coefficient + buffer is necessary.) + In multi-pass modes, this array points to the current MCU's blocks + within the virtual arrays; it is used only by the input side. } + + MCU_buffer : array[0..D_MAX_BLOCKS_IN_MCU-1] of JBLOCKROW; + + {$ifdef D_MULTISCAN_FILES_SUPPORTED} + { In multi-pass modes, we need a virtual block array for each component. } + whole_image : jvirt_barray_tbl; + {$endif} + + {$ifdef BLOCK_SMOOTHING_SUPPORTED} + { When doing block smoothing, we latch coefficient Al values here } + coef_bits_latch : Latch_Ptr; + {$endif} + end; + +{ Forward declarations } +{METHODDEF} +function decompress_onepass (cinfo : j_decompress_ptr; + output_buf : JSAMPIMAGE) : int; forward; +{$ifdef D_MULTISCAN_FILES_SUPPORTED} +{METHODDEF} +function decompress_data (cinfo : j_decompress_ptr; + output_buf : JSAMPIMAGE) : int; forward; +{$endif} +{$ifdef BLOCK_SMOOTHING_SUPPORTED} +{LOCAL} +function smoothing_ok (cinfo : j_decompress_ptr) : boolean; forward; + +{METHODDEF} +function decompress_smooth_data (cinfo : j_decompress_ptr; + output_buf : JSAMPIMAGE) : int; forward; +{$endif} + + +{LOCAL} +procedure start_iMCU_row (cinfo : j_decompress_ptr); +{ Reset within-iMCU-row counters for a new row (input side) } +var + coef : my_coef_ptr; +begin + coef := my_coef_ptr (cinfo^.coef); + + { In an interleaved scan, an MCU row is the same as an iMCU row. + In a noninterleaved scan, an iMCU row has v_samp_factor MCU rows. + But at the bottom of the image, process only what's left. } + + if (cinfo^.comps_in_scan > 1) then + begin + coef^.MCU_rows_per_iMCU_row := 1; + end + else + begin + if (cinfo^.input_iMCU_row < (cinfo^.total_iMCU_rows-1)) then + coef^.MCU_rows_per_iMCU_row := cinfo^.cur_comp_info[0]^.v_samp_factor + else + coef^.MCU_rows_per_iMCU_row := cinfo^.cur_comp_info[0]^.last_row_height; + end; + + coef^.MCU_ctr := 0; + coef^.MCU_vert_offset := 0; +end; + + +{ Initialize for an input processing pass. } + +{METHODDEF} +procedure start_input_pass (cinfo : j_decompress_ptr); +begin + cinfo^.input_iMCU_row := 0; + start_iMCU_row(cinfo); +end; + + +{ Initialize for an output processing pass. } + +{METHODDEF} +procedure start_output_pass (cinfo : j_decompress_ptr); +var + coef : my_coef_ptr; +begin +{$ifdef BLOCK_SMOOTHING_SUPPORTED} + coef := my_coef_ptr (cinfo^.coef); + + { If multipass, check to see whether to use block smoothing on this pass } + if (coef^.pub.coef_arrays <> NIL) then + begin + if (cinfo^.do_block_smoothing) and smoothing_ok(cinfo) then + coef^.pub.decompress_data := decompress_smooth_data + else + coef^.pub.decompress_data := decompress_data; + end; +{$endif} + cinfo^.output_iMCU_row := 0; +end; + + +{ Decompress and return some data in the single-pass case. + Always attempts to emit one fully interleaved MCU row ("iMCU" row). + Input and output must run in lockstep since we have only a one-MCU buffer. + Return value is JPEG_ROW_COMPLETED, JPEG_SCAN_COMPLETED, or JPEG_SUSPENDED. + + NB: output_buf contains a plane for each component in image, + which we index according to the component's SOF position.} + +{METHODDEF} +function decompress_onepass (cinfo : j_decompress_ptr; + output_buf : JSAMPIMAGE) : int; +var + coef : my_coef_ptr; + MCU_col_num : JDIMENSION; { index of current MCU within row } + last_MCU_col : JDIMENSION; + last_iMCU_row : JDIMENSION; + blkn, ci, xindex, yindex, yoffset, useful_width : int; + output_ptr : JSAMPARRAY; + start_col, output_col : JDIMENSION; + compptr : jpeg_component_info_ptr; + inverse_DCT : inverse_DCT_method_ptr; +begin + coef := my_coef_ptr (cinfo^.coef); + last_MCU_col := cinfo^.MCUs_per_row - 1; + last_iMCU_row := cinfo^.total_iMCU_rows - 1; + + { Loop to process as much as one whole iMCU row } + for yoffset := coef^.MCU_vert_offset to pred(coef^.MCU_rows_per_iMCU_row) do + begin + for MCU_col_num := coef^.MCU_ctr to last_MCU_col do + begin + { Try to fetch an MCU. Entropy decoder expects buffer to be zeroed. } + jzero_far( coef^.MCU_buffer[0], + size_t (cinfo^.blocks_in_MCU * SIZEOF(JBLOCK))); + if (not cinfo^.entropy^.decode_mcu (cinfo, coef^.MCU_buffer)) then + begin + { Suspension forced; update state counters and exit } + coef^.MCU_vert_offset := yoffset; + coef^.MCU_ctr := MCU_col_num; + decompress_onepass := JPEG_SUSPENDED; + exit; + end; + { Determine where data should go in output_buf and do the IDCT thing. + We skip dummy blocks at the right and bottom edges (but blkn gets + incremented past them!). Note the inner loop relies on having + allocated the MCU_buffer[] blocks sequentially. } + + blkn := 0; { index of current DCT block within MCU } + for ci := 0 to pred(cinfo^.comps_in_scan) do + begin + compptr := cinfo^.cur_comp_info[ci]; + { Don't bother to IDCT an uninteresting component. } + if (not compptr^.component_needed) then + begin + Inc(blkn, compptr^.MCU_blocks); + continue; + end; + inverse_DCT := cinfo^.idct^.inverse_DCT[compptr^.component_index]; + if (MCU_col_num < last_MCU_col) then + useful_width := compptr^.MCU_width + else + useful_width := compptr^.last_col_width; + + output_ptr := JSAMPARRAY(@ output_buf^[compptr^.component_index]^ + [yoffset * compptr^.DCT_scaled_size]); + start_col := LongInt(MCU_col_num) * compptr^.MCU_sample_width; + for yindex := 0 to pred(compptr^.MCU_height) do + begin + if (cinfo^.input_iMCU_row < last_iMCU_row) or + (yoffset+yindex < compptr^.last_row_height) then + begin + output_col := start_col; + for xindex := 0 to pred(useful_width) do + begin + inverse_DCT (cinfo, compptr, + JCOEFPTR(coef^.MCU_buffer[blkn+xindex]), + output_ptr, output_col); + Inc(output_col, compptr^.DCT_scaled_size); + end; + end; + Inc(blkn, compptr^.MCU_width); + Inc(JSAMPROW_PTR(output_ptr), compptr^.DCT_scaled_size); + end; + end; + end; + { Completed an MCU row, but perhaps not an iMCU row } + coef^.MCU_ctr := 0; + end; + { Completed the iMCU row, advance counters for next one } + Inc(cinfo^.output_iMCU_row); + + Inc(cinfo^.input_iMCU_row); + if (cinfo^.input_iMCU_row < cinfo^.total_iMCU_rows) then + begin + start_iMCU_row(cinfo); + decompress_onepass := JPEG_ROW_COMPLETED; + exit; + end; + { Completed the scan } + cinfo^.inputctl^.finish_input_pass (cinfo); + decompress_onepass := JPEG_SCAN_COMPLETED; +end; + +{ Dummy consume-input routine for single-pass operation. } + +{METHODDEF} +function dummy_consume_data (cinfo : j_decompress_ptr) : int; +begin + dummy_consume_data := JPEG_SUSPENDED; { Always indicate nothing was done } +end; + + +{$ifdef D_MULTISCAN_FILES_SUPPORTED} + +{ Consume input data and store it in the full-image coefficient buffer. + We read as much as one fully interleaved MCU row ("iMCU" row) per call, + ie, v_samp_factor block rows for each component in the scan. + Return value is JPEG_ROW_COMPLETED, JPEG_SCAN_COMPLETED, or JPEG_SUSPENDED.} + +{METHODDEF} +function consume_data (cinfo : j_decompress_ptr) : int; +var + coef : my_coef_ptr; + MCU_col_num : JDIMENSION; { index of current MCU within row } + blkn, ci, xindex, yindex, yoffset : int; + start_col : JDIMENSION; + buffer : array[0..MAX_COMPS_IN_SCAN-1] of JBLOCKARRAY; + buffer_ptr : JBLOCKROW; + compptr : jpeg_component_info_ptr; +begin + coef := my_coef_ptr (cinfo^.coef); + + { Align the virtual buffers for the components used in this scan. } + for ci := 0 to pred(cinfo^.comps_in_scan) do + begin + compptr := cinfo^.cur_comp_info[ci]; + buffer[ci] := cinfo^.mem^.access_virt_barray + (j_common_ptr (cinfo), coef^.whole_image[compptr^.component_index], + LongInt(cinfo^.input_iMCU_row) * compptr^.v_samp_factor, + JDIMENSION (compptr^.v_samp_factor), TRUE); + { Note: entropy decoder expects buffer to be zeroed, + but this is handled automatically by the memory manager + because we requested a pre-zeroed array. } + + end; + + { Loop to process one whole iMCU row } + for yoffset := coef^.MCU_vert_offset to pred(coef^.MCU_rows_per_iMCU_row) do + begin + for MCU_col_num := coef^.MCU_ctr to pred(cinfo^.MCUs_per_row) do + begin + { Construct list of pointers to DCT blocks belonging to this MCU } + blkn := 0; { index of current DCT block within MCU } + for ci := 0 to pred(cinfo^.comps_in_scan) do + begin + compptr := cinfo^.cur_comp_info[ci]; + start_col := LongInt(MCU_col_num) * compptr^.MCU_width; + for yindex := 0 to pred(compptr^.MCU_height) do + begin + buffer_ptr := JBLOCKROW(@ buffer[ci]^[yindex+yoffset]^[start_col]); + for xindex := 0 to pred(compptr^.MCU_width) do + begin + coef^.MCU_buffer[blkn] := buffer_ptr; + Inc(blkn); + Inc(JBLOCK_PTR(buffer_ptr)); + end; + end; + end; + { Try to fetch the MCU. } + if (not cinfo^.entropy^.decode_mcu (cinfo, coef^.MCU_buffer)) then + begin + { Suspension forced; update state counters and exit } + coef^.MCU_vert_offset := yoffset; + coef^.MCU_ctr := MCU_col_num; + consume_data := JPEG_SUSPENDED; + exit; + end; + end; + { Completed an MCU row, but perhaps not an iMCU row } + coef^.MCU_ctr := 0; + end; + { Completed the iMCU row, advance counters for next one } + Inc(cinfo^.input_iMCU_row); + if (cinfo^.input_iMCU_row < cinfo^.total_iMCU_rows) then + begin + start_iMCU_row(cinfo); + consume_data := JPEG_ROW_COMPLETED; + exit; + end; + { Completed the scan } + cinfo^.inputctl^.finish_input_pass (cinfo); + consume_data := JPEG_SCAN_COMPLETED; +end; + + +{ Decompress and return some data in the multi-pass case. + Always attempts to emit one fully interleaved MCU row ("iMCU" row). + Return value is JPEG_ROW_COMPLETED, JPEG_SCAN_COMPLETED, or JPEG_SUSPENDED. + + NB: output_buf contains a plane for each component in image. } + +{METHODDEF} +function decompress_data (cinfo : j_decompress_ptr; + output_buf : JSAMPIMAGE) : int; +var + coef : my_coef_ptr; + last_iMCU_row : JDIMENSION; + block_num : JDIMENSION; + ci, block_row, block_rows : int; + buffer : JBLOCKARRAY; + buffer_ptr : JBLOCKROW; + output_ptr : JSAMPARRAY; + output_col : JDIMENSION; + compptr : jpeg_component_info_ptr; + inverse_DCT : inverse_DCT_method_ptr; +begin + coef := my_coef_ptr (cinfo^.coef); + last_iMCU_row := cinfo^.total_iMCU_rows - 1; + + { Force some input to be done if we are getting ahead of the input. } + while (cinfo^.input_scan_number < cinfo^.output_scan_number) or + ((cinfo^.input_scan_number = cinfo^.output_scan_number) and + (LongInt(cinfo^.input_iMCU_row) <= cinfo^.output_iMCU_row)) do + begin + if (cinfo^.inputctl^.consume_input(cinfo) = JPEG_SUSPENDED) then + begin + decompress_data := JPEG_SUSPENDED; + exit; + end; + end; + + { OK, output from the virtual arrays. } + compptr := jpeg_component_info_ptr(cinfo^.comp_info); + for ci := 0 to pred(cinfo^.num_components) do + begin + { Don't bother to IDCT an uninteresting component. } + if (not compptr^.component_needed) then + continue; + { Align the virtual buffer for this component. } + buffer := cinfo^.mem^.access_virt_barray + (j_common_ptr (cinfo), coef^.whole_image[ci], + cinfo^.output_iMCU_row * compptr^.v_samp_factor, + JDIMENSION (compptr^.v_samp_factor), FALSE); + { Count non-dummy DCT block rows in this iMCU row. } + if (cinfo^.output_iMCU_row < LongInt(last_iMCU_row)) then + block_rows := compptr^.v_samp_factor + else + begin + { NB: can't use last_row_height here; it is input-side-dependent! } + block_rows := int(LongInt(compptr^.height_in_blocks) mod compptr^.v_samp_factor); + if (block_rows = 0) then + block_rows := compptr^.v_samp_factor; + end; + inverse_DCT := cinfo^.idct^.inverse_DCT[ci]; + output_ptr := output_buf^[ci]; + { Loop over all DCT blocks to be processed. } + for block_row := 0 to pred(block_rows) do + begin + buffer_ptr := buffer^[block_row]; + output_col := 0; + for block_num := 0 to pred(compptr^.width_in_blocks) do + begin + inverse_DCT (cinfo, compptr, JCOEFPTR (buffer_ptr), + output_ptr, output_col); + Inc(JBLOCK_PTR(buffer_ptr)); + Inc(output_col, compptr^.DCT_scaled_size); + end; + Inc(JSAMPROW_PTR(output_ptr), compptr^.DCT_scaled_size); + end; + Inc(compptr); + end; + + Inc(cinfo^.output_iMCU_row); + if (cinfo^.output_iMCU_row < LongInt(cinfo^.total_iMCU_rows)) then + begin + decompress_data := JPEG_ROW_COMPLETED; + exit; + end; + decompress_data := JPEG_SCAN_COMPLETED; +end; + +{$endif} { D_MULTISCAN_FILES_SUPPORTED } + + +{$ifdef BLOCK_SMOOTHING_SUPPORTED} + +{ This code applies interblock smoothing as described by section K.8 + of the JPEG standard: the first 5 AC coefficients are estimated from + the DC values of a DCT block and its 8 neighboring blocks. + We apply smoothing only for progressive JPEG decoding, and only if + the coefficients it can estimate are not yet known to full precision. } + +{ Natural-order array positions of the first 5 zigzag-order coefficients } +const + Q01_POS = 1; + Q10_POS = 8; + Q20_POS = 16; + Q11_POS = 9; + Q02_POS = 2; + +{ Determine whether block smoothing is applicable and safe. + We also latch the current states of the coef_bits[] entries for the + AC coefficients; otherwise, if the input side of the decompressor + advances into a new scan, we might think the coefficients are known + more accurately than they really are. } + +{LOCAL} +function smoothing_ok (cinfo : j_decompress_ptr) : boolean; +var + coef : my_coef_ptr; + smoothing_useful : boolean; + ci, coefi : int; + compptr : jpeg_component_info_ptr; + qtable : JQUANT_TBL_PTR; + coef_bits : coef_bits_ptr; + coef_bits_latch : Latch_Ptr; +begin + coef := my_coef_ptr (cinfo^.coef); + smoothing_useful := FALSE; + + if (not cinfo^.progressive_mode) or (cinfo^.coef_bits = NIL) then + begin + smoothing_ok := FALSE; + exit; + end; + + { Allocate latch area if not already done } + if (coef^.coef_bits_latch = NIL) then + coef^.coef_bits_latch := Latch_Ptr( + cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE, + cinfo^.num_components * + (SAVED_COEFS * SIZEOF(int))) ); + coef_bits_latch := (coef^.coef_bits_latch); + + compptr := jpeg_component_info_ptr(cinfo^.comp_info); + for ci := 0 to pred(cinfo^.num_components) do + begin + { All components' quantization values must already be latched. } + qtable := compptr^.quant_table; + if (qtable = NIL) then + begin + smoothing_ok := FALSE; + exit; + end; + { Verify DC & first 5 AC quantizers are nonzero to avoid zero-divide. } + if (qtable^.quantval[0] = 0) or + (qtable^.quantval[Q01_POS] = 0) or + (qtable^.quantval[Q10_POS] = 0) or + (qtable^.quantval[Q20_POS] = 0) or + (qtable^.quantval[Q11_POS] = 0) or + (qtable^.quantval[Q02_POS] = 0) then + begin + smoothing_ok := FALSE; + exit; + end; + { DC values must be at least partly known for all components. } + coef_bits := @cinfo^.coef_bits^[ci]; { Nomssi } + if (coef_bits^[0] < 0) then + begin + smoothing_ok := FALSE; + exit; + end; + { Block smoothing is helpful if some AC coefficients remain inaccurate. } + for coefi := 1 to 5 do + begin + coef_bits_latch^[coefi] := coef_bits^[coefi]; + if (coef_bits^[coefi] <> 0) then + smoothing_useful := TRUE; + end; + Inc(coef_bits_latch {SAVED_COEFS}); + Inc(compptr); + end; + + smoothing_ok := smoothing_useful; +end; + + +{ Variant of decompress_data for use when doing block smoothing. } + +{METHODDEF} +function decompress_smooth_data (cinfo : j_decompress_ptr; + output_buf : JSAMPIMAGE) : int; +var + coef : my_coef_ptr; + last_iMCU_row : JDIMENSION; + block_num, last_block_column : JDIMENSION; + ci, block_row, block_rows, access_rows : int; + buffer : JBLOCKARRAY; + buffer_ptr, prev_block_row, next_block_row : JBLOCKROW; + output_ptr : JSAMPARRAY; + output_col : JDIMENSION; + compptr : jpeg_component_info_ptr; + inverse_DCT : inverse_DCT_method_ptr; + first_row, last_row : boolean; + workspace : JBLOCK; + coef_bits : Latch_Ptr; { coef_bits_ptr; } + quanttbl : JQUANT_TBL_PTR; + Q00,Q01,Q02,Q10,Q11,Q20, num : INT32; + DC1,DC2,DC3,DC4,DC5,DC6,DC7,DC8,DC9 : int; + Al, pred : int; +var + delta : JDIMENSION; +begin + coef := my_coef_ptr (cinfo^.coef); + last_iMCU_row := cinfo^.total_iMCU_rows - 1; + + { Force some input to be done if we are getting ahead of the input. } + while (cinfo^.input_scan_number <= cinfo^.output_scan_number) and + (not cinfo^.inputctl^.eoi_reached) do + begin + if (cinfo^.input_scan_number = cinfo^.output_scan_number) then + begin + { If input is working on current scan, we ordinarily want it to + have completed the current row. But if input scan is DC, + we want it to keep one row ahead so that next block row's DC + values are up to date. } + + if (cinfo^.Ss = 0) then + delta := 1 + else + delta := 0; + if (LongInt(cinfo^.input_iMCU_row) > cinfo^.output_iMCU_row+LongInt(delta)) then + break; + end; + if (cinfo^.inputctl^.consume_input(cinfo) = JPEG_SUSPENDED) then + begin + decompress_smooth_data := JPEG_SUSPENDED; + exit; + end; + end; + + { OK, output from the virtual arrays. } + compptr := jpeg_component_info_ptr(cinfo^.comp_info); + for ci := 0 to (cinfo^.num_components-1) do + begin + { Don't bother to IDCT an uninteresting component. } + if (not compptr^.component_needed) then + continue; + { Count non-dummy DCT block rows in this iMCU row. } + if (cinfo^.output_iMCU_row < LongInt(last_iMCU_row)) then + begin + block_rows := compptr^.v_samp_factor; + access_rows := block_rows * 2; { this and next iMCU row } + last_row := FALSE; + end + else + begin + { NB: can't use last_row_height here; it is input-side-dependent! } + block_rows := int (compptr^.height_in_blocks) mod compptr^.v_samp_factor; + if (block_rows = 0) then + block_rows := compptr^.v_samp_factor; + access_rows := block_rows; { this iMCU row only } + last_row := TRUE; + end; + { Align the virtual buffer for this component. } + if (cinfo^.output_iMCU_row > 0) then + begin + Inc(access_rows, compptr^.v_samp_factor); { prior iMCU row too } + buffer := cinfo^.mem^.access_virt_barray + (j_common_ptr (cinfo), coef^.whole_image[ci], + (cinfo^.output_iMCU_row - 1) * compptr^.v_samp_factor, + JDIMENSION (access_rows), FALSE); + Inc(JBLOCKROW_PTR(buffer), compptr^.v_samp_factor); { point to current iMCU row } + first_row := FALSE; + end + else + begin + buffer := cinfo^.mem^.access_virt_barray + (j_common_ptr (cinfo), coef^.whole_image[ci], + JDIMENSION (0), JDIMENSION (access_rows), FALSE); + first_row := TRUE; + end; + { Fetch component-dependent info } + coef_bits := coef^.coef_bits_latch; + Inc(coef_bits, ci); { ci * SAVED_COEFS} + quanttbl := compptr^.quant_table; + Q00 := quanttbl^.quantval[0]; + Q01 := quanttbl^.quantval[Q01_POS]; + Q10 := quanttbl^.quantval[Q10_POS]; + Q20 := quanttbl^.quantval[Q20_POS]; + Q11 := quanttbl^.quantval[Q11_POS]; + Q02 := quanttbl^.quantval[Q02_POS]; + inverse_DCT := cinfo^.idct^.inverse_DCT[ci]; + output_ptr := output_buf^[ci]; + { Loop over all DCT blocks to be processed. } + for block_row := 0 to (block_rows-1) do + begin + buffer_ptr := buffer^[block_row]; + if (first_row) and (block_row = 0) then + prev_block_row := buffer_ptr + else + prev_block_row := buffer^[block_row-1]; + if (last_row) and (block_row = block_rows-1) then + next_block_row := buffer_ptr + else + next_block_row := buffer^[block_row+1]; + { We fetch the surrounding DC values using a sliding-register approach. + Initialize all nine here so as to do the right thing on narrow pics.} + + DC3 := int(prev_block_row^[0][0]); + DC2 := DC3; + DC1 := DC2; + DC6 := int(buffer_ptr^[0][0]); + DC5 := DC6; + DC4 := DC5; + DC9 := int(next_block_row^[0][0]); + DC8 := DC9; + DC7 := DC8 ; + output_col := 0; + last_block_column := compptr^.width_in_blocks - 1; + for block_num := 0 to last_block_column do + begin + { Fetch current DCT block into workspace so we can modify it. } + jcopy_block_row(buffer_ptr, JBLOCKROW (@workspace), JDIMENSION(1)); + { Update DC values } + if (block_num < last_block_column) then + begin + DC3 := int (prev_block_row^[1][0]); + DC6 := int (buffer_ptr^[1][0]); + DC9 := int (next_block_row^[1][0]); + end; + { Compute coefficient estimates per K.8. + An estimate is applied only if coefficient is still zero, + and is not known to be fully accurate. } + + { AC01 } + Al := coef_bits^[1]; + if (Al <> 0) and (workspace[1] = 0) then + begin + num := 36 * Q00 * (DC4 - DC6); + if (num >= 0) then + begin + pred := int (((Q01 shl 7) + num) div (Q01 shl 8)); + if (Al > 0) and (pred >= (1 shl Al)) then + pred := (1 shl Al)-1; + end + else + begin + pred := int (((Q01 shl 7) - num) div (Q01 shl 8)); + if (Al > 0) and (pred >= (1 shl Al)) then + pred := (1 shl Al)-1; + pred := -pred; + end; + workspace[1] := JCOEF (pred); + end; + { AC10 } + Al := coef_bits^[2]; + if (Al <> 0) and (workspace[8] = 0) then + begin + num := 36 * Q00 * (DC2 - DC8); + if (num >= 0) then + begin + pred := int (((Q10 shl 7) + num) div (Q10 shl 8)); + if (Al > 0) and (pred >= (1 shl Al)) then + pred := (1 shl Al)-1; + end + else + begin + pred := int (((Q10 shl 7) - num) div (Q10 shl 8)); + if (Al > 0) and (pred >= (1 shl Al)) then + pred := (1 shl Al)-1; + pred := -pred; + end; + workspace[8] := JCOEF (pred); + end; + { AC20 } + Al := coef_bits^[3]; + if (Al <> 0) and (workspace[16] = 0) then + begin + num := 9 * Q00 * (DC2 + DC8 - 2*DC5); + if (num >= 0) then + begin + pred := int (((Q20 shl 7) + num) div (Q20 shl 8)); + if (Al > 0) and (pred >= (1 shl Al)) then + pred := (1 shl Al)-1; + end + else + begin + pred := int (((Q20 shl 7) - num) div (Q20 shl 8)); + if (Al > 0) and (pred >= (1 shl Al)) then + pred := (1 shl Al)-1; + pred := -pred; + end; + workspace[16] := JCOEF (pred); + end; + { AC11 } + Al := coef_bits^[4]; + if (Al <> 0) and (workspace[9] = 0) then + begin + num := 5 * Q00 * (DC1 - DC3 - DC7 + DC9); + if (num >= 0) then + begin + pred := int (((Q11 shl 7) + num) div (Q11 shl 8)); + if (Al > 0) and (pred >= (1 shl Al)) then + pred := (1 shl Al)-1; + end + else + begin + pred := int (((Q11 shl 7) - num) div (Q11 shl 8)); + if (Al > 0) and (pred >= (1 shl Al)) then + pred := (1 shl Al)-1; + pred := -pred; + end; + workspace[9] := JCOEF (pred); + end; + { AC02 } + Al := coef_bits^[5]; + if (Al <> 0) and (workspace[2] = 0) then + begin + num := 9 * Q00 * (DC4 + DC6 - 2*DC5); + if (num >= 0) then + begin + pred := int (((Q02 shl 7) + num) div (Q02 shl 8)); + if (Al > 0) and (pred >= (1 shl Al)) then + pred := (1 shl Al)-1; + end + else + begin + pred := int (((Q02 shl 7) - num) div (Q02 shl 8)); + if (Al > 0) and (pred >= (1 shl Al)) then + pred := (1 shl Al)-1; + pred := -pred; + end; + workspace[2] := JCOEF (pred); + end; + { OK, do the IDCT } + inverse_DCT (cinfo, compptr, JCOEFPTR (@workspace), + output_ptr, output_col); + { Advance for next column } + DC1 := DC2; DC2 := DC3; + DC4 := DC5; DC5 := DC6; + DC7 := DC8; DC8 := DC9; + Inc(JBLOCK_PTR(buffer_ptr)); + Inc(JBLOCK_PTR(prev_block_row)); + Inc(JBLOCK_PTR(next_block_row)); + Inc(output_col, compptr^.DCT_scaled_size); + end; + Inc(JSAMPROW_PTR(output_ptr), compptr^.DCT_scaled_size); + end; + Inc(compptr); + end; + + Inc(cinfo^.output_iMCU_row); + if (cinfo^.output_iMCU_row < LongInt(cinfo^.total_iMCU_rows)) then + begin + decompress_smooth_data := JPEG_ROW_COMPLETED; + exit; + end; + decompress_smooth_data := JPEG_SCAN_COMPLETED; +end; + +{$endif} { BLOCK_SMOOTHING_SUPPORTED } + + +{ Initialize coefficient buffer controller. } + +{GLOBAL} +procedure jinit_d_coef_controller (cinfo : j_decompress_ptr; + need_full_buffer : boolean); +var + coef : my_coef_ptr; +{$ifdef D_MULTISCAN_FILES_SUPPORTED} +var + ci, access_rows : int; + compptr : jpeg_component_info_ptr; +{$endif} +var + buffer : JBLOCK_PTR; + i : int; +begin + coef := my_coef_ptr( + cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE, + SIZEOF(my_coef_controller)) ); + cinfo^.coef := jpeg_d_coef_controller_ptr(coef); + coef^.pub.start_input_pass := start_input_pass; + coef^.pub.start_output_pass := start_output_pass; +{$ifdef BLOCK_SMOOTHING_SUPPORTED} + coef^.coef_bits_latch := NIL; +{$endif} + + { Create the coefficient buffer. } + if (need_full_buffer) then + begin +{$ifdef D_MULTISCAN_FILES_SUPPORTED} + { Allocate a full-image virtual array for each component, } + { padded to a multiple of samp_factor DCT blocks in each direction. } + { Note we ask for a pre-zeroed array. } + + compptr := jpeg_component_info_ptr(cinfo^.comp_info); + for ci := 0 to pred(cinfo^.num_components) do + begin + access_rows := compptr^.v_samp_factor; +{$ifdef BLOCK_SMOOTHING_SUPPORTED} + { If block smoothing could be used, need a bigger window } + if (cinfo^.progressive_mode) then + access_rows := access_rows * 3; +{$endif} + coef^.whole_image[ci] := cinfo^.mem^.request_virt_barray + (j_common_ptr (cinfo), JPOOL_IMAGE, TRUE, + JDIMENSION (jround_up( long(compptr^.width_in_blocks), + long(compptr^.h_samp_factor) )), + JDIMENSION (jround_up( long(compptr^.height_in_blocks), + long(compptr^.v_samp_factor) )), + JDIMENSION (access_rows)); + Inc(compptr); + end; + coef^.pub.consume_data := consume_data; + coef^.pub.decompress_data := decompress_data; + coef^.pub.coef_arrays := @(coef^.whole_image); + { link to virtual arrays } +{$else} + ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); +{$endif} + end + else + begin + { We only need a single-MCU buffer. } + buffer := JBLOCK_PTR ( + cinfo^.mem^.alloc_large (j_common_ptr (cinfo), JPOOL_IMAGE, + D_MAX_BLOCKS_IN_MCU * SIZEOF(JBLOCK)) ); + for i := 0 to pred(D_MAX_BLOCKS_IN_MCU) do + begin + coef^.MCU_buffer[i] := JBLOCKROW(buffer); + Inc(buffer); + end; + coef^.pub.consume_data := dummy_consume_data; + coef^.pub.decompress_data := decompress_onepass; + coef^.pub.coef_arrays := NIL; { flag for no virtual arrays } + end; +end; + +end. diff --git a/Imaging/JpegLib/imjdcolor.pas b/Imaging/JpegLib/imjdcolor.pas index 2eec9d3..64c5f41 100644 --- a/Imaging/JpegLib/imjdcolor.pas +++ b/Imaging/JpegLib/imjdcolor.pas @@ -1,501 +1,501 @@ -unit imjdcolor; - -{ This file contains output colorspace conversion routines. } - -{ Original: jdcolor.c ; Copyright (C) 1991-1997, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjutils, - imjdeferr, - imjerror, - imjpeglib; - -{ Module initialization routine for output colorspace conversion. } - -{GLOBAL} -procedure jinit_color_deconverter (cinfo : j_decompress_ptr); - -implementation - -{ Private subobject } -type - int_Color_Table = array[0..MAXJSAMPLE+1-1] of int; - int_table_ptr = ^int_Color_Table; - INT32_Color_Table = array[0..MAXJSAMPLE+1-1] of INT32; - INT32_table_ptr = ^INT32_Color_Table; -type - my_cconvert_ptr = ^my_color_deconverter; - my_color_deconverter = record - pub : jpeg_color_deconverter; { public fields } - - { Private state for YCC^.RGB conversion } - Cr_r_tab : int_table_ptr; { => table for Cr to R conversion } - Cb_b_tab : int_table_ptr; { => table for Cb to B conversion } - Cr_g_tab : INT32_table_ptr; { => table for Cr to G conversion } - Cb_g_tab : INT32_table_ptr; { => table for Cb to G conversion } - end; - - - - -{*************** YCbCr ^. RGB conversion: most common case *************} - -{ YCbCr is defined per CCIR 601-1, except that Cb and Cr are - normalized to the range 0..MAXJSAMPLE rather than -0.5 .. 0.5. - The conversion equations to be implemented are therefore - R = Y + 1.40200 * Cr - G = Y - 0.34414 * Cb - 0.71414 * Cr - B = Y + 1.77200 * Cb - where Cb and Cr represent the incoming values less CENTERJSAMPLE. - (These numbers are derived from TIFF 6.0 section 21, dated 3-June-92.) - - To avoid floating-point arithmetic, we represent the fractional constants - as integers scaled up by 2^16 (about 4 digits precision); we have to divide - the products by 2^16, with appropriate rounding, to get the correct answer. - Notice that Y, being an integral input, does not contribute any fraction - so it need not participate in the rounding. - - For even more speed, we avoid doing any multiplications in the inner loop - by precalculating the constants times Cb and Cr for all possible values. - For 8-bit JSAMPLEs this is very reasonable (only 256 entries per table); - for 12-bit samples it is still acceptable. It's not very reasonable for - 16-bit samples, but if you want lossless storage you shouldn't be changing - colorspace anyway. - The Cr=>R and Cb=>B values can be rounded to integers in advance; the - values for the G calculation are left scaled up, since we must add them - together before rounding. } - -const - SCALEBITS = 16; { speediest right-shift on some machines } - ONE_HALF = (INT32(1) shl (SCALEBITS-1)); - - -{ Initialize tables for YCC->RGB colorspace conversion. } - -{LOCAL} -procedure build_ycc_rgb_table (cinfo : j_decompress_ptr); -const - FIX_1_40200 = INT32(Round( 1.40200 * (1 shl SCALEBITS))); - FIX_1_77200 = INT32(Round( 1.77200 * (1 shl SCALEBITS))); - FIX_0_71414 = INT32(Round( 0.71414 * (1 shl SCALEBITS))); - FIX_0_34414 = INT32(Round( 0.34414 * (1 shl SCALEBITS))); - -var - cconvert : my_cconvert_ptr; - i : int; - x : INT32; -var - shift_temp : INT32; -begin - cconvert := my_cconvert_ptr (cinfo^.cconvert); - - - cconvert^.Cr_r_tab := int_table_ptr( - cinfo^.mem^.alloc_small ( j_common_ptr(cinfo), JPOOL_IMAGE, - (MAXJSAMPLE+1) * SIZEOF(int)) ); - cconvert^.Cb_b_tab := int_table_ptr ( - cinfo^.mem^.alloc_small ( j_common_ptr(cinfo), JPOOL_IMAGE, - (MAXJSAMPLE+1) * SIZEOF(int)) ); - cconvert^.Cr_g_tab := INT32_table_ptr ( - cinfo^.mem^.alloc_small ( j_common_ptr(cinfo), JPOOL_IMAGE, - (MAXJSAMPLE+1) * SIZEOF(INT32)) ); - cconvert^.Cb_g_tab := INT32_table_ptr ( - cinfo^.mem^.alloc_small ( j_common_ptr(cinfo), JPOOL_IMAGE, - (MAXJSAMPLE+1) * SIZEOF(INT32)) ); - - - x := -CENTERJSAMPLE; - for i := 0 to MAXJSAMPLE do - begin - { i is the actual input pixel value, in the range 0..MAXJSAMPLE } - { The Cb or Cr value we are thinking of is x := i - CENTERJSAMPLE } - { Cr=>R value is nearest int to 1.40200 * x } - - shift_temp := FIX_1_40200 * x + ONE_HALF; - if shift_temp < 0 then { SHIFT arithmetic RIGHT } - cconvert^.Cr_r_tab^[i] := int((shift_temp shr SCALEBITS) - or ( (not INT32(0)) shl (32-SCALEBITS))) - else - cconvert^.Cr_r_tab^[i] := int(shift_temp shr SCALEBITS); - - { Cb=>B value is nearest int to 1.77200 * x } - shift_temp := FIX_1_77200 * x + ONE_HALF; - if shift_temp < 0 then { SHIFT arithmetic RIGHT } - cconvert^.Cb_b_tab^[i] := int((shift_temp shr SCALEBITS) - or ( (not INT32(0)) shl (32-SCALEBITS))) - else - cconvert^.Cb_b_tab^[i] := int(shift_temp shr SCALEBITS); - - { Cr=>G value is scaled-up -0.71414 * x } - cconvert^.Cr_g_tab^[i] := (- FIX_0_71414 ) * x; - { Cb=>G value is scaled-up -0.34414 * x } - { We also add in ONE_HALF so that need not do it in inner loop } - cconvert^.Cb_g_tab^[i] := (- FIX_0_34414 ) * x + ONE_HALF; - Inc(x); - end; -end; - - -{ Convert some rows of samples to the output colorspace. - - Note that we change from noninterleaved, one-plane-per-component format - to interleaved-pixel format. The output buffer is therefore three times - as wide as the input buffer. - A starting row offset is provided only for the input buffer. The caller - can easily adjust the passed output_buf value to accommodate any row - offset required on that side. } - -{METHODDEF} -procedure ycc_rgb_convert (cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - input_row : JDIMENSION; - output_buf : JSAMPARRAY; - num_rows : int); -var - cconvert : my_cconvert_ptr; - {register} y, cb, cr : int; - {register} outptr : JSAMPROW; - {register} inptr0, inptr1, inptr2 : JSAMPROW; - {register} col : JDIMENSION; - num_cols : JDIMENSION; - { copy these pointers into registers if possible } - {register} range_limit : range_limit_table_ptr; - {register} Crrtab : int_table_ptr; - {register} Cbbtab : int_table_ptr; - {register} Crgtab : INT32_table_ptr; - {register} Cbgtab : INT32_table_ptr; -var - shift_temp : INT32; -begin - cconvert := my_cconvert_ptr (cinfo^.cconvert); - num_cols := cinfo^.output_width; - range_limit := cinfo^.sample_range_limit; - Crrtab := cconvert^.Cr_r_tab; - Cbbtab := cconvert^.Cb_b_tab; - Crgtab := cconvert^.Cr_g_tab; - Cbgtab := cconvert^.Cb_g_tab; - - while (num_rows > 0) do - begin - Dec(num_rows); - inptr0 := input_buf^[0]^[input_row]; - inptr1 := input_buf^[1]^[input_row]; - inptr2 := input_buf^[2]^[input_row]; - Inc(input_row); - outptr := output_buf^[0]; - Inc(JSAMPROW_PTR(output_buf)); - for col := 0 to pred(num_cols) do - begin - y := GETJSAMPLE(inptr0^[col]); - cb := GETJSAMPLE(inptr1^[col]); - cr := GETJSAMPLE(inptr2^[col]); - { Range-limiting is essential due to noise introduced by DCT losses. } - outptr^[RGB_RED] := range_limit^[y + Crrtab^[cr]]; - shift_temp := Cbgtab^[cb] + Crgtab^[cr]; - if shift_temp < 0 then { SHIFT arithmetic RIGHT } - outptr^[RGB_GREEN] := range_limit^[y + int((shift_temp shr SCALEBITS) - or ( (not INT32(0)) shl (32-SCALEBITS)))] - else - outptr^[RGB_GREEN] := range_limit^[y + int(shift_temp shr SCALEBITS)]; - - outptr^[RGB_BLUE] := range_limit^[y + Cbbtab^[cb]]; - Inc(JSAMPLE_PTR(outptr), RGB_PIXELSIZE); - end; - end; -end; - - -{*************** Cases other than YCbCr -> RGB *************} - - -{ Color conversion for no colorspace change: just copy the data, - converting from separate-planes to interleaved representation. } - -{METHODDEF} -procedure null_convert (cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - input_row : JDIMENSION; - output_buf : JSAMPARRAY; - num_rows : int); -var - {register} inptr, - outptr : JSAMPLE_PTR; - {register} count : JDIMENSION; - {register} num_components : int; - num_cols : JDIMENSION; - ci : int; -begin - num_components := cinfo^.num_components; - num_cols := cinfo^.output_width; - - while (num_rows > 0) do - begin - Dec(num_rows); - for ci := 0 to pred(num_components) do - begin - inptr := JSAMPLE_PTR(input_buf^[ci]^[input_row]); - outptr := JSAMPLE_PTR(@(output_buf^[0]^[ci])); - - for count := pred(num_cols) downto 0 do - begin - outptr^ := inptr^; { needn't bother with GETJSAMPLE() here } - Inc(inptr); - Inc(outptr, num_components); - end; - end; - Inc(input_row); - Inc(JSAMPROW_PTR(output_buf)); - end; -end; - - -{ Color conversion for grayscale: just copy the data. - This also works for YCbCr -> grayscale conversion, in which - we just copy the Y (luminance) component and ignore chrominance. } - -{METHODDEF} -procedure grayscale_convert (cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - input_row : JDIMENSION; - output_buf : JSAMPARRAY; - num_rows : int); -begin - jcopy_sample_rows(input_buf^[0], int(input_row), output_buf, 0, - num_rows, cinfo^.output_width); -end; - -{ Convert grayscale to RGB: just duplicate the graylevel three times. - This is provided to support applications that don't want to cope - with grayscale as a separate case. } - -{METHODDEF} -procedure gray_rgb_convert (cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - input_row : JDIMENSION; - output_buf : JSAMPARRAY; - num_rows : int); -var - {register} inptr, outptr : JSAMPLE_PTR; - {register} col : JDIMENSION; - num_cols : JDIMENSION; -begin - num_cols := cinfo^.output_width; - while (num_rows > 0) do - begin - inptr := JSAMPLE_PTR(input_buf^[0]^[input_row]); - Inc(input_row); - outptr := JSAMPLE_PTR(@output_buf^[0]); - Inc(JSAMPROW_PTR(output_buf)); - for col := 0 to pred(num_cols) do - begin - { We can dispense with GETJSAMPLE() here } - JSAMPROW(outptr)^[RGB_RED] := inptr^; - JSAMPROW(outptr)^[RGB_GREEN] := inptr^; - JSAMPROW(outptr)^[RGB_BLUE] := inptr^; - Inc(inptr); - Inc(outptr, RGB_PIXELSIZE); - end; - Dec(num_rows); - end; -end; - - -{ Adobe-style YCCK -> CMYK conversion. - We convert YCbCr to R=1-C, G=1-M, and B=1-Y using the same - conversion as above, while passing K (black) unchanged. - We assume build_ycc_rgb_table has been called. } - -{METHODDEF} -procedure ycck_cmyk_convert (cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - input_row : JDIMENSION; - output_buf : JSAMPARRAY; - num_rows : int); -var - cconvert : my_cconvert_ptr; - {register} y, cb, cr : int; - {register} outptr : JSAMPROW; - {register} inptr0, inptr1, inptr2, inptr3 : JSAMPROW; - {register} col : JDIMENSION; - num_cols : JDIMENSION; - { copy these pointers into registers if possible } - {register} range_limit : range_limit_table_ptr; - {register} Crrtab : int_table_ptr; - {register} Cbbtab : int_table_ptr; - {register} Crgtab : INT32_table_ptr; - {register} Cbgtab : INT32_table_ptr; -var - shift_temp : INT32; -begin - cconvert := my_cconvert_ptr (cinfo^.cconvert); - num_cols := cinfo^.output_width; - { copy these pointers into registers if possible } - range_limit := cinfo^.sample_range_limit; - Crrtab := cconvert^.Cr_r_tab; - Cbbtab := cconvert^.Cb_b_tab; - Crgtab := cconvert^.Cr_g_tab; - Cbgtab := cconvert^.Cb_g_tab; - - while (num_rows > 0) do - begin - Dec(num_rows); - inptr0 := input_buf^[0]^[input_row]; - inptr1 := input_buf^[1]^[input_row]; - inptr2 := input_buf^[2]^[input_row]; - inptr3 := input_buf^[3]^[input_row]; - Inc(input_row); - outptr := output_buf^[0]; - Inc(JSAMPROW_PTR(output_buf)); - for col := 0 to pred(num_cols) do - begin - y := GETJSAMPLE(inptr0^[col]); - cb := GETJSAMPLE(inptr1^[col]); - cr := GETJSAMPLE(inptr2^[col]); - { Range-limiting is essential due to noise introduced by DCT losses. } - outptr^[0] := range_limit^[MAXJSAMPLE - (y + Crrtab^[cr])]; { red } - shift_temp := Cbgtab^[cb] + Crgtab^[cr]; - if shift_temp < 0 then - outptr^[1] := range_limit^[MAXJSAMPLE - (y + int( - (shift_temp shr SCALEBITS) or ((not INT32(0)) shl (32-SCALEBITS)) - ) )] - else - outptr^[1] := range_limit^[MAXJSAMPLE - { green } - (y + int(shift_temp shr SCALEBITS) )]; - outptr^[2] := range_limit^[MAXJSAMPLE - (y + Cbbtab^[cb])]; { blue } - { K passes through unchanged } - outptr^[3] := inptr3^[col]; { don't need GETJSAMPLE here } - Inc(JSAMPLE_PTR(outptr), 4); - end; - end; -end; - - -{ Empty method for start_pass. } - -{METHODDEF} -procedure start_pass_dcolor (cinfo : j_decompress_ptr); -begin - { no work needed } -end; - - -{ Module initialization routine for output colorspace conversion. } - -{GLOBAL} -procedure jinit_color_deconverter (cinfo : j_decompress_ptr); -var - cconvert : my_cconvert_ptr; - ci : int; -begin - cconvert := my_cconvert_ptr ( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_color_deconverter)) ); - cinfo^.cconvert := jpeg_color_deconverter_ptr (cconvert); - cconvert^.pub.start_pass := start_pass_dcolor; - - { Make sure num_components agrees with jpeg_color_space } - case (cinfo^.jpeg_color_space) of - JCS_GRAYSCALE: - if (cinfo^.num_components <> 1) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); - - JCS_RGB, - JCS_YCbCr: - if (cinfo^.num_components <> 3) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); - - JCS_CMYK, - JCS_YCCK: - if (cinfo^.num_components <> 4) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); - - else { JCS_UNKNOWN can be anything } - if (cinfo^.num_components < 1) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); - end; - - { Set out_color_components and conversion method based on requested space. - Also clear the component_needed flags for any unused components, - so that earlier pipeline stages can avoid useless computation. } - - case (cinfo^.out_color_space) of - JCS_GRAYSCALE: - begin - cinfo^.out_color_components := 1; - if (cinfo^.jpeg_color_space = JCS_GRAYSCALE) - or (cinfo^.jpeg_color_space = JCS_YCbCr) then - begin - cconvert^.pub.color_convert := grayscale_convert; - { For color -> grayscale conversion, only the - Y (0) component is needed } - for ci := 1 to pred(cinfo^.num_components) do - cinfo^.comp_info^[ci].component_needed := FALSE; - end - else - ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); - end; - - JCS_RGB: - begin - cinfo^.out_color_components := RGB_PIXELSIZE; - if (cinfo^.jpeg_color_space = JCS_YCbCr) then - begin - cconvert^.pub.color_convert := ycc_rgb_convert; - build_ycc_rgb_table(cinfo); - end - else - if (cinfo^.jpeg_color_space = JCS_GRAYSCALE) then - begin - cconvert^.pub.color_convert := gray_rgb_convert; - end - else - if (cinfo^.jpeg_color_space = JCS_RGB) and (RGB_PIXELSIZE = 3) then - begin - cconvert^.pub.color_convert := null_convert; - end - else - ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); - end; - - JCS_CMYK: - begin - cinfo^.out_color_components := 4; - if (cinfo^.jpeg_color_space = JCS_YCCK) then - begin - cconvert^.pub.color_convert := ycck_cmyk_convert; - build_ycc_rgb_table(cinfo); - end - else - if (cinfo^.jpeg_color_space = JCS_CMYK) then - begin - cconvert^.pub.color_convert := null_convert; - end - else - ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); - end; - - else - begin { Permit null conversion to same output space } - if (cinfo^.out_color_space = cinfo^.jpeg_color_space) then - begin - cinfo^.out_color_components := cinfo^.num_components; - cconvert^.pub.color_convert := null_convert; - end - else { unsupported non-null conversion } - ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); - end; - end; - - if (cinfo^.quantize_colors) then - cinfo^.output_components := 1 { single colormapped output component } - else - cinfo^.output_components := cinfo^.out_color_components; -end; - -end. +unit imjdcolor; + +{ This file contains output colorspace conversion routines. } + +{ Original: jdcolor.c ; Copyright (C) 1991-1997, Thomas G. Lane. } + +interface + +{$I imjconfig.inc} + +uses + imjmorecfg, + imjinclude, + imjutils, + imjdeferr, + imjerror, + imjpeglib; + +{ Module initialization routine for output colorspace conversion. } + +{GLOBAL} +procedure jinit_color_deconverter (cinfo : j_decompress_ptr); + +implementation + +{ Private subobject } +type + int_Color_Table = array[0..MAXJSAMPLE+1-1] of int; + int_table_ptr = ^int_Color_Table; + INT32_Color_Table = array[0..MAXJSAMPLE+1-1] of INT32; + INT32_table_ptr = ^INT32_Color_Table; +type + my_cconvert_ptr = ^my_color_deconverter; + my_color_deconverter = record + pub : jpeg_color_deconverter; { public fields } + + { Private state for YCC^.RGB conversion } + Cr_r_tab : int_table_ptr; { => table for Cr to R conversion } + Cb_b_tab : int_table_ptr; { => table for Cb to B conversion } + Cr_g_tab : INT32_table_ptr; { => table for Cr to G conversion } + Cb_g_tab : INT32_table_ptr; { => table for Cb to G conversion } + end; + + + + +{*************** YCbCr ^. RGB conversion: most common case *************} + +{ YCbCr is defined per CCIR 601-1, except that Cb and Cr are + normalized to the range 0..MAXJSAMPLE rather than -0.5 .. 0.5. + The conversion equations to be implemented are therefore + R = Y + 1.40200 * Cr + G = Y - 0.34414 * Cb - 0.71414 * Cr + B = Y + 1.77200 * Cb + where Cb and Cr represent the incoming values less CENTERJSAMPLE. + (These numbers are derived from TIFF 6.0 section 21, dated 3-June-92.) + + To avoid floating-point arithmetic, we represent the fractional constants + as integers scaled up by 2^16 (about 4 digits precision); we have to divide + the products by 2^16, with appropriate rounding, to get the correct answer. + Notice that Y, being an integral input, does not contribute any fraction + so it need not participate in the rounding. + + For even more speed, we avoid doing any multiplications in the inner loop + by precalculating the constants times Cb and Cr for all possible values. + For 8-bit JSAMPLEs this is very reasonable (only 256 entries per table); + for 12-bit samples it is still acceptable. It's not very reasonable for + 16-bit samples, but if you want lossless storage you shouldn't be changing + colorspace anyway. + The Cr=>R and Cb=>B values can be rounded to integers in advance; the + values for the G calculation are left scaled up, since we must add them + together before rounding. } + +const + SCALEBITS = 16; { speediest right-shift on some machines } + ONE_HALF = (INT32(1) shl (SCALEBITS-1)); + + +{ Initialize tables for YCC->RGB colorspace conversion. } + +{LOCAL} +procedure build_ycc_rgb_table (cinfo : j_decompress_ptr); +const + FIX_1_40200 = INT32(Round( 1.40200 * (1 shl SCALEBITS))); + FIX_1_77200 = INT32(Round( 1.77200 * (1 shl SCALEBITS))); + FIX_0_71414 = INT32(Round( 0.71414 * (1 shl SCALEBITS))); + FIX_0_34414 = INT32(Round( 0.34414 * (1 shl SCALEBITS))); + +var + cconvert : my_cconvert_ptr; + i : int; + x : INT32; +var + shift_temp : INT32; +begin + cconvert := my_cconvert_ptr (cinfo^.cconvert); + + + cconvert^.Cr_r_tab := int_table_ptr( + cinfo^.mem^.alloc_small ( j_common_ptr(cinfo), JPOOL_IMAGE, + (MAXJSAMPLE+1) * SIZEOF(int)) ); + cconvert^.Cb_b_tab := int_table_ptr ( + cinfo^.mem^.alloc_small ( j_common_ptr(cinfo), JPOOL_IMAGE, + (MAXJSAMPLE+1) * SIZEOF(int)) ); + cconvert^.Cr_g_tab := INT32_table_ptr ( + cinfo^.mem^.alloc_small ( j_common_ptr(cinfo), JPOOL_IMAGE, + (MAXJSAMPLE+1) * SIZEOF(INT32)) ); + cconvert^.Cb_g_tab := INT32_table_ptr ( + cinfo^.mem^.alloc_small ( j_common_ptr(cinfo), JPOOL_IMAGE, + (MAXJSAMPLE+1) * SIZEOF(INT32)) ); + + + x := -CENTERJSAMPLE; + for i := 0 to MAXJSAMPLE do + begin + { i is the actual input pixel value, in the range 0..MAXJSAMPLE } + { The Cb or Cr value we are thinking of is x := i - CENTERJSAMPLE } + { Cr=>R value is nearest int to 1.40200 * x } + + shift_temp := FIX_1_40200 * x + ONE_HALF; + if shift_temp < 0 then { SHIFT arithmetic RIGHT } + cconvert^.Cr_r_tab^[i] := int((shift_temp shr SCALEBITS) + or ( (not INT32(0)) shl (32-SCALEBITS))) + else + cconvert^.Cr_r_tab^[i] := int(shift_temp shr SCALEBITS); + + { Cb=>B value is nearest int to 1.77200 * x } + shift_temp := FIX_1_77200 * x + ONE_HALF; + if shift_temp < 0 then { SHIFT arithmetic RIGHT } + cconvert^.Cb_b_tab^[i] := int((shift_temp shr SCALEBITS) + or ( (not INT32(0)) shl (32-SCALEBITS))) + else + cconvert^.Cb_b_tab^[i] := int(shift_temp shr SCALEBITS); + + { Cr=>G value is scaled-up -0.71414 * x } + cconvert^.Cr_g_tab^[i] := (- FIX_0_71414 ) * x; + { Cb=>G value is scaled-up -0.34414 * x } + { We also add in ONE_HALF so that need not do it in inner loop } + cconvert^.Cb_g_tab^[i] := (- FIX_0_34414 ) * x + ONE_HALF; + Inc(x); + end; +end; + + +{ Convert some rows of samples to the output colorspace. + + Note that we change from noninterleaved, one-plane-per-component format + to interleaved-pixel format. The output buffer is therefore three times + as wide as the input buffer. + A starting row offset is provided only for the input buffer. The caller + can easily adjust the passed output_buf value to accommodate any row + offset required on that side. } + +{METHODDEF} +procedure ycc_rgb_convert (cinfo : j_decompress_ptr; + input_buf : JSAMPIMAGE; + input_row : JDIMENSION; + output_buf : JSAMPARRAY; + num_rows : int); +var + cconvert : my_cconvert_ptr; + {register} y, cb, cr : int; + {register} outptr : JSAMPROW; + {register} inptr0, inptr1, inptr2 : JSAMPROW; + {register} col : JDIMENSION; + num_cols : JDIMENSION; + { copy these pointers into registers if possible } + {register} range_limit : range_limit_table_ptr; + {register} Crrtab : int_table_ptr; + {register} Cbbtab : int_table_ptr; + {register} Crgtab : INT32_table_ptr; + {register} Cbgtab : INT32_table_ptr; +var + shift_temp : INT32; +begin + cconvert := my_cconvert_ptr (cinfo^.cconvert); + num_cols := cinfo^.output_width; + range_limit := cinfo^.sample_range_limit; + Crrtab := cconvert^.Cr_r_tab; + Cbbtab := cconvert^.Cb_b_tab; + Crgtab := cconvert^.Cr_g_tab; + Cbgtab := cconvert^.Cb_g_tab; + + while (num_rows > 0) do + begin + Dec(num_rows); + inptr0 := input_buf^[0]^[input_row]; + inptr1 := input_buf^[1]^[input_row]; + inptr2 := input_buf^[2]^[input_row]; + Inc(input_row); + outptr := output_buf^[0]; + Inc(JSAMPROW_PTR(output_buf)); + for col := 0 to pred(num_cols) do + begin + y := GETJSAMPLE(inptr0^[col]); + cb := GETJSAMPLE(inptr1^[col]); + cr := GETJSAMPLE(inptr2^[col]); + { Range-limiting is essential due to noise introduced by DCT losses. } + outptr^[RGB_RED] := range_limit^[y + Crrtab^[cr]]; + shift_temp := Cbgtab^[cb] + Crgtab^[cr]; + if shift_temp < 0 then { SHIFT arithmetic RIGHT } + outptr^[RGB_GREEN] := range_limit^[y + int((shift_temp shr SCALEBITS) + or ( (not INT32(0)) shl (32-SCALEBITS)))] + else + outptr^[RGB_GREEN] := range_limit^[y + int(shift_temp shr SCALEBITS)]; + + outptr^[RGB_BLUE] := range_limit^[y + Cbbtab^[cb]]; + Inc(JSAMPLE_PTR(outptr), RGB_PIXELSIZE); + end; + end; +end; + + +{*************** Cases other than YCbCr -> RGB *************} + + +{ Color conversion for no colorspace change: just copy the data, + converting from separate-planes to interleaved representation. } + +{METHODDEF} +procedure null_convert (cinfo : j_decompress_ptr; + input_buf : JSAMPIMAGE; + input_row : JDIMENSION; + output_buf : JSAMPARRAY; + num_rows : int); +var + {register} inptr, + outptr : JSAMPLE_PTR; + {register} count : JDIMENSION; + {register} num_components : int; + num_cols : JDIMENSION; + ci : int; +begin + num_components := cinfo^.num_components; + num_cols := cinfo^.output_width; + + while (num_rows > 0) do + begin + Dec(num_rows); + for ci := 0 to pred(num_components) do + begin + inptr := JSAMPLE_PTR(input_buf^[ci]^[input_row]); + outptr := JSAMPLE_PTR(@(output_buf^[0]^[ci])); + + for count := pred(num_cols) downto 0 do + begin + outptr^ := inptr^; { needn't bother with GETJSAMPLE() here } + Inc(inptr); + Inc(outptr, num_components); + end; + end; + Inc(input_row); + Inc(JSAMPROW_PTR(output_buf)); + end; +end; + + +{ Color conversion for grayscale: just copy the data. + This also works for YCbCr -> grayscale conversion, in which + we just copy the Y (luminance) component and ignore chrominance. } + +{METHODDEF} +procedure grayscale_convert (cinfo : j_decompress_ptr; + input_buf : JSAMPIMAGE; + input_row : JDIMENSION; + output_buf : JSAMPARRAY; + num_rows : int); +begin + jcopy_sample_rows(input_buf^[0], int(input_row), output_buf, 0, + num_rows, cinfo^.output_width); +end; + +{ Convert grayscale to RGB: just duplicate the graylevel three times. + This is provided to support applications that don't want to cope + with grayscale as a separate case. } + +{METHODDEF} +procedure gray_rgb_convert (cinfo : j_decompress_ptr; + input_buf : JSAMPIMAGE; + input_row : JDIMENSION; + output_buf : JSAMPARRAY; + num_rows : int); +var + {register} inptr, outptr : JSAMPLE_PTR; + {register} col : JDIMENSION; + num_cols : JDIMENSION; +begin + num_cols := cinfo^.output_width; + while (num_rows > 0) do + begin + inptr := JSAMPLE_PTR(input_buf^[0]^[input_row]); + Inc(input_row); + outptr := JSAMPLE_PTR(@output_buf^[0]); + Inc(JSAMPROW_PTR(output_buf)); + for col := 0 to pred(num_cols) do + begin + { We can dispense with GETJSAMPLE() here } + JSAMPROW(outptr)^[RGB_RED] := inptr^; + JSAMPROW(outptr)^[RGB_GREEN] := inptr^; + JSAMPROW(outptr)^[RGB_BLUE] := inptr^; + Inc(inptr); + Inc(outptr, RGB_PIXELSIZE); + end; + Dec(num_rows); + end; +end; + + +{ Adobe-style YCCK -> CMYK conversion. + We convert YCbCr to R=1-C, G=1-M, and B=1-Y using the same + conversion as above, while passing K (black) unchanged. + We assume build_ycc_rgb_table has been called. } + +{METHODDEF} +procedure ycck_cmyk_convert (cinfo : j_decompress_ptr; + input_buf : JSAMPIMAGE; + input_row : JDIMENSION; + output_buf : JSAMPARRAY; + num_rows : int); +var + cconvert : my_cconvert_ptr; + {register} y, cb, cr : int; + {register} outptr : JSAMPROW; + {register} inptr0, inptr1, inptr2, inptr3 : JSAMPROW; + {register} col : JDIMENSION; + num_cols : JDIMENSION; + { copy these pointers into registers if possible } + {register} range_limit : range_limit_table_ptr; + {register} Crrtab : int_table_ptr; + {register} Cbbtab : int_table_ptr; + {register} Crgtab : INT32_table_ptr; + {register} Cbgtab : INT32_table_ptr; +var + shift_temp : INT32; +begin + cconvert := my_cconvert_ptr (cinfo^.cconvert); + num_cols := cinfo^.output_width; + { copy these pointers into registers if possible } + range_limit := cinfo^.sample_range_limit; + Crrtab := cconvert^.Cr_r_tab; + Cbbtab := cconvert^.Cb_b_tab; + Crgtab := cconvert^.Cr_g_tab; + Cbgtab := cconvert^.Cb_g_tab; + + while (num_rows > 0) do + begin + Dec(num_rows); + inptr0 := input_buf^[0]^[input_row]; + inptr1 := input_buf^[1]^[input_row]; + inptr2 := input_buf^[2]^[input_row]; + inptr3 := input_buf^[3]^[input_row]; + Inc(input_row); + outptr := output_buf^[0]; + Inc(JSAMPROW_PTR(output_buf)); + for col := 0 to pred(num_cols) do + begin + y := GETJSAMPLE(inptr0^[col]); + cb := GETJSAMPLE(inptr1^[col]); + cr := GETJSAMPLE(inptr2^[col]); + { Range-limiting is essential due to noise introduced by DCT losses. } + outptr^[0] := range_limit^[MAXJSAMPLE - (y + Crrtab^[cr])]; { red } + shift_temp := Cbgtab^[cb] + Crgtab^[cr]; + if shift_temp < 0 then + outptr^[1] := range_limit^[MAXJSAMPLE - (y + int( + (shift_temp shr SCALEBITS) or ((not INT32(0)) shl (32-SCALEBITS)) + ) )] + else + outptr^[1] := range_limit^[MAXJSAMPLE - { green } + (y + int(shift_temp shr SCALEBITS) )]; + outptr^[2] := range_limit^[MAXJSAMPLE - (y + Cbbtab^[cb])]; { blue } + { K passes through unchanged } + outptr^[3] := inptr3^[col]; { don't need GETJSAMPLE here } + Inc(JSAMPLE_PTR(outptr), 4); + end; + end; +end; + + +{ Empty method for start_pass. } + +{METHODDEF} +procedure start_pass_dcolor (cinfo : j_decompress_ptr); +begin + { no work needed } +end; + + +{ Module initialization routine for output colorspace conversion. } + +{GLOBAL} +procedure jinit_color_deconverter (cinfo : j_decompress_ptr); +var + cconvert : my_cconvert_ptr; + ci : int; +begin + cconvert := my_cconvert_ptr ( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + SIZEOF(my_color_deconverter)) ); + cinfo^.cconvert := jpeg_color_deconverter_ptr (cconvert); + cconvert^.pub.start_pass := start_pass_dcolor; + + { Make sure num_components agrees with jpeg_color_space } + case (cinfo^.jpeg_color_space) of + JCS_GRAYSCALE: + if (cinfo^.num_components <> 1) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); + + JCS_RGB, + JCS_YCbCr: + if (cinfo^.num_components <> 3) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); + + JCS_CMYK, + JCS_YCCK: + if (cinfo^.num_components <> 4) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); + + else { JCS_UNKNOWN can be anything } + if (cinfo^.num_components < 1) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); + end; + + { Set out_color_components and conversion method based on requested space. + Also clear the component_needed flags for any unused components, + so that earlier pipeline stages can avoid useless computation. } + + case (cinfo^.out_color_space) of + JCS_GRAYSCALE: + begin + cinfo^.out_color_components := 1; + if (cinfo^.jpeg_color_space = JCS_GRAYSCALE) + or (cinfo^.jpeg_color_space = JCS_YCbCr) then + begin + cconvert^.pub.color_convert := grayscale_convert; + { For color -> grayscale conversion, only the + Y (0) component is needed } + for ci := 1 to pred(cinfo^.num_components) do + cinfo^.comp_info^[ci].component_needed := FALSE; + end + else + ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); + end; + + JCS_RGB: + begin + cinfo^.out_color_components := RGB_PIXELSIZE; + if (cinfo^.jpeg_color_space = JCS_YCbCr) then + begin + cconvert^.pub.color_convert := ycc_rgb_convert; + build_ycc_rgb_table(cinfo); + end + else + if (cinfo^.jpeg_color_space = JCS_GRAYSCALE) then + begin + cconvert^.pub.color_convert := gray_rgb_convert; + end + else + if (cinfo^.jpeg_color_space = JCS_RGB) and (RGB_PIXELSIZE = 3) then + begin + cconvert^.pub.color_convert := null_convert; + end + else + ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); + end; + + JCS_CMYK: + begin + cinfo^.out_color_components := 4; + if (cinfo^.jpeg_color_space = JCS_YCCK) then + begin + cconvert^.pub.color_convert := ycck_cmyk_convert; + build_ycc_rgb_table(cinfo); + end + else + if (cinfo^.jpeg_color_space = JCS_CMYK) then + begin + cconvert^.pub.color_convert := null_convert; + end + else + ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); + end; + + else + begin { Permit null conversion to same output space } + if (cinfo^.out_color_space = cinfo^.jpeg_color_space) then + begin + cinfo^.out_color_components := cinfo^.num_components; + cconvert^.pub.color_convert := null_convert; + end + else { unsupported non-null conversion } + ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); + end; + end; + + if (cinfo^.quantize_colors) then + cinfo^.output_components := 1 { single colormapped output component } + else + cinfo^.output_components := cinfo^.out_color_components; +end; + +end. diff --git a/Imaging/JpegLib/imjdct.pas b/Imaging/JpegLib/imjdct.pas index 63e83c1..30d3356 100644 --- a/Imaging/JpegLib/imjdct.pas +++ b/Imaging/JpegLib/imjdct.pas @@ -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. diff --git a/Imaging/JpegLib/imjddctmgr.pas b/Imaging/JpegLib/imjddctmgr.pas index 5ae7c1e..5e62b3a 100644 --- a/Imaging/JpegLib/imjddctmgr.pas +++ b/Imaging/JpegLib/imjddctmgr.pas @@ -1,330 +1,330 @@ -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} + +{$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. diff --git a/Imaging/JpegLib/imjdeferr.pas b/Imaging/JpegLib/imjdeferr.pas index 3c960e0..eeaf6f6 100644 --- a/Imaging/JpegLib/imjdeferr.pas +++ b/Imaging/JpegLib/imjdeferr.pas @@ -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. diff --git a/Imaging/JpegLib/imjdhuff.pas b/Imaging/JpegLib/imjdhuff.pas index 1182468..f11485c 100644 --- a/Imaging/JpegLib/imjdhuff.pas +++ b/Imaging/JpegLib/imjdhuff.pas @@ -1,1204 +1,1204 @@ -unit imjdhuff; - -{ This file contains declarations for Huffman entropy decoding routines - that are shared between the sequential decoder (jdhuff.c) and the - progressive decoder (jdphuff.c). No other modules need to see these. } - -{ This file contains Huffman entropy decoding routines. - - Much of the complexity here has to do with supporting input suspension. - If the data source module demands suspension, we want to be able to back - up to the start of the current MCU. To do this, we copy state variables - into local working storage, and update them back to the permanent - storage only upon successful completion of an MCU. } - -{ Original: jdhuff.h+jdhuff.c; Copyright (C) 1991-1997, Thomas G. Lane. } - - - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjdeferr, - imjerror, - imjutils, - imjpeglib; - - -{ Declarations shared with jdphuff.c } - - - -{ Derived data constructed for each Huffman table } - -const - HUFF_LOOKAHEAD = 8; { # of bits of lookahead } - -type - d_derived_tbl_ptr = ^d_derived_tbl; - d_derived_tbl = record - { Basic tables: (element [0] of each array is unused) } - maxcode : array[0..18-1] of INT32; { largest code of length k (-1 if none) } - { (maxcode[17] is a sentinel to ensure jpeg_huff_decode terminates) } - valoffset : array[0..17-1] of INT32; { huffval[] offset for codes of length k } - { valoffset[k] = huffval[] index of 1st symbol of code length k, less - the smallest code of length k; so given a code of length k, the - corresponding symbol is huffval[code + valoffset[k]] } - - { Link to public Huffman table (needed only in jpeg_huff_decode) } - pub : JHUFF_TBL_PTR; - - { Lookahead tables: indexed by the next HUFF_LOOKAHEAD bits of - the input data stream. If the next Huffman code is no more - than HUFF_LOOKAHEAD bits long, we can obtain its length and - the corresponding symbol directly from these tables. } - - look_nbits : array[0..(1 shl HUFF_LOOKAHEAD)-1] of int; - { # bits, or 0 if too long } - look_sym : array[0..(1 shl HUFF_LOOKAHEAD)-1] of UINT8; - { symbol, or unused } - end; - -{ Fetching the next N bits from the input stream is a time-critical operation - for the Huffman decoders. We implement it with a combination of inline - macros and out-of-line subroutines. Note that N (the number of bits - demanded at one time) never exceeds 15 for JPEG use. - - We read source bytes into get_buffer and dole out bits as needed. - If get_buffer already contains enough bits, they are fetched in-line - by the macros CHECK_BIT_BUFFER and GET_BITS. When there aren't enough - bits, jpeg_fill_bit_buffer is called; it will attempt to fill get_buffer - as full as possible (not just to the number of bits needed; this - prefetching reduces the overhead cost of calling jpeg_fill_bit_buffer). - Note that jpeg_fill_bit_buffer may return FALSE to indicate suspension. - On TRUE return, jpeg_fill_bit_buffer guarantees that get_buffer contains - at least the requested number of bits --- dummy zeroes are inserted if - necessary. } - - -type - bit_buf_type = INT32 ; { type of bit-extraction buffer } -const - BIT_BUF_SIZE = 32; { size of buffer in bits } - -{ If long is > 32 bits on your machine, and shifting/masking longs is - reasonably fast, making bit_buf_type be long and setting BIT_BUF_SIZE - appropriately should be a win. Unfortunately we can't define the size - with something like #define BIT_BUF_SIZE (sizeof(bit_buf_type)*8) - because not all machines measure sizeof in 8-bit bytes. } - -type - bitread_perm_state = record { Bitreading state saved across MCUs } - get_buffer : bit_buf_type; { current bit-extraction buffer } - bits_left : int; { # of unused bits in it } - end; - -type - bitread_working_state = record - { Bitreading working state within an MCU } - { current data source location } - { We need a copy, rather than munging the original, in case of suspension } - next_input_byte : JOCTETptr; { => next byte to read from source } - bytes_in_buffer : size_t; { # of bytes remaining in source buffer } - { Bit input buffer --- note these values are kept in register variables, - not in this struct, inside the inner loops. } - - get_buffer : bit_buf_type; { current bit-extraction buffer } - bits_left : int; { # of unused bits in it } - { Pointer needed by jpeg_fill_bit_buffer } - cinfo : j_decompress_ptr; { back link to decompress master record } - end; - -{ Module initialization routine for Huffman entropy decoding. } - -{GLOBAL} -procedure jinit_huff_decoder (cinfo : j_decompress_ptr); - -{GLOBAL} -function jpeg_huff_decode(var state : bitread_working_state; - get_buffer : bit_buf_type; {register} - bits_left : int; {register} - htbl : d_derived_tbl_ptr; - min_bits : int) : int; - -{ Compute the derived values for a Huffman table. - Note this is also used by jdphuff.c. } - -{GLOBAL} -procedure jpeg_make_d_derived_tbl (cinfo : j_decompress_ptr; - isDC : boolean; - tblno : int; - var pdtbl : d_derived_tbl_ptr); - -{ Load up the bit buffer to a depth of at least nbits } - -function jpeg_fill_bit_buffer (var state : bitread_working_state; - get_buffer : bit_buf_type; {register} - bits_left : int; {register} - nbits : int) : boolean; - -implementation - -{$IFDEF MACRO} - -{ Macros to declare and load/save bitread local variables. } -{$define BITREAD_STATE_VARS} - get_buffer : bit_buf_type ; {register} - bits_left : int; {register} - br_state : bitread_working_state; - -{$define BITREAD_LOAD_STATE(cinfop,permstate)} - br_state.cinfo := cinfop; - br_state.next_input_byte := cinfop^.src^.next_input_byte; - br_state.bytes_in_buffer := cinfop^.src^.bytes_in_buffer; - get_buffer := permstate.get_buffer; - bits_left := permstate.bits_left; - -{$define BITREAD_SAVE_STATE(cinfop,permstate) } - cinfop^.src^.next_input_byte := br_state.next_input_byte; - cinfop^.src^.bytes_in_buffer := br_state.bytes_in_buffer; - permstate.get_buffer := get_buffer; - permstate.bits_left := bits_left; - - -{ These macros provide the in-line portion of bit fetching. - Use CHECK_BIT_BUFFER to ensure there are N bits in get_buffer - before using GET_BITS, PEEK_BITS, or DROP_BITS. - The variables get_buffer and bits_left are assumed to be locals, - but the state struct might not be (jpeg_huff_decode needs this). - CHECK_BIT_BUFFER(state,n,action); - Ensure there are N bits in get_buffer; if suspend, take action. - val = GET_BITS(n); - Fetch next N bits. - val = PEEK_BITS(n); - Fetch next N bits without removing them from the buffer. - DROP_BITS(n); - Discard next N bits. - The value N should be a simple variable, not an expression, because it - is evaluated multiple times. } - - -{$define CHECK_BIT_BUFFER(state,nbits,action)} - if (bits_left < (nbits)) then - begin - if (not jpeg_fill_bit_buffer(&(state),get_buffer,bits_left,nbits)) then - begin - action; - exit; - end; - get_buffer := state.get_buffer; - bits_left := state.bits_left; - end; - - -{$define GET_BITS(nbits)} - Dec(bits_left, (nbits)); - ( (int(get_buffer shr bits_left)) and ( pred(1 shl (nbits)) ) ) - -{$define PEEK_BITS(nbits)} - int(get_buffer shr (bits_left - (nbits))) and pred(1 shl (nbits)) - -{$define DROP_BITS(nbits)} - Dec(bits_left, nbits); - - - - -{ Code for extracting next Huffman-coded symbol from input bit stream. - Again, this is time-critical and we make the main paths be macros. - - We use a lookahead table to process codes of up to HUFF_LOOKAHEAD bits - without looping. Usually, more than 95% of the Huffman codes will be 8 - or fewer bits long. The few overlength codes are handled with a loop, - which need not be inline code. - - Notes about the HUFF_DECODE macro: - 1. Near the end of the data segment, we may fail to get enough bits - for a lookahead. In that case, we do it the hard way. - 2. If the lookahead table contains no entry, the next code must be - more than HUFF_LOOKAHEAD bits long. - 3. jpeg_huff_decode returns -1 if forced to suspend. } - - - - -macro HUFF_DECODE(s,br_state,htbl,return FALSE,slowlabel); -label showlabel; -var - nb, look : int; {register} -begin - if (bits_left < HUFF_LOOKAHEAD) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then - begin - decode_mcu := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - if (bits_left < HUFF_LOOKAHEAD) then - begin - nb := 1; - goto slowlabel; - end; - end; - {look := PEEK_BITS(HUFF_LOOKAHEAD);} - look := int(get_buffer shr (bits_left - HUFF_LOOKAHEAD)) and - pred(1 shl HUFF_LOOKAHEAD); - - nb := htbl^.look_nbits[look]; - if (nb <> 0) then - begin - {DROP_BITS(nb);} - Dec(bits_left, nb); - - s := htbl^.look_sym[look]; - end - else - begin - nb := HUFF_LOOKAHEAD+1; -slowlabel: - s := jpeg_huff_decode(br_state,get_buffer,bits_left,htbl,nb)); - if (s < 0) then - begin - result := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; -end; - - -{$ENDIF} {MACRO} - -{ Expanded entropy decoder object for Huffman decoding. - - The savable_state subrecord contains fields that change within an MCU, - but must not be updated permanently until we complete the MCU. } - -type - savable_state = record - last_dc_val : array[0..MAX_COMPS_IN_SCAN-1] of int; { last DC coef for each component } - end; - - -type - huff_entropy_ptr = ^huff_entropy_decoder; - huff_entropy_decoder = record - pub : jpeg_entropy_decoder; { public fields } - - { These fields are loaded into local variables at start of each MCU. - In case of suspension, we exit WITHOUT updating them. } - - bitstate : bitread_perm_state; { Bit buffer at start of MCU } - saved : savable_state; { Other state at start of MCU } - - { These fields are NOT loaded into local working state. } - restarts_to_go : uInt; { MCUs left in this restart interval } - - { Pointers to derived tables (these workspaces have image lifespan) } - dc_derived_tbls : array[0..NUM_HUFF_TBLS] of d_derived_tbl_ptr; - ac_derived_tbls : array[0..NUM_HUFF_TBLS] of d_derived_tbl_ptr; - - { Precalculated info set up by start_pass for use in decode_mcu: } - - { Pointers to derived tables to be used for each block within an MCU } - dc_cur_tbls : array[0..D_MAX_BLOCKS_IN_MCU-1] of d_derived_tbl_ptr; - ac_cur_tbls : array[0..D_MAX_BLOCKS_IN_MCU-1] of d_derived_tbl_ptr; - { Whether we care about the DC and AC coefficient values for each block } - dc_needed : array[0..D_MAX_BLOCKS_IN_MCU-1] of boolean; - ac_needed : array[0..D_MAX_BLOCKS_IN_MCU-1] of boolean; - end; - - - -{ Initialize for a Huffman-compressed scan. } - -{METHODDEF} -procedure start_pass_huff_decoder (cinfo : j_decompress_ptr); -var - entropy : huff_entropy_ptr; - ci, blkn, dctbl, actbl : int; - compptr : jpeg_component_info_ptr; -begin - entropy := huff_entropy_ptr (cinfo^.entropy); - - { Check that the scan parameters Ss, Se, Ah/Al are OK for sequential JPEG. - This ought to be an error condition, but we make it a warning because - there are some baseline files out there with all zeroes in these bytes. } - - if (cinfo^.Ss <> 0) or (cinfo^.Se <> DCTSIZE2-1) or - (cinfo^.Ah <> 0) or (cinfo^.Al <> 0) then - WARNMS(j_common_ptr(cinfo), JWRN_NOT_SEQUENTIAL); - - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - dctbl := compptr^.dc_tbl_no; - actbl := compptr^.ac_tbl_no; - { Compute derived values for Huffman tables } - { We may do this more than once for a table, but it's not expensive } - jpeg_make_d_derived_tbl(cinfo, TRUE, dctbl, - entropy^.dc_derived_tbls[dctbl]); - jpeg_make_d_derived_tbl(cinfo, FALSE, actbl, - entropy^.ac_derived_tbls[actbl]); - { Initialize DC predictions to 0 } - entropy^.saved.last_dc_val[ci] := 0; - end; - - { Precalculate decoding info for each block in an MCU of this scan } - for blkn := 0 to pred(cinfo^.blocks_in_MCU) do - begin - ci := cinfo^.MCU_membership[blkn]; - compptr := cinfo^.cur_comp_info[ci]; - { Precalculate which table to use for each block } - entropy^.dc_cur_tbls[blkn] := entropy^.dc_derived_tbls[compptr^.dc_tbl_no]; - entropy^.ac_cur_tbls[blkn] := entropy^.ac_derived_tbls[compptr^.ac_tbl_no]; - { Decide whether we really care about the coefficient values } - if (compptr^.component_needed) then - begin - entropy^.dc_needed[blkn] := TRUE; - { we don't need the ACs if producing a 1/8th-size image } - entropy^.ac_needed[blkn] := (compptr^.DCT_scaled_size > 1); - end - else - begin - entropy^.ac_needed[blkn] := FALSE; - entropy^.dc_needed[blkn] := FALSE; - end; - end; - - { Initialize bitread state variables } - entropy^.bitstate.bits_left := 0; - entropy^.bitstate.get_buffer := 0; { unnecessary, but keeps Purify quiet } - entropy^.pub.insufficient_data := FALSE; - - { Initialize restart counter } - entropy^.restarts_to_go := cinfo^.restart_interval; -end; - - -{ Compute the derived values for a Huffman table. - This routine also performs some validation checks on the table. - - Note this is also used by jdphuff.c. } - -{GLOBAL} -procedure jpeg_make_d_derived_tbl (cinfo : j_decompress_ptr; - isDC : boolean; - tblno : int; - var pdtbl : d_derived_tbl_ptr); -var - htbl : JHUFF_TBL_PTR; - dtbl : d_derived_tbl_ptr; - p, i, l, si, numsymbols : int; - lookbits, ctr : int; - huffsize : array[0..257-1] of byte; - huffcode : array[0..257-1] of uInt; - code : uInt; -var - sym : int; -begin - { Note that huffsize[] and huffcode[] are filled in code-length order, - paralleling the order of the symbols themselves in htbl^.huffval[]. } - - { Find the input Huffman table } - if (tblno < 0) or (tblno >= NUM_HUFF_TBLS) then - ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, tblno); - if isDC then - htbl := cinfo^.dc_huff_tbl_ptrs[tblno] - else - htbl := cinfo^.ac_huff_tbl_ptrs[tblno]; - if (htbl = NIL) then - ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, tblno); - - { Allocate a workspace if we haven't already done so. } - if (pdtbl = NIL) then - pdtbl := d_derived_tbl_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(d_derived_tbl)) ); - dtbl := pdtbl; - dtbl^.pub := htbl; { fill in back link } - - { Figure C.1: make table of Huffman code length for each symbol } - - p := 0; - for l := 1 to 16 do - begin - i := int(htbl^.bits[l]); - if (i < 0) or (p + i > 256) then { protect against table overrun } - ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE); - while (i > 0) do - begin - huffsize[p] := byte(l); - Inc(p); - Dec(i); - end; - end; - huffsize[p] := 0; - numsymbols := p; - - { Figure C.2: generate the codes themselves } - { We also validate that the counts represent a legal Huffman code tree. } - - code := 0; - si := huffsize[0]; - p := 0; - while (huffsize[p] <> 0) do - begin - while (( int (huffsize[p]) ) = si) do - begin - huffcode[p] := code; - Inc(p); - Inc(code); - end; - { code is now 1 more than the last code used for codelength si; but - it must still fit in si bits, since no code is allowed to be all ones. } - - if (INT32(code) >= (INT32(1) shl si)) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE); - - code := code shl 1; - Inc(si); - end; - - { Figure F.15: generate decoding tables for bit-sequential decoding } - - p := 0; - for l := 1 to 16 do - begin - if (htbl^.bits[l] <> 0) then - begin - { valoffset[l] = huffval[] index of 1st symbol of code length l, - minus the minimum code of length l } - - dtbl^.valoffset[l] := INT32(p) - INT32(huffcode[p]); - Inc(p, htbl^.bits[l]); - dtbl^.maxcode[l] := huffcode[p-1]; { maximum code of length l } - end - else - begin - dtbl^.maxcode[l] := -1; { -1 if no codes of this length } - end; - end; - dtbl^.maxcode[17] := long($FFFFF); { ensures jpeg_huff_decode terminates } - - { Compute lookahead tables to speed up decoding. - First we set all the table entries to 0, indicating "too long"; - then we iterate through the Huffman codes that are short enough and - fill in all the entries that correspond to bit sequences starting - with that code. } - - MEMZERO(@dtbl^.look_nbits, SIZEOF(dtbl^.look_nbits)); - - p := 0; - for l := 1 to HUFF_LOOKAHEAD do - begin - for i := 1 to int (htbl^.bits[l]) do - begin - { l := current code's length, p := its index in huffcode[] & huffval[]. } - { Generate left-justified code followed by all possible bit sequences } - lookbits := huffcode[p] shl (HUFF_LOOKAHEAD-l); - for ctr := pred(1 shl (HUFF_LOOKAHEAD-l)) downto 0 do - begin - dtbl^.look_nbits[lookbits] := l; - dtbl^.look_sym[lookbits] := htbl^.huffval[p]; - Inc(lookbits); - end; - Inc(p); - end; - end; - - { Validate symbols as being reasonable. - For AC tables, we make no check, but accept all byte values 0..255. - For DC tables, we require the symbols to be in range 0..15. - (Tighter bounds could be applied depending on the data depth and mode, - but this is sufficient to ensure safe decoding.) } - - if (isDC) then - begin - for i := 0 to pred(numsymbols) do - begin - sym := htbl^.huffval[i]; - if (sym < 0) or (sym > 15) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE); - end; - end; -end; - - -{ Out-of-line code for bit fetching (shared with jdphuff.c). - See jdhuff.h for info about usage. - Note: current values of get_buffer and bits_left are passed as parameters, - but are returned in the corresponding fields of the state struct. - - On most machines MIN_GET_BITS should be 25 to allow the full 32-bit width - of get_buffer to be used. (On machines with wider words, an even larger - buffer could be used.) However, on some machines 32-bit shifts are - quite slow and take time proportional to the number of places shifted. - (This is true with most PC compilers, for instance.) In this case it may - be a win to set MIN_GET_BITS to the minimum value of 15. This reduces the - average shift distance at the cost of more calls to jpeg_fill_bit_buffer. } - -{$ifdef SLOW_SHIFT_32} -const - MIN_GET_BITS = 15; { minimum allowable value } -{$else} -const - MIN_GET_BITS = (BIT_BUF_SIZE-7); -{$endif} - - -{GLOBAL} -function jpeg_fill_bit_buffer (var state : bitread_working_state; - {register} get_buffer : bit_buf_type; - {register} bits_left : int; - nbits : int) : boolean; -label - no_more_bytes; -{ Load up the bit buffer to a depth of at least nbits } -var - { Copy heavily used state fields into locals (hopefully registers) } - {register} next_input_byte : {const} JOCTETptr; - {register} bytes_in_buffer : size_t; -var - {register} c : int; -var - cinfo : j_decompress_ptr; -begin - next_input_byte := state.next_input_byte; - bytes_in_buffer := state.bytes_in_buffer; - cinfo := state.cinfo; - - { Attempt to load at least MIN_GET_BITS bits into get_buffer. } - { (It is assumed that no request will be for more than that many bits.) } - { We fail to do so only if we hit a marker or are forced to suspend. } - - if (cinfo^.unread_marker = 0) then { cannot advance past a marker } - begin - while (bits_left < MIN_GET_BITS) do - begin - { Attempt to read a byte } - if (bytes_in_buffer = 0) then - begin - if not cinfo^.src^.fill_input_buffer(cinfo) then - begin - jpeg_fill_bit_buffer := FALSE; - exit; - end; - next_input_byte := cinfo^.src^.next_input_byte; - bytes_in_buffer := cinfo^.src^.bytes_in_buffer; - end; - Dec(bytes_in_buffer); - c := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - - - { If it's $FF, check and discard stuffed zero byte } - if (c = $FF) then - begin - { Loop here to discard any padding FF's on terminating marker, - so that we can save a valid unread_marker value. NOTE: we will - accept multiple FF's followed by a 0 as meaning a single FF data - byte. This data pattern is not valid according to the standard. } - - repeat - if (bytes_in_buffer = 0) then - begin - if (not state.cinfo^.src^.fill_input_buffer (state.cinfo)) then - begin - jpeg_fill_bit_buffer := FALSE; - exit; - end; - next_input_byte := state.cinfo^.src^.next_input_byte; - bytes_in_buffer := state.cinfo^.src^.bytes_in_buffer; - end; - Dec(bytes_in_buffer); - c := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - Until (c <> $FF); - - if (c = 0) then - begin - { Found FF/00, which represents an FF data byte } - c := $FF; - end - else - begin - { Oops, it's actually a marker indicating end of compressed data. - Save the marker code for later use. - Fine point: it might appear that we should save the marker into - bitread working state, not straight into permanent state. But - once we have hit a marker, we cannot need to suspend within the - current MCU, because we will read no more bytes from the data - source. So it is OK to update permanent state right away. } - - cinfo^.unread_marker := c; - { See if we need to insert some fake zero bits. } - goto no_more_bytes; - end; - end; - - { OK, load c into get_buffer } - get_buffer := (get_buffer shl 8) or c; - Inc(bits_left, 8); - end { end while } - end - else - begin - no_more_bytes: - { We get here if we've read the marker that terminates the compressed - data segment. There should be enough bits in the buffer register - to satisfy the request; if so, no problem. } - - if (nbits > bits_left) then - begin - { Uh-oh. Report corrupted data to user and stuff zeroes into - the data stream, so that we can produce some kind of image. - We use a nonvolatile flag to ensure that only one warning message - appears per data segment. } - - if not cinfo^.entropy^.insufficient_data then - begin - WARNMS(j_common_ptr(cinfo), JWRN_HIT_MARKER); - cinfo^.entropy^.insufficient_data := TRUE; - end; - { Fill the buffer with zero bits } - get_buffer := get_buffer shl (MIN_GET_BITS - bits_left); - bits_left := MIN_GET_BITS; - end; - end; - - { Unload the local registers } - state.next_input_byte := next_input_byte; - state.bytes_in_buffer := bytes_in_buffer; - state.get_buffer := get_buffer; - state.bits_left := bits_left; - - jpeg_fill_bit_buffer := TRUE; -end; - - -{ Out-of-line code for Huffman code decoding. - See jdhuff.h for info about usage. } - -{GLOBAL} -function jpeg_huff_decode (var state : bitread_working_state; - {register} get_buffer : bit_buf_type; - {register} bits_left : int; - htbl : d_derived_tbl_ptr; - min_bits : int) : int; -var - {register} l : int; - {register} code : INT32; -begin - l := min_bits; - - { HUFF_DECODE has determined that the code is at least min_bits } - { bits long, so fetch that many bits in one swoop. } - - {CHECK_BIT_BUFFER(state, l, return -1);} - if (bits_left < l) then - begin - if (not jpeg_fill_bit_buffer(state, get_buffer, bits_left, l)) then - begin - jpeg_huff_decode := -1; - exit; - end; - get_buffer := state.get_buffer; - bits_left := state.bits_left; - end; - - {code := GET_BITS(l);} - Dec(bits_left, l); - code := (int(get_buffer shr bits_left)) and ( pred(1 shl l) ); - - { Collect the rest of the Huffman code one bit at a time. } - { This is per Figure F.16 in the JPEG spec. } - - while (code > htbl^.maxcode[l]) do - begin - code := code shl 1; - {CHECK_BIT_BUFFER(state, 1, return -1);} - if (bits_left < 1) then - begin - if (not jpeg_fill_bit_buffer(state, get_buffer, bits_left, 1)) then - begin - jpeg_huff_decode := -1; - exit; - end; - get_buffer := state.get_buffer; - bits_left := state.bits_left; - end; - - {code := code or GET_BITS(1);} - Dec(bits_left); - code := code or ( (int(get_buffer shr bits_left)) and pred(1 shl 1) ); - - Inc(l); - end; - - { Unload the local registers } - state.get_buffer := get_buffer; - state.bits_left := bits_left; - - { With garbage input we may reach the sentinel value l := 17. } - - if (l > 16) then - begin - WARNMS(j_common_ptr(state.cinfo), JWRN_HUFF_BAD_CODE); - jpeg_huff_decode := 0; { fake a zero as the safest result } - exit; - end; - - jpeg_huff_decode := htbl^.pub^.huffval[ int (code + htbl^.valoffset[l]) ]; -end; - - -{ Figure F.12: extend sign bit. - On some machines, a shift and add will be faster than a table lookup. } - -{$ifdef AVOID_TABLES} - -#define HUFF_EXTEND(x,s) ((x) < (1<<((s)-1)) ? (x) + (((-1)<<(s)) + 1) : (x)) - -{$else} - -{$define HUFF_EXTEND(x,s) - if (x < extend_test[s]) then - := x + extend_offset[s] - else - x;} - -const - extend_test : array[0..16-1] of int = { entry n is 2**(n-1) } - ($0000, $0001, $0002, $0004, $0008, $0010, $0020, $0040, - $0080, $0100, $0200, $0400, $0800, $1000, $2000, $4000); - -const - extend_offset : array[0..16-1] of int = { entry n is (-1 << n) + 1 } -(0, ((-1) shl 1) + 1, ((-1) shl 2) + 1, ((-1) shl 3) + 1, ((-1) shl 4) + 1, - ((-1) shl 5) + 1, ((-1) shl 6) + 1, ((-1) shl 7) + 1, ((-1) shl 8) + 1, - ((-1) shl 9) + 1, ((-1) shl 10) + 1, ((-1) shl 11) + 1,((-1) shl 12) + 1, - ((-1) shl 13) + 1, ((-1) shl 14) + 1, ((-1) shl 15) + 1); - -{$endif} { AVOID_TABLES } - - -{ Check for a restart marker & resynchronize decoder. - Returns FALSE if must suspend. } - -{LOCAL} -function process_restart (cinfo : j_decompress_ptr) : boolean; -var - entropy : huff_entropy_ptr; - ci : int; -begin - entropy := huff_entropy_ptr (cinfo^.entropy); - - { Throw away any unused bits remaining in bit buffer; } - { include any full bytes in next_marker's count of discarded bytes } - Inc(cinfo^.marker^.discarded_bytes, entropy^.bitstate.bits_left div 8); - entropy^.bitstate.bits_left := 0; - - { Advance past the RSTn marker } - if (not cinfo^.marker^.read_restart_marker (cinfo)) then - begin - process_restart := FALSE; - exit; - end; - - { Re-initialize DC predictions to 0 } - for ci := 0 to pred(cinfo^.comps_in_scan) do - entropy^.saved.last_dc_val[ci] := 0; - - { Reset restart counter } - entropy^.restarts_to_go := cinfo^.restart_interval; - - { Reset out-of-data flag, unless read_restart_marker left us smack up - against a marker. In that case we will end up treating the next data - segment as empty, and we can avoid producing bogus output pixels by - leaving the flag set. } - - if (cinfo^.unread_marker = 0) then - entropy^.pub.insufficient_data := FALSE; - - process_restart := TRUE; -end; - - -{ Decode and return one MCU's worth of Huffman-compressed coefficients. - The coefficients are reordered from zigzag order into natural array order, - but are not dequantized. - - The i'th block of the MCU is stored into the block pointed to by - MCU_data[i]. WE ASSUME THIS AREA HAS BEEN ZEROED BY THE CALLER. - (Wholesale zeroing is usually a little faster than retail...) - - Returns FALSE if data source requested suspension. In that case no - changes have been made to permanent state. (Exception: some output - coefficients may already have been assigned. This is harmless for - this module, since we'll just re-assign them on the next call.) } - -{METHODDEF} -function decode_mcu (cinfo : j_decompress_ptr; - var MCU_data : array of JBLOCKROW) : boolean; -label - label1, label2, label3; -var - entropy : huff_entropy_ptr; - {register} s, k, r : int; - blkn, ci : int; - block : JBLOCK_PTR; - {BITREAD_STATE_VARS} - get_buffer : bit_buf_type ; {register} - bits_left : int; {register} - br_state : bitread_working_state; - - state : savable_state; - dctbl : d_derived_tbl_ptr; - actbl : d_derived_tbl_ptr; -var - nb, look : int; {register} -begin - entropy := huff_entropy_ptr (cinfo^.entropy); - - { Process restart marker if needed; may have to suspend } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - if (not process_restart(cinfo)) then - begin - decode_mcu := FALSE; - exit; - end; - end; - - { If we've run out of data, just leave the MCU set to zeroes. - This way, we return uniform gray for the remainder of the segment. } - - if not entropy^.pub.insufficient_data then - begin - - { Load up working state } - {BITREAD_LOAD_STATE(cinfo,entropy^.bitstate);} - br_state.cinfo := cinfo; - br_state.next_input_byte := cinfo^.src^.next_input_byte; - br_state.bytes_in_buffer := cinfo^.src^.bytes_in_buffer; - get_buffer := entropy^.bitstate.get_buffer; - bits_left := entropy^.bitstate.bits_left; - - {ASSIGN_STATE(state, entropy^.saved);} - state := entropy^.saved; - - { Outer loop handles each block in the MCU } - - for blkn := 0 to pred(cinfo^.blocks_in_MCU) do - begin - block := JBLOCK_PTR(MCU_data[blkn]); - dctbl := entropy^.dc_cur_tbls[blkn]; - actbl := entropy^.ac_cur_tbls[blkn]; - - { Decode a single block's worth of coefficients } - - { Section F.2.2.1: decode the DC coefficient difference } - {HUFF_DECODE(s, br_state, dctbl, return FALSE, label1);} - if (bits_left < HUFF_LOOKAHEAD) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then - begin - decode_mcu := False; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - if (bits_left < HUFF_LOOKAHEAD) then - begin - nb := 1; - goto label1; - end; - end; - {look := PEEK_BITS(HUFF_LOOKAHEAD);} - look := int(get_buffer shr (bits_left - HUFF_LOOKAHEAD)) and - pred(1 shl HUFF_LOOKAHEAD); - - nb := dctbl^.look_nbits[look]; - if (nb <> 0) then - begin - {DROP_BITS(nb);} - Dec(bits_left, nb); - - s := dctbl^.look_sym[look]; - end - else - begin - nb := HUFF_LOOKAHEAD+1; - label1: - s := jpeg_huff_decode(br_state,get_buffer,bits_left,dctbl,nb); - if (s < 0) then - begin - decode_mcu := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - if (s <> 0) then - begin - {CHECK_BIT_BUFFER(br_state, s, return FALSE);} - if (bits_left < s) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,s)) then - begin - decode_mcu := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - {r := GET_BITS(s);} - Dec(bits_left, s); - r := ( int(get_buffer shr bits_left)) and ( pred(1 shl s) ); - - {s := HUFF_EXTEND(r, s);} - if (r < extend_test[s]) then - s := r + extend_offset[s] - else - s := r; - end; - - if (entropy^.dc_needed[blkn]) then - begin - { Convert DC difference to actual value, update last_dc_val } - ci := cinfo^.MCU_membership[blkn]; - Inc(s, state.last_dc_val[ci]); - state.last_dc_val[ci] := s; - { Output the DC coefficient (assumes jpeg_natural_order[0] := 0) } - block^[0] := JCOEF (s); - end; - - if (entropy^.ac_needed[blkn]) then - begin - - { Section F.2.2.2: decode the AC coefficients } - { Since zeroes are skipped, output area must be cleared beforehand } - k := 1; - while (k < DCTSIZE2) do { Nomssi: k is incr. in the loop } - begin - {HUFF_DECODE(s, br_state, actbl, return FALSE, label2);} - if (bits_left < HUFF_LOOKAHEAD) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then - begin - decode_mcu := False; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - if (bits_left < HUFF_LOOKAHEAD) then - begin - nb := 1; - goto label2; - end; - end; - {look := PEEK_BITS(HUFF_LOOKAHEAD);} - look := int(get_buffer shr (bits_left - HUFF_LOOKAHEAD)) and - pred(1 shl HUFF_LOOKAHEAD); - - nb := actbl^.look_nbits[look]; - if (nb <> 0) then - begin - {DROP_BITS(nb);} - Dec(bits_left, nb); - - s := actbl^.look_sym[look]; - end - else - begin - nb := HUFF_LOOKAHEAD+1; - label2: - s := jpeg_huff_decode(br_state,get_buffer,bits_left,actbl,nb); - if (s < 0) then - begin - decode_mcu := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - r := s shr 4; - s := s and 15; - - if (s <> 0) then - begin - Inc(k, r); - {CHECK_BIT_BUFFER(br_state, s, return FALSE);} - if (bits_left < s) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,s)) then - begin - decode_mcu := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - {r := GET_BITS(s);} - Dec(bits_left, s); - r := (int(get_buffer shr bits_left)) and ( pred(1 shl s) ); - - {s := HUFF_EXTEND(r, s);} - if (r < extend_test[s]) then - s := r + extend_offset[s] - else - s := r; - { Output coefficient in natural (dezigzagged) order. - Note: the extra entries in jpeg_natural_order[] will save us - if k >= DCTSIZE2, which could happen if the data is corrupted. } - - block^[jpeg_natural_order[k]] := JCOEF (s); - end - else - begin - if (r <> 15) then - break; - Inc(k, 15); - end; - Inc(k); - end; - end - else - begin - - { Section F.2.2.2: decode the AC coefficients } - { In this path we just discard the values } - k := 1; - while (k < DCTSIZE2) do - begin - {HUFF_DECODE(s, br_state, actbl, return FALSE, label3);} - if (bits_left < HUFF_LOOKAHEAD) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then - begin - decode_mcu := False; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - if (bits_left < HUFF_LOOKAHEAD) then - begin - nb := 1; - goto label3; - end; - end; - {look := PEEK_BITS(HUFF_LOOKAHEAD);} - look := int(get_buffer shr (bits_left - HUFF_LOOKAHEAD)) and - pred(1 shl HUFF_LOOKAHEAD); - - nb := actbl^.look_nbits[look]; - if (nb <> 0) then - begin - {DROP_BITS(nb);} - Dec(bits_left, nb); - - s := actbl^.look_sym[look]; - end - else - begin - nb := HUFF_LOOKAHEAD+1; - label3: - s := jpeg_huff_decode(br_state,get_buffer,bits_left,actbl,nb); - if (s < 0) then - begin - decode_mcu := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - r := s shr 4; - s := s and 15; - - if (s <> 0) then - begin - Inc(k, r); - {CHECK_BIT_BUFFER(br_state, s, return FALSE);} - if (bits_left < s) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,s)) then - begin - decode_mcu := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - {DROP_BITS(s);} - Dec(bits_left, s); - end - else - begin - if (r <> 15) then - break; - Inc(k, 15); - end; - Inc(k); - end; - - end; - end; - - { Completed MCU, so update state } - {BITREAD_SAVE_STATE(cinfo,entropy^.bitstate);} - cinfo^.src^.next_input_byte := br_state.next_input_byte; - cinfo^.src^.bytes_in_buffer := br_state.bytes_in_buffer; - entropy^.bitstate.get_buffer := get_buffer; - entropy^.bitstate.bits_left := bits_left; - - {ASSIGN_STATE(entropy^.saved, state);} - entropy^.saved := state; - - end; - - { Account for restart interval (no-op if not using restarts) } - Dec(entropy^.restarts_to_go); - - decode_mcu := TRUE; -end; - - -{ Module initialization routine for Huffman entropy decoding. } - -{GLOBAL} -procedure jinit_huff_decoder (cinfo : j_decompress_ptr); -var - entropy : huff_entropy_ptr; - i : int; -begin - entropy := huff_entropy_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(huff_entropy_decoder)) ); - cinfo^.entropy := jpeg_entropy_decoder_ptr (entropy); - entropy^.pub.start_pass := start_pass_huff_decoder; - entropy^.pub.decode_mcu := decode_mcu; - - { Mark tables unallocated } - for i := 0 to pred(NUM_HUFF_TBLS) do - begin - entropy^.dc_derived_tbls[i] := NIL; - entropy^.ac_derived_tbls[i] := NIL; - end; -end; - -end. +unit imjdhuff; + +{ This file contains declarations for Huffman entropy decoding routines + that are shared between the sequential decoder (jdhuff.c) and the + progressive decoder (jdphuff.c). No other modules need to see these. } + +{ This file contains Huffman entropy decoding routines. + + Much of the complexity here has to do with supporting input suspension. + If the data source module demands suspension, we want to be able to back + up to the start of the current MCU. To do this, we copy state variables + into local working storage, and update them back to the permanent + storage only upon successful completion of an MCU. } + +{ Original: jdhuff.h+jdhuff.c; Copyright (C) 1991-1997, Thomas G. Lane. } + + + +interface + +{$I imjconfig.inc} + +uses + imjmorecfg, + imjinclude, + imjdeferr, + imjerror, + imjutils, + imjpeglib; + + +{ Declarations shared with jdphuff.c } + + + +{ Derived data constructed for each Huffman table } + +const + HUFF_LOOKAHEAD = 8; { # of bits of lookahead } + +type + d_derived_tbl_ptr = ^d_derived_tbl; + d_derived_tbl = record + { Basic tables: (element [0] of each array is unused) } + maxcode : array[0..18-1] of INT32; { largest code of length k (-1 if none) } + { (maxcode[17] is a sentinel to ensure jpeg_huff_decode terminates) } + valoffset : array[0..17-1] of INT32; { huffval[] offset for codes of length k } + { valoffset[k] = huffval[] index of 1st symbol of code length k, less + the smallest code of length k; so given a code of length k, the + corresponding symbol is huffval[code + valoffset[k]] } + + { Link to public Huffman table (needed only in jpeg_huff_decode) } + pub : JHUFF_TBL_PTR; + + { Lookahead tables: indexed by the next HUFF_LOOKAHEAD bits of + the input data stream. If the next Huffman code is no more + than HUFF_LOOKAHEAD bits long, we can obtain its length and + the corresponding symbol directly from these tables. } + + look_nbits : array[0..(1 shl HUFF_LOOKAHEAD)-1] of int; + { # bits, or 0 if too long } + look_sym : array[0..(1 shl HUFF_LOOKAHEAD)-1] of UINT8; + { symbol, or unused } + end; + +{ Fetching the next N bits from the input stream is a time-critical operation + for the Huffman decoders. We implement it with a combination of inline + macros and out-of-line subroutines. Note that N (the number of bits + demanded at one time) never exceeds 15 for JPEG use. + + We read source bytes into get_buffer and dole out bits as needed. + If get_buffer already contains enough bits, they are fetched in-line + by the macros CHECK_BIT_BUFFER and GET_BITS. When there aren't enough + bits, jpeg_fill_bit_buffer is called; it will attempt to fill get_buffer + as full as possible (not just to the number of bits needed; this + prefetching reduces the overhead cost of calling jpeg_fill_bit_buffer). + Note that jpeg_fill_bit_buffer may return FALSE to indicate suspension. + On TRUE return, jpeg_fill_bit_buffer guarantees that get_buffer contains + at least the requested number of bits --- dummy zeroes are inserted if + necessary. } + + +type + bit_buf_type = INT32 ; { type of bit-extraction buffer } +const + BIT_BUF_SIZE = 32; { size of buffer in bits } + +{ If long is > 32 bits on your machine, and shifting/masking longs is + reasonably fast, making bit_buf_type be long and setting BIT_BUF_SIZE + appropriately should be a win. Unfortunately we can't define the size + with something like #define BIT_BUF_SIZE (sizeof(bit_buf_type)*8) + because not all machines measure sizeof in 8-bit bytes. } + +type + bitread_perm_state = record { Bitreading state saved across MCUs } + get_buffer : bit_buf_type; { current bit-extraction buffer } + bits_left : int; { # of unused bits in it } + end; + +type + bitread_working_state = record + { Bitreading working state within an MCU } + { current data source location } + { We need a copy, rather than munging the original, in case of suspension } + next_input_byte : JOCTETptr; { => next byte to read from source } + bytes_in_buffer : size_t; { # of bytes remaining in source buffer } + { Bit input buffer --- note these values are kept in register variables, + not in this struct, inside the inner loops. } + + get_buffer : bit_buf_type; { current bit-extraction buffer } + bits_left : int; { # of unused bits in it } + { Pointer needed by jpeg_fill_bit_buffer } + cinfo : j_decompress_ptr; { back link to decompress master record } + end; + +{ Module initialization routine for Huffman entropy decoding. } + +{GLOBAL} +procedure jinit_huff_decoder (cinfo : j_decompress_ptr); + +{GLOBAL} +function jpeg_huff_decode(var state : bitread_working_state; + get_buffer : bit_buf_type; {register} + bits_left : int; {register} + htbl : d_derived_tbl_ptr; + min_bits : int) : int; + +{ Compute the derived values for a Huffman table. + Note this is also used by jdphuff.c. } + +{GLOBAL} +procedure jpeg_make_d_derived_tbl (cinfo : j_decompress_ptr; + isDC : boolean; + tblno : int; + var pdtbl : d_derived_tbl_ptr); + +{ Load up the bit buffer to a depth of at least nbits } + +function jpeg_fill_bit_buffer (var state : bitread_working_state; + get_buffer : bit_buf_type; {register} + bits_left : int; {register} + nbits : int) : boolean; + +implementation + +{$IFDEF MACRO} + +{ Macros to declare and load/save bitread local variables. } +{$define BITREAD_STATE_VARS} + get_buffer : bit_buf_type ; {register} + bits_left : int; {register} + br_state : bitread_working_state; + +{$define BITREAD_LOAD_STATE(cinfop,permstate)} + br_state.cinfo := cinfop; + br_state.next_input_byte := cinfop^.src^.next_input_byte; + br_state.bytes_in_buffer := cinfop^.src^.bytes_in_buffer; + get_buffer := permstate.get_buffer; + bits_left := permstate.bits_left; + +{$define BITREAD_SAVE_STATE(cinfop,permstate) } + cinfop^.src^.next_input_byte := br_state.next_input_byte; + cinfop^.src^.bytes_in_buffer := br_state.bytes_in_buffer; + permstate.get_buffer := get_buffer; + permstate.bits_left := bits_left; + + +{ These macros provide the in-line portion of bit fetching. + Use CHECK_BIT_BUFFER to ensure there are N bits in get_buffer + before using GET_BITS, PEEK_BITS, or DROP_BITS. + The variables get_buffer and bits_left are assumed to be locals, + but the state struct might not be (jpeg_huff_decode needs this). + CHECK_BIT_BUFFER(state,n,action); + Ensure there are N bits in get_buffer; if suspend, take action. + val = GET_BITS(n); + Fetch next N bits. + val = PEEK_BITS(n); + Fetch next N bits without removing them from the buffer. + DROP_BITS(n); + Discard next N bits. + The value N should be a simple variable, not an expression, because it + is evaluated multiple times. } + + +{$define CHECK_BIT_BUFFER(state,nbits,action)} + if (bits_left < (nbits)) then + begin + if (not jpeg_fill_bit_buffer(&(state),get_buffer,bits_left,nbits)) then + begin + action; + exit; + end; + get_buffer := state.get_buffer; + bits_left := state.bits_left; + end; + + +{$define GET_BITS(nbits)} + Dec(bits_left, (nbits)); + ( (int(get_buffer shr bits_left)) and ( pred(1 shl (nbits)) ) ) + +{$define PEEK_BITS(nbits)} + int(get_buffer shr (bits_left - (nbits))) and pred(1 shl (nbits)) + +{$define DROP_BITS(nbits)} + Dec(bits_left, nbits); + + + + +{ Code for extracting next Huffman-coded symbol from input bit stream. + Again, this is time-critical and we make the main paths be macros. + + We use a lookahead table to process codes of up to HUFF_LOOKAHEAD bits + without looping. Usually, more than 95% of the Huffman codes will be 8 + or fewer bits long. The few overlength codes are handled with a loop, + which need not be inline code. + + Notes about the HUFF_DECODE macro: + 1. Near the end of the data segment, we may fail to get enough bits + for a lookahead. In that case, we do it the hard way. + 2. If the lookahead table contains no entry, the next code must be + more than HUFF_LOOKAHEAD bits long. + 3. jpeg_huff_decode returns -1 if forced to suspend. } + + + + +macro HUFF_DECODE(s,br_state,htbl,return FALSE,slowlabel); +label showlabel; +var + nb, look : int; {register} +begin + if (bits_left < HUFF_LOOKAHEAD) then + begin + if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then + begin + decode_mcu := FALSE; + exit; + end; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + if (bits_left < HUFF_LOOKAHEAD) then + begin + nb := 1; + goto slowlabel; + end; + end; + {look := PEEK_BITS(HUFF_LOOKAHEAD);} + look := int(get_buffer shr (bits_left - HUFF_LOOKAHEAD)) and + pred(1 shl HUFF_LOOKAHEAD); + + nb := htbl^.look_nbits[look]; + if (nb <> 0) then + begin + {DROP_BITS(nb);} + Dec(bits_left, nb); + + s := htbl^.look_sym[look]; + end + else + begin + nb := HUFF_LOOKAHEAD+1; +slowlabel: + s := jpeg_huff_decode(br_state,get_buffer,bits_left,htbl,nb)); + if (s < 0) then + begin + result := FALSE; + exit; + end; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + end; +end; + + +{$ENDIF} {MACRO} + +{ Expanded entropy decoder object for Huffman decoding. + + The savable_state subrecord contains fields that change within an MCU, + but must not be updated permanently until we complete the MCU. } + +type + savable_state = record + last_dc_val : array[0..MAX_COMPS_IN_SCAN-1] of int; { last DC coef for each component } + end; + + +type + huff_entropy_ptr = ^huff_entropy_decoder; + huff_entropy_decoder = record + pub : jpeg_entropy_decoder; { public fields } + + { These fields are loaded into local variables at start of each MCU. + In case of suspension, we exit WITHOUT updating them. } + + bitstate : bitread_perm_state; { Bit buffer at start of MCU } + saved : savable_state; { Other state at start of MCU } + + { These fields are NOT loaded into local working state. } + restarts_to_go : uInt; { MCUs left in this restart interval } + + { Pointers to derived tables (these workspaces have image lifespan) } + dc_derived_tbls : array[0..NUM_HUFF_TBLS] of d_derived_tbl_ptr; + ac_derived_tbls : array[0..NUM_HUFF_TBLS] of d_derived_tbl_ptr; + + { Precalculated info set up by start_pass for use in decode_mcu: } + + { Pointers to derived tables to be used for each block within an MCU } + dc_cur_tbls : array[0..D_MAX_BLOCKS_IN_MCU-1] of d_derived_tbl_ptr; + ac_cur_tbls : array[0..D_MAX_BLOCKS_IN_MCU-1] of d_derived_tbl_ptr; + { Whether we care about the DC and AC coefficient values for each block } + dc_needed : array[0..D_MAX_BLOCKS_IN_MCU-1] of boolean; + ac_needed : array[0..D_MAX_BLOCKS_IN_MCU-1] of boolean; + end; + + + +{ Initialize for a Huffman-compressed scan. } + +{METHODDEF} +procedure start_pass_huff_decoder (cinfo : j_decompress_ptr); +var + entropy : huff_entropy_ptr; + ci, blkn, dctbl, actbl : int; + compptr : jpeg_component_info_ptr; +begin + entropy := huff_entropy_ptr (cinfo^.entropy); + + { Check that the scan parameters Ss, Se, Ah/Al are OK for sequential JPEG. + This ought to be an error condition, but we make it a warning because + there are some baseline files out there with all zeroes in these bytes. } + + if (cinfo^.Ss <> 0) or (cinfo^.Se <> DCTSIZE2-1) or + (cinfo^.Ah <> 0) or (cinfo^.Al <> 0) then + WARNMS(j_common_ptr(cinfo), JWRN_NOT_SEQUENTIAL); + + for ci := 0 to pred(cinfo^.comps_in_scan) do + begin + compptr := cinfo^.cur_comp_info[ci]; + dctbl := compptr^.dc_tbl_no; + actbl := compptr^.ac_tbl_no; + { Compute derived values for Huffman tables } + { We may do this more than once for a table, but it's not expensive } + jpeg_make_d_derived_tbl(cinfo, TRUE, dctbl, + entropy^.dc_derived_tbls[dctbl]); + jpeg_make_d_derived_tbl(cinfo, FALSE, actbl, + entropy^.ac_derived_tbls[actbl]); + { Initialize DC predictions to 0 } + entropy^.saved.last_dc_val[ci] := 0; + end; + + { Precalculate decoding info for each block in an MCU of this scan } + for blkn := 0 to pred(cinfo^.blocks_in_MCU) do + begin + ci := cinfo^.MCU_membership[blkn]; + compptr := cinfo^.cur_comp_info[ci]; + { Precalculate which table to use for each block } + entropy^.dc_cur_tbls[blkn] := entropy^.dc_derived_tbls[compptr^.dc_tbl_no]; + entropy^.ac_cur_tbls[blkn] := entropy^.ac_derived_tbls[compptr^.ac_tbl_no]; + { Decide whether we really care about the coefficient values } + if (compptr^.component_needed) then + begin + entropy^.dc_needed[blkn] := TRUE; + { we don't need the ACs if producing a 1/8th-size image } + entropy^.ac_needed[blkn] := (compptr^.DCT_scaled_size > 1); + end + else + begin + entropy^.ac_needed[blkn] := FALSE; + entropy^.dc_needed[blkn] := FALSE; + end; + end; + + { Initialize bitread state variables } + entropy^.bitstate.bits_left := 0; + entropy^.bitstate.get_buffer := 0; { unnecessary, but keeps Purify quiet } + entropy^.pub.insufficient_data := FALSE; + + { Initialize restart counter } + entropy^.restarts_to_go := cinfo^.restart_interval; +end; + + +{ Compute the derived values for a Huffman table. + This routine also performs some validation checks on the table. + + Note this is also used by jdphuff.c. } + +{GLOBAL} +procedure jpeg_make_d_derived_tbl (cinfo : j_decompress_ptr; + isDC : boolean; + tblno : int; + var pdtbl : d_derived_tbl_ptr); +var + htbl : JHUFF_TBL_PTR; + dtbl : d_derived_tbl_ptr; + p, i, l, si, numsymbols : int; + lookbits, ctr : int; + huffsize : array[0..257-1] of byte; + huffcode : array[0..257-1] of uInt; + code : uInt; +var + sym : int; +begin + { Note that huffsize[] and huffcode[] are filled in code-length order, + paralleling the order of the symbols themselves in htbl^.huffval[]. } + + { Find the input Huffman table } + if (tblno < 0) or (tblno >= NUM_HUFF_TBLS) then + ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, tblno); + if isDC then + htbl := cinfo^.dc_huff_tbl_ptrs[tblno] + else + htbl := cinfo^.ac_huff_tbl_ptrs[tblno]; + if (htbl = NIL) then + ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, tblno); + + { Allocate a workspace if we haven't already done so. } + if (pdtbl = NIL) then + pdtbl := d_derived_tbl_ptr( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + SIZEOF(d_derived_tbl)) ); + dtbl := pdtbl; + dtbl^.pub := htbl; { fill in back link } + + { Figure C.1: make table of Huffman code length for each symbol } + + p := 0; + for l := 1 to 16 do + begin + i := int(htbl^.bits[l]); + if (i < 0) or (p + i > 256) then { protect against table overrun } + ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE); + while (i > 0) do + begin + huffsize[p] := byte(l); + Inc(p); + Dec(i); + end; + end; + huffsize[p] := 0; + numsymbols := p; + + { Figure C.2: generate the codes themselves } + { We also validate that the counts represent a legal Huffman code tree. } + + code := 0; + si := huffsize[0]; + p := 0; + while (huffsize[p] <> 0) do + begin + while (( int (huffsize[p]) ) = si) do + begin + huffcode[p] := code; + Inc(p); + Inc(code); + end; + { code is now 1 more than the last code used for codelength si; but + it must still fit in si bits, since no code is allowed to be all ones. } + + if (INT32(code) >= (INT32(1) shl si)) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE); + + code := code shl 1; + Inc(si); + end; + + { Figure F.15: generate decoding tables for bit-sequential decoding } + + p := 0; + for l := 1 to 16 do + begin + if (htbl^.bits[l] <> 0) then + begin + { valoffset[l] = huffval[] index of 1st symbol of code length l, + minus the minimum code of length l } + + dtbl^.valoffset[l] := INT32(p) - INT32(huffcode[p]); + Inc(p, htbl^.bits[l]); + dtbl^.maxcode[l] := huffcode[p-1]; { maximum code of length l } + end + else + begin + dtbl^.maxcode[l] := -1; { -1 if no codes of this length } + end; + end; + dtbl^.maxcode[17] := long($FFFFF); { ensures jpeg_huff_decode terminates } + + { Compute lookahead tables to speed up decoding. + First we set all the table entries to 0, indicating "too long"; + then we iterate through the Huffman codes that are short enough and + fill in all the entries that correspond to bit sequences starting + with that code. } + + MEMZERO(@dtbl^.look_nbits, SIZEOF(dtbl^.look_nbits)); + + p := 0; + for l := 1 to HUFF_LOOKAHEAD do + begin + for i := 1 to int (htbl^.bits[l]) do + begin + { l := current code's length, p := its index in huffcode[] & huffval[]. } + { Generate left-justified code followed by all possible bit sequences } + lookbits := huffcode[p] shl (HUFF_LOOKAHEAD-l); + for ctr := pred(1 shl (HUFF_LOOKAHEAD-l)) downto 0 do + begin + dtbl^.look_nbits[lookbits] := l; + dtbl^.look_sym[lookbits] := htbl^.huffval[p]; + Inc(lookbits); + end; + Inc(p); + end; + end; + + { Validate symbols as being reasonable. + For AC tables, we make no check, but accept all byte values 0..255. + For DC tables, we require the symbols to be in range 0..15. + (Tighter bounds could be applied depending on the data depth and mode, + but this is sufficient to ensure safe decoding.) } + + if (isDC) then + begin + for i := 0 to pred(numsymbols) do + begin + sym := htbl^.huffval[i]; + if (sym < 0) or (sym > 15) then + ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE); + end; + end; +end; + + +{ Out-of-line code for bit fetching (shared with jdphuff.c). + See jdhuff.h for info about usage. + Note: current values of get_buffer and bits_left are passed as parameters, + but are returned in the corresponding fields of the state struct. + + On most machines MIN_GET_BITS should be 25 to allow the full 32-bit width + of get_buffer to be used. (On machines with wider words, an even larger + buffer could be used.) However, on some machines 32-bit shifts are + quite slow and take time proportional to the number of places shifted. + (This is true with most PC compilers, for instance.) In this case it may + be a win to set MIN_GET_BITS to the minimum value of 15. This reduces the + average shift distance at the cost of more calls to jpeg_fill_bit_buffer. } + +{$ifdef SLOW_SHIFT_32} +const + MIN_GET_BITS = 15; { minimum allowable value } +{$else} +const + MIN_GET_BITS = (BIT_BUF_SIZE-7); +{$endif} + + +{GLOBAL} +function jpeg_fill_bit_buffer (var state : bitread_working_state; + {register} get_buffer : bit_buf_type; + {register} bits_left : int; + nbits : int) : boolean; +label + no_more_bytes; +{ Load up the bit buffer to a depth of at least nbits } +var + { Copy heavily used state fields into locals (hopefully registers) } + {register} next_input_byte : {const} JOCTETptr; + {register} bytes_in_buffer : size_t; +var + {register} c : int; +var + cinfo : j_decompress_ptr; +begin + next_input_byte := state.next_input_byte; + bytes_in_buffer := state.bytes_in_buffer; + cinfo := state.cinfo; + + { Attempt to load at least MIN_GET_BITS bits into get_buffer. } + { (It is assumed that no request will be for more than that many bits.) } + { We fail to do so only if we hit a marker or are forced to suspend. } + + if (cinfo^.unread_marker = 0) then { cannot advance past a marker } + begin + while (bits_left < MIN_GET_BITS) do + begin + { Attempt to read a byte } + if (bytes_in_buffer = 0) then + begin + if not cinfo^.src^.fill_input_buffer(cinfo) then + begin + jpeg_fill_bit_buffer := FALSE; + exit; + end; + next_input_byte := cinfo^.src^.next_input_byte; + bytes_in_buffer := cinfo^.src^.bytes_in_buffer; + end; + Dec(bytes_in_buffer); + c := GETJOCTET(next_input_byte^); + Inc(next_input_byte); + + + { If it's $FF, check and discard stuffed zero byte } + if (c = $FF) then + begin + { Loop here to discard any padding FF's on terminating marker, + so that we can save a valid unread_marker value. NOTE: we will + accept multiple FF's followed by a 0 as meaning a single FF data + byte. This data pattern is not valid according to the standard. } + + repeat + if (bytes_in_buffer = 0) then + begin + if (not state.cinfo^.src^.fill_input_buffer (state.cinfo)) then + begin + jpeg_fill_bit_buffer := FALSE; + exit; + end; + next_input_byte := state.cinfo^.src^.next_input_byte; + bytes_in_buffer := state.cinfo^.src^.bytes_in_buffer; + end; + Dec(bytes_in_buffer); + c := GETJOCTET(next_input_byte^); + Inc(next_input_byte); + Until (c <> $FF); + + if (c = 0) then + begin + { Found FF/00, which represents an FF data byte } + c := $FF; + end + else + begin + { Oops, it's actually a marker indicating end of compressed data. + Save the marker code for later use. + Fine point: it might appear that we should save the marker into + bitread working state, not straight into permanent state. But + once we have hit a marker, we cannot need to suspend within the + current MCU, because we will read no more bytes from the data + source. So it is OK to update permanent state right away. } + + cinfo^.unread_marker := c; + { See if we need to insert some fake zero bits. } + goto no_more_bytes; + end; + end; + + { OK, load c into get_buffer } + get_buffer := (get_buffer shl 8) or c; + Inc(bits_left, 8); + end { end while } + end + else + begin + no_more_bytes: + { We get here if we've read the marker that terminates the compressed + data segment. There should be enough bits in the buffer register + to satisfy the request; if so, no problem. } + + if (nbits > bits_left) then + begin + { Uh-oh. Report corrupted data to user and stuff zeroes into + the data stream, so that we can produce some kind of image. + We use a nonvolatile flag to ensure that only one warning message + appears per data segment. } + + if not cinfo^.entropy^.insufficient_data then + begin + WARNMS(j_common_ptr(cinfo), JWRN_HIT_MARKER); + cinfo^.entropy^.insufficient_data := TRUE; + end; + { Fill the buffer with zero bits } + get_buffer := get_buffer shl (MIN_GET_BITS - bits_left); + bits_left := MIN_GET_BITS; + end; + end; + + { Unload the local registers } + state.next_input_byte := next_input_byte; + state.bytes_in_buffer := bytes_in_buffer; + state.get_buffer := get_buffer; + state.bits_left := bits_left; + + jpeg_fill_bit_buffer := TRUE; +end; + + +{ Out-of-line code for Huffman code decoding. + See jdhuff.h for info about usage. } + +{GLOBAL} +function jpeg_huff_decode (var state : bitread_working_state; + {register} get_buffer : bit_buf_type; + {register} bits_left : int; + htbl : d_derived_tbl_ptr; + min_bits : int) : int; +var + {register} l : int; + {register} code : INT32; +begin + l := min_bits; + + { HUFF_DECODE has determined that the code is at least min_bits } + { bits long, so fetch that many bits in one swoop. } + + {CHECK_BIT_BUFFER(state, l, return -1);} + if (bits_left < l) then + begin + if (not jpeg_fill_bit_buffer(state, get_buffer, bits_left, l)) then + begin + jpeg_huff_decode := -1; + exit; + end; + get_buffer := state.get_buffer; + bits_left := state.bits_left; + end; + + {code := GET_BITS(l);} + Dec(bits_left, l); + code := (int(get_buffer shr bits_left)) and ( pred(1 shl l) ); + + { Collect the rest of the Huffman code one bit at a time. } + { This is per Figure F.16 in the JPEG spec. } + + while (code > htbl^.maxcode[l]) do + begin + code := code shl 1; + {CHECK_BIT_BUFFER(state, 1, return -1);} + if (bits_left < 1) then + begin + if (not jpeg_fill_bit_buffer(state, get_buffer, bits_left, 1)) then + begin + jpeg_huff_decode := -1; + exit; + end; + get_buffer := state.get_buffer; + bits_left := state.bits_left; + end; + + {code := code or GET_BITS(1);} + Dec(bits_left); + code := code or ( (int(get_buffer shr bits_left)) and pred(1 shl 1) ); + + Inc(l); + end; + + { Unload the local registers } + state.get_buffer := get_buffer; + state.bits_left := bits_left; + + { With garbage input we may reach the sentinel value l := 17. } + + if (l > 16) then + begin + WARNMS(j_common_ptr(state.cinfo), JWRN_HUFF_BAD_CODE); + jpeg_huff_decode := 0; { fake a zero as the safest result } + exit; + end; + + jpeg_huff_decode := htbl^.pub^.huffval[ int (code + htbl^.valoffset[l]) ]; +end; + + +{ Figure F.12: extend sign bit. + On some machines, a shift and add will be faster than a table lookup. } + +{$ifdef AVOID_TABLES} + +#define HUFF_EXTEND(x,s) ((x) < (1<<((s)-1)) ? (x) + (((-1)<<(s)) + 1) : (x)) + +{$else} + +{$define HUFF_EXTEND(x,s) + if (x < extend_test[s]) then + := x + extend_offset[s] + else + x;} + +const + extend_test : array[0..16-1] of int = { entry n is 2**(n-1) } + ($0000, $0001, $0002, $0004, $0008, $0010, $0020, $0040, + $0080, $0100, $0200, $0400, $0800, $1000, $2000, $4000); + +const + extend_offset : array[0..16-1] of int = { entry n is (-1 << n) + 1 } +(0, ((-1) shl 1) + 1, ((-1) shl 2) + 1, ((-1) shl 3) + 1, ((-1) shl 4) + 1, + ((-1) shl 5) + 1, ((-1) shl 6) + 1, ((-1) shl 7) + 1, ((-1) shl 8) + 1, + ((-1) shl 9) + 1, ((-1) shl 10) + 1, ((-1) shl 11) + 1,((-1) shl 12) + 1, + ((-1) shl 13) + 1, ((-1) shl 14) + 1, ((-1) shl 15) + 1); + +{$endif} { AVOID_TABLES } + + +{ Check for a restart marker & resynchronize decoder. + Returns FALSE if must suspend. } + +{LOCAL} +function process_restart (cinfo : j_decompress_ptr) : boolean; +var + entropy : huff_entropy_ptr; + ci : int; +begin + entropy := huff_entropy_ptr (cinfo^.entropy); + + { Throw away any unused bits remaining in bit buffer; } + { include any full bytes in next_marker's count of discarded bytes } + Inc(cinfo^.marker^.discarded_bytes, entropy^.bitstate.bits_left div 8); + entropy^.bitstate.bits_left := 0; + + { Advance past the RSTn marker } + if (not cinfo^.marker^.read_restart_marker (cinfo)) then + begin + process_restart := FALSE; + exit; + end; + + { Re-initialize DC predictions to 0 } + for ci := 0 to pred(cinfo^.comps_in_scan) do + entropy^.saved.last_dc_val[ci] := 0; + + { Reset restart counter } + entropy^.restarts_to_go := cinfo^.restart_interval; + + { Reset out-of-data flag, unless read_restart_marker left us smack up + against a marker. In that case we will end up treating the next data + segment as empty, and we can avoid producing bogus output pixels by + leaving the flag set. } + + if (cinfo^.unread_marker = 0) then + entropy^.pub.insufficient_data := FALSE; + + process_restart := TRUE; +end; + + +{ Decode and return one MCU's worth of Huffman-compressed coefficients. + The coefficients are reordered from zigzag order into natural array order, + but are not dequantized. + + The i'th block of the MCU is stored into the block pointed to by + MCU_data[i]. WE ASSUME THIS AREA HAS BEEN ZEROED BY THE CALLER. + (Wholesale zeroing is usually a little faster than retail...) + + Returns FALSE if data source requested suspension. In that case no + changes have been made to permanent state. (Exception: some output + coefficients may already have been assigned. This is harmless for + this module, since we'll just re-assign them on the next call.) } + +{METHODDEF} +function decode_mcu (cinfo : j_decompress_ptr; + var MCU_data : array of JBLOCKROW) : boolean; +label + label1, label2, label3; +var + entropy : huff_entropy_ptr; + {register} s, k, r : int; + blkn, ci : int; + block : JBLOCK_PTR; + {BITREAD_STATE_VARS} + get_buffer : bit_buf_type ; {register} + bits_left : int; {register} + br_state : bitread_working_state; + + state : savable_state; + dctbl : d_derived_tbl_ptr; + actbl : d_derived_tbl_ptr; +var + nb, look : int; {register} +begin + entropy := huff_entropy_ptr (cinfo^.entropy); + + { Process restart marker if needed; may have to suspend } + if (cinfo^.restart_interval <> 0) then + begin + if (entropy^.restarts_to_go = 0) then + if (not process_restart(cinfo)) then + begin + decode_mcu := FALSE; + exit; + end; + end; + + { If we've run out of data, just leave the MCU set to zeroes. + This way, we return uniform gray for the remainder of the segment. } + + if not entropy^.pub.insufficient_data then + begin + + { Load up working state } + {BITREAD_LOAD_STATE(cinfo,entropy^.bitstate);} + br_state.cinfo := cinfo; + br_state.next_input_byte := cinfo^.src^.next_input_byte; + br_state.bytes_in_buffer := cinfo^.src^.bytes_in_buffer; + get_buffer := entropy^.bitstate.get_buffer; + bits_left := entropy^.bitstate.bits_left; + + {ASSIGN_STATE(state, entropy^.saved);} + state := entropy^.saved; + + { Outer loop handles each block in the MCU } + + for blkn := 0 to pred(cinfo^.blocks_in_MCU) do + begin + block := JBLOCK_PTR(MCU_data[blkn]); + dctbl := entropy^.dc_cur_tbls[blkn]; + actbl := entropy^.ac_cur_tbls[blkn]; + + { Decode a single block's worth of coefficients } + + { Section F.2.2.1: decode the DC coefficient difference } + {HUFF_DECODE(s, br_state, dctbl, return FALSE, label1);} + if (bits_left < HUFF_LOOKAHEAD) then + begin + if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then + begin + decode_mcu := False; + exit; + end; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + if (bits_left < HUFF_LOOKAHEAD) then + begin + nb := 1; + goto label1; + end; + end; + {look := PEEK_BITS(HUFF_LOOKAHEAD);} + look := int(get_buffer shr (bits_left - HUFF_LOOKAHEAD)) and + pred(1 shl HUFF_LOOKAHEAD); + + nb := dctbl^.look_nbits[look]; + if (nb <> 0) then + begin + {DROP_BITS(nb);} + Dec(bits_left, nb); + + s := dctbl^.look_sym[look]; + end + else + begin + nb := HUFF_LOOKAHEAD+1; + label1: + s := jpeg_huff_decode(br_state,get_buffer,bits_left,dctbl,nb); + if (s < 0) then + begin + decode_mcu := FALSE; + exit; + end; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + end; + + if (s <> 0) then + begin + {CHECK_BIT_BUFFER(br_state, s, return FALSE);} + if (bits_left < s) then + begin + if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,s)) then + begin + decode_mcu := FALSE; + exit; + end; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + end; + + {r := GET_BITS(s);} + Dec(bits_left, s); + r := ( int(get_buffer shr bits_left)) and ( pred(1 shl s) ); + + {s := HUFF_EXTEND(r, s);} + if (r < extend_test[s]) then + s := r + extend_offset[s] + else + s := r; + end; + + if (entropy^.dc_needed[blkn]) then + begin + { Convert DC difference to actual value, update last_dc_val } + ci := cinfo^.MCU_membership[blkn]; + Inc(s, state.last_dc_val[ci]); + state.last_dc_val[ci] := s; + { Output the DC coefficient (assumes jpeg_natural_order[0] := 0) } + block^[0] := JCOEF (s); + end; + + if (entropy^.ac_needed[blkn]) then + begin + + { Section F.2.2.2: decode the AC coefficients } + { Since zeroes are skipped, output area must be cleared beforehand } + k := 1; + while (k < DCTSIZE2) do { Nomssi: k is incr. in the loop } + begin + {HUFF_DECODE(s, br_state, actbl, return FALSE, label2);} + if (bits_left < HUFF_LOOKAHEAD) then + begin + if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then + begin + decode_mcu := False; + exit; + end; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + if (bits_left < HUFF_LOOKAHEAD) then + begin + nb := 1; + goto label2; + end; + end; + {look := PEEK_BITS(HUFF_LOOKAHEAD);} + look := int(get_buffer shr (bits_left - HUFF_LOOKAHEAD)) and + pred(1 shl HUFF_LOOKAHEAD); + + nb := actbl^.look_nbits[look]; + if (nb <> 0) then + begin + {DROP_BITS(nb);} + Dec(bits_left, nb); + + s := actbl^.look_sym[look]; + end + else + begin + nb := HUFF_LOOKAHEAD+1; + label2: + s := jpeg_huff_decode(br_state,get_buffer,bits_left,actbl,nb); + if (s < 0) then + begin + decode_mcu := FALSE; + exit; + end; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + end; + + r := s shr 4; + s := s and 15; + + if (s <> 0) then + begin + Inc(k, r); + {CHECK_BIT_BUFFER(br_state, s, return FALSE);} + if (bits_left < s) then + begin + if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,s)) then + begin + decode_mcu := FALSE; + exit; + end; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + end; + + {r := GET_BITS(s);} + Dec(bits_left, s); + r := (int(get_buffer shr bits_left)) and ( pred(1 shl s) ); + + {s := HUFF_EXTEND(r, s);} + if (r < extend_test[s]) then + s := r + extend_offset[s] + else + s := r; + { Output coefficient in natural (dezigzagged) order. + Note: the extra entries in jpeg_natural_order[] will save us + if k >= DCTSIZE2, which could happen if the data is corrupted. } + + block^[jpeg_natural_order[k]] := JCOEF (s); + end + else + begin + if (r <> 15) then + break; + Inc(k, 15); + end; + Inc(k); + end; + end + else + begin + + { Section F.2.2.2: decode the AC coefficients } + { In this path we just discard the values } + k := 1; + while (k < DCTSIZE2) do + begin + {HUFF_DECODE(s, br_state, actbl, return FALSE, label3);} + if (bits_left < HUFF_LOOKAHEAD) then + begin + if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then + begin + decode_mcu := False; + exit; + end; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + if (bits_left < HUFF_LOOKAHEAD) then + begin + nb := 1; + goto label3; + end; + end; + {look := PEEK_BITS(HUFF_LOOKAHEAD);} + look := int(get_buffer shr (bits_left - HUFF_LOOKAHEAD)) and + pred(1 shl HUFF_LOOKAHEAD); + + nb := actbl^.look_nbits[look]; + if (nb <> 0) then + begin + {DROP_BITS(nb);} + Dec(bits_left, nb); + + s := actbl^.look_sym[look]; + end + else + begin + nb := HUFF_LOOKAHEAD+1; + label3: + s := jpeg_huff_decode(br_state,get_buffer,bits_left,actbl,nb); + if (s < 0) then + begin + decode_mcu := FALSE; + exit; + end; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + end; + + r := s shr 4; + s := s and 15; + + if (s <> 0) then + begin + Inc(k, r); + {CHECK_BIT_BUFFER(br_state, s, return FALSE);} + if (bits_left < s) then + begin + if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,s)) then + begin + decode_mcu := FALSE; + exit; + end; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + end; + + {DROP_BITS(s);} + Dec(bits_left, s); + end + else + begin + if (r <> 15) then + break; + Inc(k, 15); + end; + Inc(k); + end; + + end; + end; + + { Completed MCU, so update state } + {BITREAD_SAVE_STATE(cinfo,entropy^.bitstate);} + cinfo^.src^.next_input_byte := br_state.next_input_byte; + cinfo^.src^.bytes_in_buffer := br_state.bytes_in_buffer; + entropy^.bitstate.get_buffer := get_buffer; + entropy^.bitstate.bits_left := bits_left; + + {ASSIGN_STATE(entropy^.saved, state);} + entropy^.saved := state; + + end; + + { Account for restart interval (no-op if not using restarts) } + Dec(entropy^.restarts_to_go); + + decode_mcu := TRUE; +end; + + +{ Module initialization routine for Huffman entropy decoding. } + +{GLOBAL} +procedure jinit_huff_decoder (cinfo : j_decompress_ptr); +var + entropy : huff_entropy_ptr; + i : int; +begin + entropy := huff_entropy_ptr( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + SIZEOF(huff_entropy_decoder)) ); + cinfo^.entropy := jpeg_entropy_decoder_ptr (entropy); + entropy^.pub.start_pass := start_pass_huff_decoder; + entropy^.pub.decode_mcu := decode_mcu; + + { Mark tables unallocated } + for i := 0 to pred(NUM_HUFF_TBLS) do + begin + entropy^.dc_derived_tbls[i] := NIL; + entropy^.ac_derived_tbls[i] := NIL; + end; +end; + +end. diff --git a/Imaging/JpegLib/imjdinput.pas b/Imaging/JpegLib/imjdinput.pas index 32a4d09..16a13e2 100644 --- a/Imaging/JpegLib/imjdinput.pas +++ b/Imaging/JpegLib/imjdinput.pas @@ -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. diff --git a/Imaging/JpegLib/imjdmainct.pas b/Imaging/JpegLib/imjdmainct.pas index 6c50f63..8c04d7e 100644 --- a/Imaging/JpegLib/imjdmainct.pas +++ b/Imaging/JpegLib/imjdmainct.pas @@ -1,610 +1,610 @@ -unit imjdmainct; - - -{ This file is part of the Independent JPEG Group's software. - For conditions of distribution and use, see the accompanying README file. - - This file contains the main buffer controller for decompression. - The main buffer lies between the JPEG decompressor proper and the - post-processor; it holds downsampled data in the JPEG colorspace. - - Note that this code is bypassed in raw-data mode, since the application - supplies the equivalent of the main buffer in that case. } - -{ Original: jdmainct.c ; Copyright (C) 1994-1996, Thomas G. Lane. } - - -{ In the current system design, the main buffer need never be a full-image - buffer; any full-height buffers will be found inside the coefficient or - postprocessing controllers. Nonetheless, the main controller is not - trivial. Its responsibility is to provide context rows for upsampling/ - rescaling, and doing this in an efficient fashion is a bit tricky. - - Postprocessor input data is counted in "row groups". A row group - is defined to be (v_samp_factor * DCT_scaled_size / min_DCT_scaled_size) - sample rows of each component. (We require DCT_scaled_size values to be - chosen such that these numbers are integers. In practice DCT_scaled_size - values will likely be powers of two, so we actually have the stronger - condition that DCT_scaled_size / min_DCT_scaled_size is an integer.) - Upsampling will typically produce max_v_samp_factor pixel rows from each - row group (times any additional scale factor that the upsampler is - applying). - - The coefficient controller will deliver data to us one iMCU row at a time; - each iMCU row contains v_samp_factor * DCT_scaled_size sample rows, or - exactly min_DCT_scaled_size row groups. (This amount of data corresponds - to one row of MCUs when the image is fully interleaved.) Note that the - number of sample rows varies across components, but the number of row - groups does not. Some garbage sample rows may be included in the last iMCU - row at the bottom of the image. - - Depending on the vertical scaling algorithm used, the upsampler may need - access to the sample row(s) above and below its current input row group. - The upsampler is required to set need_context_rows TRUE at global - selection - time if so. When need_context_rows is FALSE, this controller can simply - obtain one iMCU row at a time from the coefficient controller and dole it - out as row groups to the postprocessor. - - When need_context_rows is TRUE, this controller guarantees that the buffer - passed to postprocessing contains at least one row group's worth of samples - above and below the row group(s) being processed. Note that the context - rows "above" the first passed row group appear at negative row offsets in - the passed buffer. At the top and bottom of the image, the required - context rows are manufactured by duplicating the first or last real sample - row; this avoids having special cases in the upsampling inner loops. - - The amount of context is fixed at one row group just because that's a - convenient number for this controller to work with. The existing - upsamplers really only need one sample row of context. An upsampler - supporting arbitrary output rescaling might wish for more than one row - group of context when shrinking the image; tough, we don't handle that. - (This is justified by the assumption that downsizing will be handled mostly - by adjusting the DCT_scaled_size values, so that the actual scale factor at - the upsample step needn't be much less than one.) - - To provide the desired context, we have to retain the last two row groups - of one iMCU row while reading in the next iMCU row. (The last row group - can't be processed until we have another row group for its below-context, - and so we have to save the next-to-last group too for its above-context.) - We could do this most simply by copying data around in our buffer, but - that'd be very slow. We can avoid copying any data by creating a rather - strange pointer structure. Here's how it works. We allocate a workspace - consisting of M+2 row groups (where M = min_DCT_scaled_size is the number - of row groups per iMCU row). We create two sets of redundant pointers to - the workspace. Labeling the physical row groups 0 to M+1, the synthesized - pointer lists look like this: - M+1 M-1 - master pointer --> 0 master pointer --> 0 - 1 1 - ... ... - M-3 M-3 - M-2 M - M-1 M+1 - M M-2 - M+1 M-1 - 0 0 - We read alternate iMCU rows using each master pointer; thus the last two - row groups of the previous iMCU row remain un-overwritten in the workspace. - The pointer lists are set up so that the required context rows appear to - be adjacent to the proper places when we pass the pointer lists to the - upsampler. - - The above pictures describe the normal state of the pointer lists. - At top and bottom of the image, we diddle the pointer lists to duplicate - the first or last sample row as necessary (this is cheaper than copying - sample rows around). - - This scheme breaks down if M < 2, ie, min_DCT_scaled_size is 1. In that - situation each iMCU row provides only one row group so the buffering logic - must be different (eg, we must read two iMCU rows before we can emit the - first row group). For now, we simply do not support providing context - rows when min_DCT_scaled_size is 1. That combination seems unlikely to - be worth providing --- if someone wants a 1/8th-size preview, they probably - want it quick and dirty, so a context-free upsampler is sufficient. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, -{$ifdef QUANT_2PASS_SUPPORTED} - imjquant2, -{$endif} - imjdeferr, - imjerror, - imjpeglib; - - -{GLOBAL} -procedure jinit_d_main_controller (cinfo : j_decompress_ptr; - need_full_buffer : boolean); - - -implementation - -{ Private buffer controller object } - -type - my_main_ptr = ^my_main_controller; - my_main_controller = record - pub : jpeg_d_main_controller; { public fields } - - { Pointer to allocated workspace (M or M+2 row groups). } - buffer : array[0..MAX_COMPONENTS-1] of JSAMPARRAY; - - buffer_full : boolean; { Have we gotten an iMCU row from decoder? } - rowgroup_ctr : JDIMENSION ; { counts row groups output to postprocessor } - - { Remaining fields are only used in the context case. } - - { These are the master pointers to the funny-order pointer lists. } - xbuffer : array[0..2-1] of JSAMPIMAGE; { pointers to weird pointer lists } - - whichptr : int; { indicates which pointer set is now in use } - context_state : int; { process_data state machine status } - rowgroups_avail : JDIMENSION; { row groups available to postprocessor } - iMCU_row_ctr : JDIMENSION; { counts iMCU rows to detect image top/bot } - end; { my_main_controller; } - - -{ context_state values: } -const - CTX_PREPARE_FOR_IMCU = 0; { need to prepare for MCU row } - CTX_PROCESS_IMCU = 1; { feeding iMCU to postprocessor } - CTX_POSTPONED_ROW = 2; { feeding postponed row group } - - -{ Forward declarations } -{METHODDEF} -procedure process_data_simple_main(cinfo : j_decompress_ptr; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); forward; -{METHODDEF} -procedure process_data_context_main (cinfo : j_decompress_ptr; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); forward; - -{$ifdef QUANT_2PASS_SUPPORTED} -{METHODDEF} -procedure process_data_crank_post (cinfo : j_decompress_ptr; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); forward; -{$endif} - - -{LOCAL} -procedure alloc_funny_pointers (cinfo : j_decompress_ptr); -{ Allocate space for the funny pointer lists. - This is done only once, not once per pass. } -var - main : my_main_ptr; - ci, rgroup : int; - M : int; - compptr : jpeg_component_info_ptr; - xbuf : JSAMPARRAY; -begin - main := my_main_ptr (cinfo^.main); - M := cinfo^.min_DCT_scaled_size; - - { Get top-level space for component array pointers. - We alloc both arrays with one call to save a few cycles. } - - main^.xbuffer[0] := JSAMPIMAGE ( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - cinfo^.num_components * 2 * SIZEOF(JSAMPARRAY)) ); - main^.xbuffer[1] := JSAMPIMAGE(@( main^.xbuffer[0]^[cinfo^.num_components] )); - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - rgroup := (compptr^.v_samp_factor * compptr^.DCT_scaled_size) div - cinfo^.min_DCT_scaled_size; { height of a row group of component } - { Get space for pointer lists --- M+4 row groups in each list. - We alloc both pointer lists with one call to save a few cycles. } - - xbuf := JSAMPARRAY ( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - 2 * (rgroup * (M + 4)) * SIZEOF(JSAMPROW)) ); - Inc(JSAMPROW_PTR(xbuf), rgroup); { want one row group at negative offsets } - main^.xbuffer[0]^[ci] := xbuf; - Inc(JSAMPROW_PTR(xbuf), rgroup * (M + 4)); - main^.xbuffer[1]^[ci] := xbuf; - Inc(compptr); - end; -end; - -{LOCAL} -procedure make_funny_pointers (cinfo : j_decompress_ptr); -{ Create the funny pointer lists discussed in the comments above. - The actual workspace is already allocated (in main^.buffer), - and the space for the pointer lists is allocated too. - This routine just fills in the curiously ordered lists. - This will be repeated at the beginning of each pass. } -var - main : my_main_ptr; - ci, i, rgroup : int; - M : int; - compptr : jpeg_component_info_ptr; - buf, xbuf0, xbuf1 : JSAMPARRAY; -var - help_xbuf0 : JSAMPARRAY; { work around negative offsets } -begin - main := my_main_ptr (cinfo^.main); - M := cinfo^.min_DCT_scaled_size; - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - rgroup := (compptr^.v_samp_factor * compptr^.DCT_scaled_size) div - cinfo^.min_DCT_scaled_size; { height of a row group of component } - xbuf0 := main^.xbuffer[0]^[ci]; - xbuf1 := main^.xbuffer[1]^[ci]; - { First copy the workspace pointers as-is } - buf := main^.buffer[ci]; - for i := 0 to pred(rgroup * (M + 2)) do - begin - xbuf0^[i] := buf^[i]; - xbuf1^[i] := buf^[i]; - end; - { In the second list, put the last four row groups in swapped order } - for i := 0 to pred(rgroup * 2) do - begin - xbuf1^[rgroup*(M-2) + i] := buf^[rgroup*M + i]; - xbuf1^[rgroup*M + i] := buf^[rgroup*(M-2) + i]; - end; - { The wraparound pointers at top and bottom will be filled later - (see set_wraparound_pointers, below). Initially we want the "above" - pointers to duplicate the first actual data line. This only needs - to happen in xbuffer[0]. } - - help_xbuf0 := xbuf0; - Dec(JSAMPROW_PTR(help_xbuf0), rgroup); - - for i := 0 to pred(rgroup) do - begin - {xbuf0^[i - rgroup] := xbuf0^[0];} - help_xbuf0^[i] := xbuf0^[0]; - end; - Inc(compptr); - end; -end; - - -{LOCAL} -procedure set_wraparound_pointers (cinfo : j_decompress_ptr); -{ Set up the "wraparound" pointers at top and bottom of the pointer lists. - This changes the pointer list state from top-of-image to the normal state. } -var - main : my_main_ptr; - ci, i, rgroup : int; - M : int; - compptr : jpeg_component_info_ptr; - xbuf0, xbuf1 : JSAMPARRAY; -var - help_xbuf0, - help_xbuf1 : JSAMPARRAY; { work around negative offsets } -begin - main := my_main_ptr (cinfo^.main); - M := cinfo^.min_DCT_scaled_size; - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - rgroup := (compptr^.v_samp_factor * compptr^.DCT_scaled_size) div - cinfo^.min_DCT_scaled_size; { height of a row group of component } - xbuf0 := main^.xbuffer[0]^[ci]; - xbuf1 := main^.xbuffer[1]^[ci]; - - help_xbuf0 := xbuf0; - Dec(JSAMPROW_PTR(help_xbuf0), rgroup); - help_xbuf1 := xbuf1; - Dec(JSAMPROW_PTR(help_xbuf1), rgroup); - - for i := 0 to pred(rgroup) do - begin - {xbuf0^[i - rgroup] := xbuf0^[rgroup*(M+1) + i]; - xbuf1^[i - rgroup] := xbuf1^[rgroup*(M+1) + i];} - - help_xbuf0^[i] := xbuf0^[rgroup*(M+1) + i]; - help_xbuf1^[i] := xbuf1^[rgroup*(M+1) + i]; - - xbuf0^[rgroup*(M+2) + i] := xbuf0^[i]; - xbuf1^[rgroup*(M+2) + i] := xbuf1^[i]; - end; - Inc(compptr); - end; -end; - - -{LOCAL} -procedure set_bottom_pointers (cinfo : j_decompress_ptr); -{ Change the pointer lists to duplicate the last sample row at the bottom - of the image. whichptr indicates which xbuffer holds the final iMCU row. - Also sets rowgroups_avail to indicate number of nondummy row groups in row. } -var - main : my_main_ptr; - ci, i, rgroup, iMCUheight, rows_left : int; - compptr : jpeg_component_info_ptr; - xbuf : JSAMPARRAY; -begin - main := my_main_ptr (cinfo^.main); - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - { Count sample rows in one iMCU row and in one row group } - iMCUheight := compptr^.v_samp_factor * compptr^.DCT_scaled_size; - rgroup := iMCUheight div cinfo^.min_DCT_scaled_size; - { Count nondummy sample rows remaining for this component } - rows_left := int (compptr^.downsampled_height mod JDIMENSION (iMCUheight)); - if (rows_left = 0) then - rows_left := iMCUheight; - { Count nondummy row groups. Should get same answer for each component, - so we need only do it once. } - if (ci = 0) then - begin - main^.rowgroups_avail := JDIMENSION ((rows_left-1) div rgroup + 1); - end; - { Duplicate the last real sample row rgroup*2 times; this pads out the - last partial rowgroup and ensures at least one full rowgroup of context. } - - xbuf := main^.xbuffer[main^.whichptr]^[ci]; - for i := 0 to pred(rgroup * 2) do - begin - xbuf^[rows_left + i] := xbuf^[rows_left-1]; - end; - Inc(compptr); - end; -end; - - -{ Initialize for a processing pass. } - -{METHODDEF} -procedure start_pass_main (cinfo : j_decompress_ptr; - pass_mode : J_BUF_MODE); -var - main : my_main_ptr; -begin - main := my_main_ptr (cinfo^.main); - - case (pass_mode) of - JBUF_PASS_THRU: - begin - if (cinfo^.upsample^.need_context_rows) then - begin - main^.pub.process_data := process_data_context_main; - make_funny_pointers(cinfo); { Create the xbuffer[] lists } - main^.whichptr := 0; { Read first iMCU row into xbuffer[0] } - main^.context_state := CTX_PREPARE_FOR_IMCU; - main^.iMCU_row_ctr := 0; - end - else - begin - { Simple case with no context needed } - main^.pub.process_data := process_data_simple_main; - end; - main^.buffer_full := FALSE; { Mark buffer empty } - main^.rowgroup_ctr := 0; - end; -{$ifdef QUANT_2PASS_SUPPORTED} - JBUF_CRANK_DEST: - { For last pass of 2-pass quantization, just crank the postprocessor } - main^.pub.process_data := process_data_crank_post; -{$endif} - else - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); - end; -end; - - -{ Process some data. - This handles the simple case where no context is required. } - -{METHODDEF} -procedure process_data_simple_main (cinfo : j_decompress_ptr; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); -var - main : my_main_ptr; - rowgroups_avail : JDIMENSION; -var - main_buffer_ptr : JSAMPIMAGE; -begin - main := my_main_ptr (cinfo^.main); - main_buffer_ptr := JSAMPIMAGE(@(main^.buffer)); - - { Read input data if we haven't filled the main buffer yet } - if (not main^.buffer_full) then - begin - if (cinfo^.coef^.decompress_data (cinfo, main_buffer_ptr)=0) then - exit; { suspension forced, can do nothing more } - main^.buffer_full := TRUE; { OK, we have an iMCU row to work with } - end; - - { There are always min_DCT_scaled_size row groups in an iMCU row. } - rowgroups_avail := JDIMENSION (cinfo^.min_DCT_scaled_size); - { Note: at the bottom of the image, we may pass extra garbage row groups - to the postprocessor. The postprocessor has to check for bottom - of image anyway (at row resolution), so no point in us doing it too. } - - { Feed the postprocessor } - cinfo^.post^.post_process_data (cinfo, main_buffer_ptr, - main^.rowgroup_ctr, rowgroups_avail, - output_buf, out_row_ctr, out_rows_avail); - - { Has postprocessor consumed all the data yet? If so, mark buffer empty } - if (main^.rowgroup_ctr >= rowgroups_avail) then - begin - main^.buffer_full := FALSE; - main^.rowgroup_ctr := 0; - end; -end; - - -{ Process some data. - This handles the case where context rows must be provided. } - -{METHODDEF} -procedure process_data_context_main (cinfo : j_decompress_ptr; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); -var - main : my_main_ptr; -begin - main := my_main_ptr (cinfo^.main); - - { Read input data if we haven't filled the main buffer yet } - if (not main^.buffer_full) then - begin - if (cinfo^.coef^.decompress_data (cinfo, - main^.xbuffer[main^.whichptr])=0) then - exit; { suspension forced, can do nothing more } - main^.buffer_full := TRUE; { OK, we have an iMCU row to work with } - Inc(main^.iMCU_row_ctr); { count rows received } - end; - - { Postprocessor typically will not swallow all the input data it is handed - in one call (due to filling the output buffer first). Must be prepared - to exit and restart. This switch lets us keep track of how far we got. - Note that each case falls through to the next on successful completion. } - - case (main^.context_state) of - CTX_POSTPONED_ROW: - begin - { Call postprocessor using previously set pointers for postponed row } - cinfo^.post^.post_process_data (cinfo, main^.xbuffer[main^.whichptr], - main^.rowgroup_ctr, main^.rowgroups_avail, - output_buf, out_row_ctr, out_rows_avail); - if (main^.rowgroup_ctr < main^.rowgroups_avail) then - exit; { Need to suspend } - main^.context_state := CTX_PREPARE_FOR_IMCU; - if (out_row_ctr >= out_rows_avail) then - exit; { Postprocessor exactly filled output buf } - end; - end; - case (main^.context_state) of - CTX_POSTPONED_ROW, - CTX_PREPARE_FOR_IMCU: {FALLTHROUGH} - begin - { Prepare to process first M-1 row groups of this iMCU row } - main^.rowgroup_ctr := 0; - main^.rowgroups_avail := JDIMENSION (cinfo^.min_DCT_scaled_size - 1); - { Check for bottom of image: if so, tweak pointers to "duplicate" - the last sample row, and adjust rowgroups_avail to ignore padding rows. } - - if (main^.iMCU_row_ctr = cinfo^.total_iMCU_rows) then - set_bottom_pointers(cinfo); - main^.context_state := CTX_PROCESS_IMCU; - - end; - end; - case (main^.context_state) of - CTX_POSTPONED_ROW, - CTX_PREPARE_FOR_IMCU, {FALLTHROUGH} - CTX_PROCESS_IMCU: - begin - { Call postprocessor using previously set pointers } - cinfo^.post^.post_process_data (cinfo, main^.xbuffer[main^.whichptr], - main^.rowgroup_ctr, main^.rowgroups_avail, - output_buf, out_row_ctr, out_rows_avail); - if (main^.rowgroup_ctr < main^.rowgroups_avail) then - exit; { Need to suspend } - { After the first iMCU, change wraparound pointers to normal state } - if (main^.iMCU_row_ctr = 1) then - set_wraparound_pointers(cinfo); - { Prepare to load new iMCU row using other xbuffer list } - main^.whichptr := main^.whichptr xor 1; { 0=>1 or 1=>0 } - main^.buffer_full := FALSE; - { Still need to process last row group of this iMCU row, } - { which is saved at index M+1 of the other xbuffer } - main^.rowgroup_ctr := JDIMENSION (cinfo^.min_DCT_scaled_size + 1); - main^.rowgroups_avail := JDIMENSION (cinfo^.min_DCT_scaled_size + 2); - main^.context_state := CTX_POSTPONED_ROW; - end; - end; -end; - - -{ Process some data. - Final pass of two-pass quantization: just call the postprocessor. - Source data will be the postprocessor controller's internal buffer. } - -{$ifdef QUANT_2PASS_SUPPORTED} - -{METHODDEF} -procedure process_data_crank_post (cinfo : j_decompress_ptr; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); -var - in_row_group_ctr : JDIMENSION; -begin - in_row_group_ctr := 0; - cinfo^.post^.post_process_data (cinfo, JSAMPIMAGE (NIL), - in_row_group_ctr, - JDIMENSION(0), - output_buf, - out_row_ctr, - out_rows_avail); -end; - -{$endif} { QUANT_2PASS_SUPPORTED } - - -{ Initialize main buffer controller. } - -{GLOBAL} -procedure jinit_d_main_controller (cinfo : j_decompress_ptr; - need_full_buffer : boolean); -var - main : my_main_ptr; - ci, rgroup, ngroups : 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_d_main_controller_ptr(main); - main^.pub.start_pass := start_pass_main; - - if (need_full_buffer) then { shouldn't happen } - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); - - { Allocate the workspace. - ngroups is the number of row groups we need.} - - if (cinfo^.upsample^.need_context_rows) then - begin - if (cinfo^.min_DCT_scaled_size < 2) then { unsupported, see comments above } - ERREXIT(j_common_ptr(cinfo), JERR_NOTIMPL); - alloc_funny_pointers(cinfo); { Alloc space for xbuffer[] lists } - ngroups := cinfo^.min_DCT_scaled_size + 2; - end - else - begin - ngroups := cinfo^.min_DCT_scaled_size; - end; - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - rgroup := (compptr^.v_samp_factor * compptr^.DCT_scaled_size) div - cinfo^.min_DCT_scaled_size; { height of a row group of component } - main^.buffer[ci] := cinfo^.mem^.alloc_sarray - (j_common_ptr(cinfo), JPOOL_IMAGE, - compptr^.width_in_blocks * LongWord(compptr^.DCT_scaled_size), - JDIMENSION (rgroup * ngroups)); - Inc(compptr); - end; -end; - -end. +unit imjdmainct; + + +{ This file is part of the Independent JPEG Group's software. + For conditions of distribution and use, see the accompanying README file. + + This file contains the main buffer controller for decompression. + The main buffer lies between the JPEG decompressor proper and the + post-processor; it holds downsampled data in the JPEG colorspace. + + Note that this code is bypassed in raw-data mode, since the application + supplies the equivalent of the main buffer in that case. } + +{ Original: jdmainct.c ; Copyright (C) 1994-1996, Thomas G. Lane. } + + +{ In the current system design, the main buffer need never be a full-image + buffer; any full-height buffers will be found inside the coefficient or + postprocessing controllers. Nonetheless, the main controller is not + trivial. Its responsibility is to provide context rows for upsampling/ + rescaling, and doing this in an efficient fashion is a bit tricky. + + Postprocessor input data is counted in "row groups". A row group + is defined to be (v_samp_factor * DCT_scaled_size / min_DCT_scaled_size) + sample rows of each component. (We require DCT_scaled_size values to be + chosen such that these numbers are integers. In practice DCT_scaled_size + values will likely be powers of two, so we actually have the stronger + condition that DCT_scaled_size / min_DCT_scaled_size is an integer.) + Upsampling will typically produce max_v_samp_factor pixel rows from each + row group (times any additional scale factor that the upsampler is + applying). + + The coefficient controller will deliver data to us one iMCU row at a time; + each iMCU row contains v_samp_factor * DCT_scaled_size sample rows, or + exactly min_DCT_scaled_size row groups. (This amount of data corresponds + to one row of MCUs when the image is fully interleaved.) Note that the + number of sample rows varies across components, but the number of row + groups does not. Some garbage sample rows may be included in the last iMCU + row at the bottom of the image. + + Depending on the vertical scaling algorithm used, the upsampler may need + access to the sample row(s) above and below its current input row group. + The upsampler is required to set need_context_rows TRUE at global + selection + time if so. When need_context_rows is FALSE, this controller can simply + obtain one iMCU row at a time from the coefficient controller and dole it + out as row groups to the postprocessor. + + When need_context_rows is TRUE, this controller guarantees that the buffer + passed to postprocessing contains at least one row group's worth of samples + above and below the row group(s) being processed. Note that the context + rows "above" the first passed row group appear at negative row offsets in + the passed buffer. At the top and bottom of the image, the required + context rows are manufactured by duplicating the first or last real sample + row; this avoids having special cases in the upsampling inner loops. + + The amount of context is fixed at one row group just because that's a + convenient number for this controller to work with. The existing + upsamplers really only need one sample row of context. An upsampler + supporting arbitrary output rescaling might wish for more than one row + group of context when shrinking the image; tough, we don't handle that. + (This is justified by the assumption that downsizing will be handled mostly + by adjusting the DCT_scaled_size values, so that the actual scale factor at + the upsample step needn't be much less than one.) + + To provide the desired context, we have to retain the last two row groups + of one iMCU row while reading in the next iMCU row. (The last row group + can't be processed until we have another row group for its below-context, + and so we have to save the next-to-last group too for its above-context.) + We could do this most simply by copying data around in our buffer, but + that'd be very slow. We can avoid copying any data by creating a rather + strange pointer structure. Here's how it works. We allocate a workspace + consisting of M+2 row groups (where M = min_DCT_scaled_size is the number + of row groups per iMCU row). We create two sets of redundant pointers to + the workspace. Labeling the physical row groups 0 to M+1, the synthesized + pointer lists look like this: + M+1 M-1 + master pointer --> 0 master pointer --> 0 + 1 1 + ... ... + M-3 M-3 + M-2 M + M-1 M+1 + M M-2 + M+1 M-1 + 0 0 + We read alternate iMCU rows using each master pointer; thus the last two + row groups of the previous iMCU row remain un-overwritten in the workspace. + The pointer lists are set up so that the required context rows appear to + be adjacent to the proper places when we pass the pointer lists to the + upsampler. + + The above pictures describe the normal state of the pointer lists. + At top and bottom of the image, we diddle the pointer lists to duplicate + the first or last sample row as necessary (this is cheaper than copying + sample rows around). + + This scheme breaks down if M < 2, ie, min_DCT_scaled_size is 1. In that + situation each iMCU row provides only one row group so the buffering logic + must be different (eg, we must read two iMCU rows before we can emit the + first row group). For now, we simply do not support providing context + rows when min_DCT_scaled_size is 1. That combination seems unlikely to + be worth providing --- if someone wants a 1/8th-size preview, they probably + want it quick and dirty, so a context-free upsampler is sufficient. } + +interface + +{$I imjconfig.inc} + +uses + imjmorecfg, + imjinclude, +{$ifdef QUANT_2PASS_SUPPORTED} + imjquant2, +{$endif} + imjdeferr, + imjerror, + imjpeglib; + + +{GLOBAL} +procedure jinit_d_main_controller (cinfo : j_decompress_ptr; + need_full_buffer : boolean); + + +implementation + +{ Private buffer controller object } + +type + my_main_ptr = ^my_main_controller; + my_main_controller = record + pub : jpeg_d_main_controller; { public fields } + + { Pointer to allocated workspace (M or M+2 row groups). } + buffer : array[0..MAX_COMPONENTS-1] of JSAMPARRAY; + + buffer_full : boolean; { Have we gotten an iMCU row from decoder? } + rowgroup_ctr : JDIMENSION ; { counts row groups output to postprocessor } + + { Remaining fields are only used in the context case. } + + { These are the master pointers to the funny-order pointer lists. } + xbuffer : array[0..2-1] of JSAMPIMAGE; { pointers to weird pointer lists } + + whichptr : int; { indicates which pointer set is now in use } + context_state : int; { process_data state machine status } + rowgroups_avail : JDIMENSION; { row groups available to postprocessor } + iMCU_row_ctr : JDIMENSION; { counts iMCU rows to detect image top/bot } + end; { my_main_controller; } + + +{ context_state values: } +const + CTX_PREPARE_FOR_IMCU = 0; { need to prepare for MCU row } + CTX_PROCESS_IMCU = 1; { feeding iMCU to postprocessor } + CTX_POSTPONED_ROW = 2; { feeding postponed row group } + + +{ Forward declarations } +{METHODDEF} +procedure process_data_simple_main(cinfo : j_decompress_ptr; + output_buf : JSAMPARRAY; + var out_row_ctr : JDIMENSION; + out_rows_avail : JDIMENSION); forward; +{METHODDEF} +procedure process_data_context_main (cinfo : j_decompress_ptr; + output_buf : JSAMPARRAY; + var out_row_ctr : JDIMENSION; + out_rows_avail : JDIMENSION); forward; + +{$ifdef QUANT_2PASS_SUPPORTED} +{METHODDEF} +procedure process_data_crank_post (cinfo : j_decompress_ptr; + output_buf : JSAMPARRAY; + var out_row_ctr : JDIMENSION; + out_rows_avail : JDIMENSION); forward; +{$endif} + + +{LOCAL} +procedure alloc_funny_pointers (cinfo : j_decompress_ptr); +{ Allocate space for the funny pointer lists. + This is done only once, not once per pass. } +var + main : my_main_ptr; + ci, rgroup : int; + M : int; + compptr : jpeg_component_info_ptr; + xbuf : JSAMPARRAY; +begin + main := my_main_ptr (cinfo^.main); + M := cinfo^.min_DCT_scaled_size; + + { Get top-level space for component array pointers. + We alloc both arrays with one call to save a few cycles. } + + main^.xbuffer[0] := JSAMPIMAGE ( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + cinfo^.num_components * 2 * SIZEOF(JSAMPARRAY)) ); + main^.xbuffer[1] := JSAMPIMAGE(@( main^.xbuffer[0]^[cinfo^.num_components] )); + + compptr := jpeg_component_info_ptr(cinfo^.comp_info); + for ci := 0 to pred(cinfo^.num_components) do + begin + rgroup := (compptr^.v_samp_factor * compptr^.DCT_scaled_size) div + cinfo^.min_DCT_scaled_size; { height of a row group of component } + { Get space for pointer lists --- M+4 row groups in each list. + We alloc both pointer lists with one call to save a few cycles. } + + xbuf := JSAMPARRAY ( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + 2 * (rgroup * (M + 4)) * SIZEOF(JSAMPROW)) ); + Inc(JSAMPROW_PTR(xbuf), rgroup); { want one row group at negative offsets } + main^.xbuffer[0]^[ci] := xbuf; + Inc(JSAMPROW_PTR(xbuf), rgroup * (M + 4)); + main^.xbuffer[1]^[ci] := xbuf; + Inc(compptr); + end; +end; + +{LOCAL} +procedure make_funny_pointers (cinfo : j_decompress_ptr); +{ Create the funny pointer lists discussed in the comments above. + The actual workspace is already allocated (in main^.buffer), + and the space for the pointer lists is allocated too. + This routine just fills in the curiously ordered lists. + This will be repeated at the beginning of each pass. } +var + main : my_main_ptr; + ci, i, rgroup : int; + M : int; + compptr : jpeg_component_info_ptr; + buf, xbuf0, xbuf1 : JSAMPARRAY; +var + help_xbuf0 : JSAMPARRAY; { work around negative offsets } +begin + main := my_main_ptr (cinfo^.main); + M := cinfo^.min_DCT_scaled_size; + + compptr := jpeg_component_info_ptr(cinfo^.comp_info); + for ci := 0 to pred(cinfo^.num_components) do + begin + rgroup := (compptr^.v_samp_factor * compptr^.DCT_scaled_size) div + cinfo^.min_DCT_scaled_size; { height of a row group of component } + xbuf0 := main^.xbuffer[0]^[ci]; + xbuf1 := main^.xbuffer[1]^[ci]; + { First copy the workspace pointers as-is } + buf := main^.buffer[ci]; + for i := 0 to pred(rgroup * (M + 2)) do + begin + xbuf0^[i] := buf^[i]; + xbuf1^[i] := buf^[i]; + end; + { In the second list, put the last four row groups in swapped order } + for i := 0 to pred(rgroup * 2) do + begin + xbuf1^[rgroup*(M-2) + i] := buf^[rgroup*M + i]; + xbuf1^[rgroup*M + i] := buf^[rgroup*(M-2) + i]; + end; + { The wraparound pointers at top and bottom will be filled later + (see set_wraparound_pointers, below). Initially we want the "above" + pointers to duplicate the first actual data line. This only needs + to happen in xbuffer[0]. } + + help_xbuf0 := xbuf0; + Dec(JSAMPROW_PTR(help_xbuf0), rgroup); + + for i := 0 to pred(rgroup) do + begin + {xbuf0^[i - rgroup] := xbuf0^[0];} + help_xbuf0^[i] := xbuf0^[0]; + end; + Inc(compptr); + end; +end; + + +{LOCAL} +procedure set_wraparound_pointers (cinfo : j_decompress_ptr); +{ Set up the "wraparound" pointers at top and bottom of the pointer lists. + This changes the pointer list state from top-of-image to the normal state. } +var + main : my_main_ptr; + ci, i, rgroup : int; + M : int; + compptr : jpeg_component_info_ptr; + xbuf0, xbuf1 : JSAMPARRAY; +var + help_xbuf0, + help_xbuf1 : JSAMPARRAY; { work around negative offsets } +begin + main := my_main_ptr (cinfo^.main); + M := cinfo^.min_DCT_scaled_size; + + compptr := jpeg_component_info_ptr(cinfo^.comp_info); + for ci := 0 to pred(cinfo^.num_components) do + begin + rgroup := (compptr^.v_samp_factor * compptr^.DCT_scaled_size) div + cinfo^.min_DCT_scaled_size; { height of a row group of component } + xbuf0 := main^.xbuffer[0]^[ci]; + xbuf1 := main^.xbuffer[1]^[ci]; + + help_xbuf0 := xbuf0; + Dec(JSAMPROW_PTR(help_xbuf0), rgroup); + help_xbuf1 := xbuf1; + Dec(JSAMPROW_PTR(help_xbuf1), rgroup); + + for i := 0 to pred(rgroup) do + begin + {xbuf0^[i - rgroup] := xbuf0^[rgroup*(M+1) + i]; + xbuf1^[i - rgroup] := xbuf1^[rgroup*(M+1) + i];} + + help_xbuf0^[i] := xbuf0^[rgroup*(M+1) + i]; + help_xbuf1^[i] := xbuf1^[rgroup*(M+1) + i]; + + xbuf0^[rgroup*(M+2) + i] := xbuf0^[i]; + xbuf1^[rgroup*(M+2) + i] := xbuf1^[i]; + end; + Inc(compptr); + end; +end; + + +{LOCAL} +procedure set_bottom_pointers (cinfo : j_decompress_ptr); +{ Change the pointer lists to duplicate the last sample row at the bottom + of the image. whichptr indicates which xbuffer holds the final iMCU row. + Also sets rowgroups_avail to indicate number of nondummy row groups in row. } +var + main : my_main_ptr; + ci, i, rgroup, iMCUheight, rows_left : int; + compptr : jpeg_component_info_ptr; + xbuf : JSAMPARRAY; +begin + main := my_main_ptr (cinfo^.main); + + compptr := jpeg_component_info_ptr(cinfo^.comp_info); + for ci := 0 to pred(cinfo^.num_components) do + begin + { Count sample rows in one iMCU row and in one row group } + iMCUheight := compptr^.v_samp_factor * compptr^.DCT_scaled_size; + rgroup := iMCUheight div cinfo^.min_DCT_scaled_size; + { Count nondummy sample rows remaining for this component } + rows_left := int (compptr^.downsampled_height mod JDIMENSION (iMCUheight)); + if (rows_left = 0) then + rows_left := iMCUheight; + { Count nondummy row groups. Should get same answer for each component, + so we need only do it once. } + if (ci = 0) then + begin + main^.rowgroups_avail := JDIMENSION ((rows_left-1) div rgroup + 1); + end; + { Duplicate the last real sample row rgroup*2 times; this pads out the + last partial rowgroup and ensures at least one full rowgroup of context. } + + xbuf := main^.xbuffer[main^.whichptr]^[ci]; + for i := 0 to pred(rgroup * 2) do + begin + xbuf^[rows_left + i] := xbuf^[rows_left-1]; + end; + Inc(compptr); + end; +end; + + +{ Initialize for a processing pass. } + +{METHODDEF} +procedure start_pass_main (cinfo : j_decompress_ptr; + pass_mode : J_BUF_MODE); +var + main : my_main_ptr; +begin + main := my_main_ptr (cinfo^.main); + + case (pass_mode) of + JBUF_PASS_THRU: + begin + if (cinfo^.upsample^.need_context_rows) then + begin + main^.pub.process_data := process_data_context_main; + make_funny_pointers(cinfo); { Create the xbuffer[] lists } + main^.whichptr := 0; { Read first iMCU row into xbuffer[0] } + main^.context_state := CTX_PREPARE_FOR_IMCU; + main^.iMCU_row_ctr := 0; + end + else + begin + { Simple case with no context needed } + main^.pub.process_data := process_data_simple_main; + end; + main^.buffer_full := FALSE; { Mark buffer empty } + main^.rowgroup_ctr := 0; + end; +{$ifdef QUANT_2PASS_SUPPORTED} + JBUF_CRANK_DEST: + { For last pass of 2-pass quantization, just crank the postprocessor } + main^.pub.process_data := process_data_crank_post; +{$endif} + else + ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); + end; +end; + + +{ Process some data. + This handles the simple case where no context is required. } + +{METHODDEF} +procedure process_data_simple_main (cinfo : j_decompress_ptr; + output_buf : JSAMPARRAY; + var out_row_ctr : JDIMENSION; + out_rows_avail : JDIMENSION); +var + main : my_main_ptr; + rowgroups_avail : JDIMENSION; +var + main_buffer_ptr : JSAMPIMAGE; +begin + main := my_main_ptr (cinfo^.main); + main_buffer_ptr := JSAMPIMAGE(@(main^.buffer)); + + { Read input data if we haven't filled the main buffer yet } + if (not main^.buffer_full) then + begin + if (cinfo^.coef^.decompress_data (cinfo, main_buffer_ptr)=0) then + exit; { suspension forced, can do nothing more } + main^.buffer_full := TRUE; { OK, we have an iMCU row to work with } + end; + + { There are always min_DCT_scaled_size row groups in an iMCU row. } + rowgroups_avail := JDIMENSION (cinfo^.min_DCT_scaled_size); + { Note: at the bottom of the image, we may pass extra garbage row groups + to the postprocessor. The postprocessor has to check for bottom + of image anyway (at row resolution), so no point in us doing it too. } + + { Feed the postprocessor } + cinfo^.post^.post_process_data (cinfo, main_buffer_ptr, + main^.rowgroup_ctr, rowgroups_avail, + output_buf, out_row_ctr, out_rows_avail); + + { Has postprocessor consumed all the data yet? If so, mark buffer empty } + if (main^.rowgroup_ctr >= rowgroups_avail) then + begin + main^.buffer_full := FALSE; + main^.rowgroup_ctr := 0; + end; +end; + + +{ Process some data. + This handles the case where context rows must be provided. } + +{METHODDEF} +procedure process_data_context_main (cinfo : j_decompress_ptr; + output_buf : JSAMPARRAY; + var out_row_ctr : JDIMENSION; + out_rows_avail : JDIMENSION); +var + main : my_main_ptr; +begin + main := my_main_ptr (cinfo^.main); + + { Read input data if we haven't filled the main buffer yet } + if (not main^.buffer_full) then + begin + if (cinfo^.coef^.decompress_data (cinfo, + main^.xbuffer[main^.whichptr])=0) then + exit; { suspension forced, can do nothing more } + main^.buffer_full := TRUE; { OK, we have an iMCU row to work with } + Inc(main^.iMCU_row_ctr); { count rows received } + end; + + { Postprocessor typically will not swallow all the input data it is handed + in one call (due to filling the output buffer first). Must be prepared + to exit and restart. This switch lets us keep track of how far we got. + Note that each case falls through to the next on successful completion. } + + case (main^.context_state) of + CTX_POSTPONED_ROW: + begin + { Call postprocessor using previously set pointers for postponed row } + cinfo^.post^.post_process_data (cinfo, main^.xbuffer[main^.whichptr], + main^.rowgroup_ctr, main^.rowgroups_avail, + output_buf, out_row_ctr, out_rows_avail); + if (main^.rowgroup_ctr < main^.rowgroups_avail) then + exit; { Need to suspend } + main^.context_state := CTX_PREPARE_FOR_IMCU; + if (out_row_ctr >= out_rows_avail) then + exit; { Postprocessor exactly filled output buf } + end; + end; + case (main^.context_state) of + CTX_POSTPONED_ROW, + CTX_PREPARE_FOR_IMCU: {FALLTHROUGH} + begin + { Prepare to process first M-1 row groups of this iMCU row } + main^.rowgroup_ctr := 0; + main^.rowgroups_avail := JDIMENSION (cinfo^.min_DCT_scaled_size - 1); + { Check for bottom of image: if so, tweak pointers to "duplicate" + the last sample row, and adjust rowgroups_avail to ignore padding rows. } + + if (main^.iMCU_row_ctr = cinfo^.total_iMCU_rows) then + set_bottom_pointers(cinfo); + main^.context_state := CTX_PROCESS_IMCU; + + end; + end; + case (main^.context_state) of + CTX_POSTPONED_ROW, + CTX_PREPARE_FOR_IMCU, {FALLTHROUGH} + CTX_PROCESS_IMCU: + begin + { Call postprocessor using previously set pointers } + cinfo^.post^.post_process_data (cinfo, main^.xbuffer[main^.whichptr], + main^.rowgroup_ctr, main^.rowgroups_avail, + output_buf, out_row_ctr, out_rows_avail); + if (main^.rowgroup_ctr < main^.rowgroups_avail) then + exit; { Need to suspend } + { After the first iMCU, change wraparound pointers to normal state } + if (main^.iMCU_row_ctr = 1) then + set_wraparound_pointers(cinfo); + { Prepare to load new iMCU row using other xbuffer list } + main^.whichptr := main^.whichptr xor 1; { 0=>1 or 1=>0 } + main^.buffer_full := FALSE; + { Still need to process last row group of this iMCU row, } + { which is saved at index M+1 of the other xbuffer } + main^.rowgroup_ctr := JDIMENSION (cinfo^.min_DCT_scaled_size + 1); + main^.rowgroups_avail := JDIMENSION (cinfo^.min_DCT_scaled_size + 2); + main^.context_state := CTX_POSTPONED_ROW; + end; + end; +end; + + +{ Process some data. + Final pass of two-pass quantization: just call the postprocessor. + Source data will be the postprocessor controller's internal buffer. } + +{$ifdef QUANT_2PASS_SUPPORTED} + +{METHODDEF} +procedure process_data_crank_post (cinfo : j_decompress_ptr; + output_buf : JSAMPARRAY; + var out_row_ctr : JDIMENSION; + out_rows_avail : JDIMENSION); +var + in_row_group_ctr : JDIMENSION; +begin + in_row_group_ctr := 0; + cinfo^.post^.post_process_data (cinfo, JSAMPIMAGE (NIL), + in_row_group_ctr, + JDIMENSION(0), + output_buf, + out_row_ctr, + out_rows_avail); +end; + +{$endif} { QUANT_2PASS_SUPPORTED } + + +{ Initialize main buffer controller. } + +{GLOBAL} +procedure jinit_d_main_controller (cinfo : j_decompress_ptr; + need_full_buffer : boolean); +var + main : my_main_ptr; + ci, rgroup, ngroups : 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_d_main_controller_ptr(main); + main^.pub.start_pass := start_pass_main; + + if (need_full_buffer) then { shouldn't happen } + ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); + + { Allocate the workspace. + ngroups is the number of row groups we need.} + + if (cinfo^.upsample^.need_context_rows) then + begin + if (cinfo^.min_DCT_scaled_size < 2) then { unsupported, see comments above } + ERREXIT(j_common_ptr(cinfo), JERR_NOTIMPL); + alloc_funny_pointers(cinfo); { Alloc space for xbuffer[] lists } + ngroups := cinfo^.min_DCT_scaled_size + 2; + end + else + begin + ngroups := cinfo^.min_DCT_scaled_size; + end; + + compptr := jpeg_component_info_ptr(cinfo^.comp_info); + for ci := 0 to pred(cinfo^.num_components) do + begin + rgroup := (compptr^.v_samp_factor * compptr^.DCT_scaled_size) div + cinfo^.min_DCT_scaled_size; { height of a row group of component } + main^.buffer[ci] := cinfo^.mem^.alloc_sarray + (j_common_ptr(cinfo), JPOOL_IMAGE, + compptr^.width_in_blocks * LongWord(compptr^.DCT_scaled_size), + JDIMENSION (rgroup * ngroups)); + Inc(compptr); + end; +end; + +end. diff --git a/Imaging/JpegLib/imjdmaster.pas b/Imaging/JpegLib/imjdmaster.pas index f78e928..076eeec 100644 --- a/Imaging/JpegLib/imjdmaster.pas +++ b/Imaging/JpegLib/imjdmaster.pas @@ -1,679 +1,679 @@ -unit imjdmaster; - -{ This file contains master control logic for the JPEG decompressor. - These routines are concerned with selecting the modules to be executed - and with determining the number of passes and the work to be done in each - pass. } - -{ Original: jdmaster.c ; Copyright (C) 1991-1998, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjutils, - imjerror, - imjdeferr, - imjdcolor, imjdsample, imjdpostct, imjddctmgr, imjdphuff, - imjdhuff, imjdcoefct, imjdmainct, -{$ifdef QUANT_1PASS_SUPPORTED} - imjquant1, -{$endif} -{$ifdef QUANT_2PASS_SUPPORTED} - imjquant2, -{$endif} -{$ifdef UPSAMPLE_MERGING_SUPPORTED} - imjdmerge, -{$endif} - imjpeglib; - - -{ Compute output image dimensions and related values. - NOTE: this is exported for possible use by application. - Hence it mustn't do anything that can't be done twice. - Also note that it may be called before the master module is initialized! } - -{GLOBAL} -procedure jpeg_calc_output_dimensions (cinfo : j_decompress_ptr); -{ Do computations that are needed before master selection phase } - - -{$ifdef D_MULTISCAN_FILES_SUPPORTED} - -{GLOBAL} -procedure jpeg_new_colormap (cinfo : j_decompress_ptr); - -{$endif} - -{ Initialize master decompression control and select active modules. - This is performed at the start of jpeg_start_decompress. } - -{GLOBAL} -procedure jinit_master_decompress (cinfo : j_decompress_ptr); - -implementation - -{ Private state } - -type - my_master_ptr = ^my_decomp_master; - my_decomp_master = record - pub : jpeg_decomp_master; { public fields } - - pass_number : int; { # of passes completed } - - using_merged_upsample : boolean; { TRUE if using merged upsample/cconvert } - - { Saved references to initialized quantizer modules, - in case we need to switch modes. } - - quantizer_1pass : jpeg_color_quantizer_ptr; - quantizer_2pass : jpeg_color_quantizer_ptr; - end; - -{ Determine whether merged upsample/color conversion should be used. - CRUCIAL: this must match the actual capabilities of jdmerge.c! } - -{LOCAL} -function use_merged_upsample (cinfo : j_decompress_ptr) : boolean; -var - compptr : jpeg_component_info_list_ptr; -begin - compptr := cinfo^.comp_info; - -{$ifdef UPSAMPLE_MERGING_SUPPORTED} - { Merging is the equivalent of plain box-filter upsampling } - if (cinfo^.do_fancy_upsampling) or (cinfo^.CCIR601_sampling) then - begin - use_merged_upsample := FALSE; - exit; - end; - { jdmerge.c only supports YCC=>RGB color conversion } - if (cinfo^.jpeg_color_space <> JCS_YCbCr) or (cinfo^.num_components <> 3) - or (cinfo^.out_color_space <> JCS_RGB) - or (cinfo^.out_color_components <> RGB_PIXELSIZE) then - begin - use_merged_upsample := FALSE; - exit; - end; - - { and it only handles 2h1v or 2h2v sampling ratios } - if (compptr^[0].h_samp_factor <> 2) or - (compptr^[1].h_samp_factor <> 1) or - (compptr^[2].h_samp_factor <> 1) or - (compptr^[0].v_samp_factor > 2) or - (compptr^[1].v_samp_factor <> 1) or - (compptr^[2].v_samp_factor <> 1) then - begin - use_merged_upsample := FALSE; - exit; - end; - { furthermore, it doesn't work if we've scaled the IDCTs differently } - if (compptr^[0].DCT_scaled_size <> cinfo^.min_DCT_scaled_size) or - (compptr^[1].DCT_scaled_size <> cinfo^.min_DCT_scaled_size) or - (compptr^[2].DCT_scaled_size <> cinfo^.min_DCT_scaled_size) then - begin - use_merged_upsample := FALSE; - exit; - end; - { ??? also need to test for upsample-time rescaling, when & if supported } - use_merged_upsample := TRUE; { by golly, it'll work... } -{$else} - use_merged_upsample := FALSE; -{$endif} -end; - - -{ Compute output image dimensions and related values. - NOTE: this is exported for possible use by application. - Hence it mustn't do anything that can't be done twice. - Also note that it may be called before the master module is initialized! } - -{GLOBAL} -procedure jpeg_calc_output_dimensions (cinfo : j_decompress_ptr); -{ Do computations that are needed before master selection phase } -{$ifdef IDCT_SCALING_SUPPORTED} -var - ci : int; - compptr : jpeg_component_info_ptr; -{$endif} -var - ssize : int; -begin - { Prevent application from calling me at wrong times } - if (cinfo^.global_state <> DSTATE_READY) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - -{$ifdef IDCT_SCALING_SUPPORTED} - - { Compute actual output image dimensions and DCT scaling choices. } - if (cinfo^.scale_num * 8 <= cinfo^.scale_denom) then - begin - { Provide 1/8 scaling } - cinfo^.output_width := JDIMENSION ( - jdiv_round_up( long(cinfo^.image_width), long(8)) ); - cinfo^.output_height := JDIMENSION ( - jdiv_round_up( long(cinfo^.image_height), long(8)) ); - cinfo^.min_DCT_scaled_size := 1; - end - else - if (cinfo^.scale_num * 4 <= cinfo^.scale_denom) then - begin - { Provide 1/4 scaling } - cinfo^.output_width := JDIMENSION ( - jdiv_round_up( long (cinfo^.image_width), long(4)) ); - cinfo^.output_height := JDIMENSION ( - jdiv_round_up( long (cinfo^.image_height), long(4)) ); - cinfo^.min_DCT_scaled_size := 2; - end - else - if (cinfo^.scale_num * 2 <= cinfo^.scale_denom) then - begin - { Provide 1/2 scaling } - cinfo^.output_width := JDIMENSION ( - jdiv_round_up( long(cinfo^.image_width), long(2)) ); - cinfo^.output_height := JDIMENSION ( - jdiv_round_up( long(cinfo^.image_height), long(2)) ); - cinfo^.min_DCT_scaled_size := 4; - end - else - begin - { Provide 1/1 scaling } - cinfo^.output_width := cinfo^.image_width; - cinfo^.output_height := cinfo^.image_height; - cinfo^.min_DCT_scaled_size := DCTSIZE; - end; - { In selecting the actual DCT scaling for each component, we try to - scale up the chroma components via IDCT scaling rather than upsampling. - This saves time if the upsampler gets to use 1:1 scaling. - Note this code assumes that the supported DCT scalings are powers of 2. } - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - ssize := cinfo^.min_DCT_scaled_size; - while (ssize < DCTSIZE) and - ((compptr^.h_samp_factor * ssize * 2 <= - cinfo^.max_h_samp_factor * cinfo^.min_DCT_scaled_size) and - (compptr^.v_samp_factor * ssize * 2 <= - cinfo^.max_v_samp_factor * cinfo^.min_DCT_scaled_size)) do - begin - ssize := ssize * 2; - end; - compptr^.DCT_scaled_size := ssize; - Inc(compptr); - end; - - { Recompute downsampled dimensions of components; - application needs to know these if using raw downsampled data. } - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - { Size in samples, after IDCT scaling } - compptr^.downsampled_width := JDIMENSION ( - jdiv_round_up(long (cinfo^.image_width) * - long (compptr^.h_samp_factor * compptr^.DCT_scaled_size), - long (cinfo^.max_h_samp_factor * DCTSIZE)) ); - compptr^.downsampled_height := JDIMENSION ( - jdiv_round_up(long (cinfo^.image_height) * - long (compptr^.v_samp_factor * compptr^.DCT_scaled_size), - long (cinfo^.max_v_samp_factor * DCTSIZE)) ); - Inc(compptr); - end; - -{$else} { !IDCT_SCALING_SUPPORTED } - - { Hardwire it to "no scaling" } - cinfo^.output_width := cinfo^.image_width; - cinfo^.output_height := cinfo^.image_height; - { jdinput.c has already initialized DCT_scaled_size to DCTSIZE, - and has computed unscaled downsampled_width and downsampled_height. } - -{$endif} { IDCT_SCALING_SUPPORTED } - - { Report number of components in selected colorspace. } - { Probably this should be in the color conversion module... } - case (cinfo^.out_color_space) of - JCS_GRAYSCALE: - cinfo^.out_color_components := 1; -{$ifndef RGB_PIXELSIZE_IS_3} - JCS_RGB: - cinfo^.out_color_components := RGB_PIXELSIZE; -{$else} - JCS_RGB, -{$endif} { else share code with YCbCr } - JCS_YCbCr: - cinfo^.out_color_components := 3; - JCS_CMYK, - JCS_YCCK: - cinfo^.out_color_components := 4; - else { else must be same colorspace as in file } - cinfo^.out_color_components := cinfo^.num_components; - end; - if (cinfo^.quantize_colors) then - cinfo^.output_components := 1 - else - cinfo^.output_components := cinfo^.out_color_components; - - { See if upsampler will want to emit more than one row at a time } - if (use_merged_upsample(cinfo)) then - cinfo^.rec_outbuf_height := cinfo^.max_v_samp_factor - else - cinfo^.rec_outbuf_height := 1; -end; - - -{ Several decompression processes need to range-limit values to the range - 0..MAXJSAMPLE; the input value may fall somewhat outside this range - due to noise introduced by quantization, roundoff error, etc. These - processes are inner loops and need to be as fast as possible. On most - machines, particularly CPUs with pipelines or instruction prefetch, - a (subscript-check-less) C table lookup - x := sample_range_limit[x]; - is faster than explicit tests - if (x < 0) x := 0; - else if (x > MAXJSAMPLE) x := MAXJSAMPLE; - These processes all use a common table prepared by the routine below. - - For most steps we can mathematically guarantee that the initial value - of x is within MAXJSAMPLE+1 of the legal range, so a table running from - -(MAXJSAMPLE+1) to 2*MAXJSAMPLE+1 is sufficient. But for the initial - limiting step (just after the IDCT), a wildly out-of-range value is - possible if the input data is corrupt. To avoid any chance of indexing - off the end of memory and getting a bad-pointer trap, we perform the - post-IDCT limiting thus: - x := range_limit[x & MASK]; - where MASK is 2 bits wider than legal sample data, ie 10 bits for 8-bit - samples. Under normal circumstances this is more than enough range and - a correct output will be generated; with bogus input data the mask will - cause wraparound, and we will safely generate a bogus-but-in-range output. - For the post-IDCT step, we want to convert the data from signed to unsigned - representation by adding CENTERJSAMPLE at the same time that we limit it. - So the post-IDCT limiting table ends up looking like this: - CENTERJSAMPLE,CENTERJSAMPLE+1,...,MAXJSAMPLE, - MAXJSAMPLE (repeat 2*(MAXJSAMPLE+1)-CENTERJSAMPLE times), - 0 (repeat 2*(MAXJSAMPLE+1)-CENTERJSAMPLE times), - 0,1,...,CENTERJSAMPLE-1 - Negative inputs select values from the upper half of the table after - masking. - - We can save some space by overlapping the start of the post-IDCT table - with the simpler range limiting table. The post-IDCT table begins at - sample_range_limit + CENTERJSAMPLE. - - Note that the table is allocated in near data space on PCs; it's small - enough and used often enough to justify this. } - -{LOCAL} -procedure prepare_range_limit_table (cinfo : j_decompress_ptr); -{ Allocate and fill in the sample_range_limit table } -var - table : range_limit_table_ptr; - idct_table : JSAMPROW; - i : int; -begin - table := range_limit_table_ptr ( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - (5 * (MAXJSAMPLE+1) + CENTERJSAMPLE) * SIZEOF(JSAMPLE)) ); - - { First segment of "simple" table: limit[x] := 0 for x < 0 } - MEMZERO(table, (MAXJSAMPLE+1) * SIZEOF(JSAMPLE)); - - cinfo^.sample_range_limit := (table); - { allow negative subscripts of simple table } - { is noop, handled via type definition (Nomssi) } - { Main part of "simple" table: limit[x] := x } - for i := 0 to MAXJSAMPLE do - table^[i] := JSAMPLE (i); - idct_table := JSAMPROW(@ table^[CENTERJSAMPLE]); - { Point to where post-IDCT table starts } - { End of simple table, rest of first half of post-IDCT table } - for i := CENTERJSAMPLE to pred(2*(MAXJSAMPLE+1)) do - idct_table^[i] := MAXJSAMPLE; - { Second half of post-IDCT table } - MEMZERO(@(idct_table^[2 * (MAXJSAMPLE+1)]), - (2 * (MAXJSAMPLE+1) - CENTERJSAMPLE) * SIZEOF(JSAMPLE)); - MEMCOPY(@(idct_table^[(4 * (MAXJSAMPLE+1) - CENTERJSAMPLE)]), - @cinfo^.sample_range_limit^[0], CENTERJSAMPLE * SIZEOF(JSAMPLE)); - -end; - - -{ Master selection of decompression modules. - This is done once at jpeg_start_decompress time. We determine - which modules will be used and give them appropriate initialization calls. - We also initialize the decompressor input side to begin consuming data. - - Since jpeg_read_header has finished, we know what is in the SOF - and (first) SOS markers. We also have all the application parameter - settings. } - -{LOCAL} -procedure master_selection (cinfo : j_decompress_ptr); -var - master : my_master_ptr; - use_c_buffer : boolean; - samplesperrow : long; - jd_samplesperrow : JDIMENSION; -var - nscans : int; -begin - master := my_master_ptr (cinfo^.master); - - { Initialize dimensions and other stuff } - jpeg_calc_output_dimensions(cinfo); - prepare_range_limit_table(cinfo); - - { Width of an output scanline must be representable as JDIMENSION. } - samplesperrow := long(cinfo^.output_width) * long (cinfo^.out_color_components); - jd_samplesperrow := JDIMENSION (samplesperrow); - if (long(jd_samplesperrow) <> samplesperrow) then - ERREXIT(j_common_ptr(cinfo), JERR_WIDTH_OVERFLOW); - - { Initialize my private state } - master^.pass_number := 0; - master^.using_merged_upsample := use_merged_upsample(cinfo); - - { Color quantizer selection } - master^.quantizer_1pass := NIL; - master^.quantizer_2pass := NIL; - { No mode changes if not using buffered-image mode. } - if (not cinfo^.quantize_colors) or (not cinfo^.buffered_image) then - begin - cinfo^.enable_1pass_quant := FALSE; - cinfo^.enable_external_quant := FALSE; - cinfo^.enable_2pass_quant := FALSE; - end; - if (cinfo^.quantize_colors) then - begin - if (cinfo^.raw_data_out) then - ERREXIT(j_common_ptr(cinfo), JERR_NOTIMPL); - { 2-pass quantizer only works in 3-component color space. } - if (cinfo^.out_color_components <> 3) then - begin - cinfo^.enable_1pass_quant := TRUE; - cinfo^.enable_external_quant := FALSE; - cinfo^.enable_2pass_quant := FALSE; - cinfo^.colormap := NIL; - end - else - if (cinfo^.colormap <> NIL) then - begin - cinfo^.enable_external_quant := TRUE; - end - else - if (cinfo^.two_pass_quantize) then - begin - cinfo^.enable_2pass_quant := TRUE; - end - else - begin - cinfo^.enable_1pass_quant := TRUE; - end; - - if (cinfo^.enable_1pass_quant) then - begin -{$ifdef QUANT_1PASS_SUPPORTED} - jinit_1pass_quantizer(cinfo); - master^.quantizer_1pass := cinfo^.cquantize; -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); -{$endif} - end; - - { We use the 2-pass code to map to external colormaps. } - if (cinfo^.enable_2pass_quant) or (cinfo^.enable_external_quant) then - begin -{$ifdef QUANT_2PASS_SUPPORTED} - jinit_2pass_quantizer(cinfo); - master^.quantizer_2pass := cinfo^.cquantize; -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); -{$endif} - end; - { If both quantizers are initialized, the 2-pass one is left active; - this is necessary for starting with quantization to an external map. } - end; - - { Post-processing: in particular, color conversion first } - if (not cinfo^.raw_data_out) then - begin - if (master^.using_merged_upsample) then - begin -{$ifdef UPSAMPLE_MERGING_SUPPORTED} - jinit_merged_upsampler(cinfo); { does color conversion too } -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); -{$endif} - end - else - begin - jinit_color_deconverter(cinfo); - jinit_upsampler(cinfo); - end; - jinit_d_post_controller(cinfo, cinfo^.enable_2pass_quant); - end; - { Inverse DCT } - jinit_inverse_dct(cinfo); - { Entropy decoding: 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 D_PROGRESSIVE_SUPPORTED} - jinit_phuff_decoder(cinfo); -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); -{$endif} - end - else - jinit_huff_decoder(cinfo); - end; - - { Initialize principal buffer controllers. } - use_c_buffer := cinfo^.inputctl^.has_multiple_scans or cinfo^.buffered_image; - jinit_d_coef_controller(cinfo, use_c_buffer); - - if (not cinfo^.raw_data_out) then - jinit_d_main_controller(cinfo, FALSE { never need full buffer here }); - - { We can now tell the memory manager to allocate virtual arrays. } - cinfo^.mem^.realize_virt_arrays (j_common_ptr(cinfo)); - - { Initialize input side of decompressor to consume first scan. } - cinfo^.inputctl^.start_input_pass (cinfo); - -{$ifdef D_MULTISCAN_FILES_SUPPORTED} - { If jpeg_start_decompress will read the whole file, initialize - progress monitoring appropriately. The input step is counted - as one pass. } - - if (cinfo^.progress <> NIL) and (not cinfo^.buffered_image) and - (cinfo^.inputctl^.has_multiple_scans) then - begin - - { Estimate number of scans to set pass_limit. } - if (cinfo^.progressive_mode) then - begin - { Arbitrarily estimate 2 interleaved DC scans + 3 AC scans/component. } - nscans := 2 + 3 * cinfo^.num_components; - end - else - begin - { For a nonprogressive multiscan file, estimate 1 scan per component. } - nscans := cinfo^.num_components; - end; - cinfo^.progress^.pass_counter := Long(0); - cinfo^.progress^.pass_limit := long (cinfo^.total_iMCU_rows) * nscans; - cinfo^.progress^.completed_passes := 0; - if cinfo^.enable_2pass_quant then - cinfo^.progress^.total_passes := 3 - else - cinfo^.progress^.total_passes := 2; - { Count the input pass as done } - Inc(master^.pass_number); - end; -{$endif} { D_MULTISCAN_FILES_SUPPORTED } -end; - - -{ Per-pass setup. - This is called at the beginning of each output pass. We determine which - modules will be active during this pass and give them appropriate - start_pass calls. We also set is_dummy_pass to indicate whether this - is a "real" output pass or a dummy pass for color quantization. - (In the latter case, jdapistd.c will crank the pass to completion.) } - -{METHODDEF} -procedure prepare_for_output_pass (cinfo : j_decompress_ptr); -var - master : my_master_ptr; -begin - master := my_master_ptr (cinfo^.master); - - if (master^.pub.is_dummy_pass) then - begin -{$ifdef QUANT_2PASS_SUPPORTED} - { Final pass of 2-pass quantization } - master^.pub.is_dummy_pass := FALSE; - cinfo^.cquantize^.start_pass (cinfo, FALSE); - cinfo^.post^.start_pass (cinfo, JBUF_CRANK_DEST); - cinfo^.main^.start_pass (cinfo, JBUF_CRANK_DEST); -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); -{$endif} { QUANT_2PASS_SUPPORTED } - end - else - begin - if (cinfo^.quantize_colors) and (cinfo^.colormap = NIL) then - begin - { Select new quantization method } - if (cinfo^.two_pass_quantize) and (cinfo^.enable_2pass_quant) then - begin - cinfo^.cquantize := master^.quantizer_2pass; - master^.pub.is_dummy_pass := TRUE; - end - else - if (cinfo^.enable_1pass_quant) then - begin - cinfo^.cquantize := master^.quantizer_1pass; - end - else - begin - ERREXIT(j_common_ptr(cinfo), JERR_MODE_CHANGE); - end; - end; - cinfo^.idct^.start_pass (cinfo); - cinfo^.coef^.start_output_pass (cinfo); - if (not cinfo^.raw_data_out) then - begin - if (not master^.using_merged_upsample) then - cinfo^.cconvert^.start_pass (cinfo); - cinfo^.upsample^.start_pass (cinfo); - if (cinfo^.quantize_colors) then - cinfo^.cquantize^.start_pass (cinfo, master^.pub.is_dummy_pass); - if master^.pub.is_dummy_pass then - cinfo^.post^.start_pass (cinfo, JBUF_SAVE_AND_PASS) - else - cinfo^.post^.start_pass (cinfo, JBUF_PASS_THRU); - cinfo^.main^.start_pass (cinfo, JBUF_PASS_THRU); - end; - end; - - { Set up progress monitor's pass info if present } - if (cinfo^.progress <> NIL) then - begin - cinfo^.progress^.completed_passes := master^.pass_number; - if master^.pub.is_dummy_pass then - cinfo^.progress^.total_passes := master^.pass_number + 2 - else - cinfo^.progress^.total_passes := master^.pass_number + 1; - { In buffered-image mode, we assume one more output pass if EOI not - yet reached, but no more passes if EOI has been reached. } - - if (cinfo^.buffered_image) and (not cinfo^.inputctl^.eoi_reached) then - begin - if cinfo^.enable_2pass_quant then - Inc(cinfo^.progress^.total_passes, 2) - else - Inc(cinfo^.progress^.total_passes, 1); - end; - end; -end; - - -{ Finish up at end of an output pass. } - -{METHODDEF} -procedure finish_output_pass (cinfo : j_decompress_ptr); -var - master : my_master_ptr; -begin - master := my_master_ptr (cinfo^.master); - - if (cinfo^.quantize_colors) then - cinfo^.cquantize^.finish_pass (cinfo); - Inc(master^.pass_number); -end; - - -{$ifdef D_MULTISCAN_FILES_SUPPORTED} - -{ Switch to a new external colormap between output passes. } - -{GLOBAL} -procedure jpeg_new_colormap (cinfo : j_decompress_ptr); -var - master : my_master_ptr; -begin - master := my_master_ptr (cinfo^.master); - - { Prevent application from calling me at wrong times } - if (cinfo^.global_state <> DSTATE_BUFIMAGE) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - - if (cinfo^.quantize_colors) and (cinfo^.enable_external_quant) and - (cinfo^.colormap <> NIL) then - begin - { Select 2-pass quantizer for external colormap use } - cinfo^.cquantize := master^.quantizer_2pass; - { Notify quantizer of colormap change } - cinfo^.cquantize^.new_color_map (cinfo); - master^.pub.is_dummy_pass := FALSE; { just in case } - end - else - ERREXIT(j_common_ptr(cinfo), JERR_MODE_CHANGE); -end; - -{$endif} { D_MULTISCAN_FILES_SUPPORTED } - - -{ Initialize master decompression control and select active modules. - This is performed at the start of jpeg_start_decompress. } - -{GLOBAL} -procedure jinit_master_decompress (cinfo : j_decompress_ptr); -var - master : my_master_ptr; -begin - master := my_master_ptr ( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_decomp_master)) ); - cinfo^.master := jpeg_decomp_master_ptr(master); - master^.pub.prepare_for_output_pass := prepare_for_output_pass; - master^.pub.finish_output_pass := finish_output_pass; - - master^.pub.is_dummy_pass := FALSE; - - master_selection(cinfo); -end; - -end. +unit imjdmaster; + +{ This file contains master control logic for the JPEG decompressor. + These routines are concerned with selecting the modules to be executed + and with determining the number of passes and the work to be done in each + pass. } + +{ Original: jdmaster.c ; Copyright (C) 1991-1998, Thomas G. Lane. } + +interface + +{$I imjconfig.inc} + +uses + imjmorecfg, + imjinclude, + imjutils, + imjerror, + imjdeferr, + imjdcolor, imjdsample, imjdpostct, imjddctmgr, imjdphuff, + imjdhuff, imjdcoefct, imjdmainct, +{$ifdef QUANT_1PASS_SUPPORTED} + imjquant1, +{$endif} +{$ifdef QUANT_2PASS_SUPPORTED} + imjquant2, +{$endif} +{$ifdef UPSAMPLE_MERGING_SUPPORTED} + imjdmerge, +{$endif} + imjpeglib; + + +{ Compute output image dimensions and related values. + NOTE: this is exported for possible use by application. + Hence it mustn't do anything that can't be done twice. + Also note that it may be called before the master module is initialized! } + +{GLOBAL} +procedure jpeg_calc_output_dimensions (cinfo : j_decompress_ptr); +{ Do computations that are needed before master selection phase } + + +{$ifdef D_MULTISCAN_FILES_SUPPORTED} + +{GLOBAL} +procedure jpeg_new_colormap (cinfo : j_decompress_ptr); + +{$endif} + +{ Initialize master decompression control and select active modules. + This is performed at the start of jpeg_start_decompress. } + +{GLOBAL} +procedure jinit_master_decompress (cinfo : j_decompress_ptr); + +implementation + +{ Private state } + +type + my_master_ptr = ^my_decomp_master; + my_decomp_master = record + pub : jpeg_decomp_master; { public fields } + + pass_number : int; { # of passes completed } + + using_merged_upsample : boolean; { TRUE if using merged upsample/cconvert } + + { Saved references to initialized quantizer modules, + in case we need to switch modes. } + + quantizer_1pass : jpeg_color_quantizer_ptr; + quantizer_2pass : jpeg_color_quantizer_ptr; + end; + +{ Determine whether merged upsample/color conversion should be used. + CRUCIAL: this must match the actual capabilities of jdmerge.c! } + +{LOCAL} +function use_merged_upsample (cinfo : j_decompress_ptr) : boolean; +var + compptr : jpeg_component_info_list_ptr; +begin + compptr := cinfo^.comp_info; + +{$ifdef UPSAMPLE_MERGING_SUPPORTED} + { Merging is the equivalent of plain box-filter upsampling } + if (cinfo^.do_fancy_upsampling) or (cinfo^.CCIR601_sampling) then + begin + use_merged_upsample := FALSE; + exit; + end; + { jdmerge.c only supports YCC=>RGB color conversion } + if (cinfo^.jpeg_color_space <> JCS_YCbCr) or (cinfo^.num_components <> 3) + or (cinfo^.out_color_space <> JCS_RGB) + or (cinfo^.out_color_components <> RGB_PIXELSIZE) then + begin + use_merged_upsample := FALSE; + exit; + end; + + { and it only handles 2h1v or 2h2v sampling ratios } + if (compptr^[0].h_samp_factor <> 2) or + (compptr^[1].h_samp_factor <> 1) or + (compptr^[2].h_samp_factor <> 1) or + (compptr^[0].v_samp_factor > 2) or + (compptr^[1].v_samp_factor <> 1) or + (compptr^[2].v_samp_factor <> 1) then + begin + use_merged_upsample := FALSE; + exit; + end; + { furthermore, it doesn't work if we've scaled the IDCTs differently } + if (compptr^[0].DCT_scaled_size <> cinfo^.min_DCT_scaled_size) or + (compptr^[1].DCT_scaled_size <> cinfo^.min_DCT_scaled_size) or + (compptr^[2].DCT_scaled_size <> cinfo^.min_DCT_scaled_size) then + begin + use_merged_upsample := FALSE; + exit; + end; + { ??? also need to test for upsample-time rescaling, when & if supported } + use_merged_upsample := TRUE; { by golly, it'll work... } +{$else} + use_merged_upsample := FALSE; +{$endif} +end; + + +{ Compute output image dimensions and related values. + NOTE: this is exported for possible use by application. + Hence it mustn't do anything that can't be done twice. + Also note that it may be called before the master module is initialized! } + +{GLOBAL} +procedure jpeg_calc_output_dimensions (cinfo : j_decompress_ptr); +{ Do computations that are needed before master selection phase } +{$ifdef IDCT_SCALING_SUPPORTED} +var + ci : int; + compptr : jpeg_component_info_ptr; +{$endif} +var + ssize : int; +begin + { Prevent application from calling me at wrong times } + if (cinfo^.global_state <> DSTATE_READY) then + ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); + +{$ifdef IDCT_SCALING_SUPPORTED} + + { Compute actual output image dimensions and DCT scaling choices. } + if (cinfo^.scale_num * 8 <= cinfo^.scale_denom) then + begin + { Provide 1/8 scaling } + cinfo^.output_width := JDIMENSION ( + jdiv_round_up( long(cinfo^.image_width), long(8)) ); + cinfo^.output_height := JDIMENSION ( + jdiv_round_up( long(cinfo^.image_height), long(8)) ); + cinfo^.min_DCT_scaled_size := 1; + end + else + if (cinfo^.scale_num * 4 <= cinfo^.scale_denom) then + begin + { Provide 1/4 scaling } + cinfo^.output_width := JDIMENSION ( + jdiv_round_up( long (cinfo^.image_width), long(4)) ); + cinfo^.output_height := JDIMENSION ( + jdiv_round_up( long (cinfo^.image_height), long(4)) ); + cinfo^.min_DCT_scaled_size := 2; + end + else + if (cinfo^.scale_num * 2 <= cinfo^.scale_denom) then + begin + { Provide 1/2 scaling } + cinfo^.output_width := JDIMENSION ( + jdiv_round_up( long(cinfo^.image_width), long(2)) ); + cinfo^.output_height := JDIMENSION ( + jdiv_round_up( long(cinfo^.image_height), long(2)) ); + cinfo^.min_DCT_scaled_size := 4; + end + else + begin + { Provide 1/1 scaling } + cinfo^.output_width := cinfo^.image_width; + cinfo^.output_height := cinfo^.image_height; + cinfo^.min_DCT_scaled_size := DCTSIZE; + end; + { In selecting the actual DCT scaling for each component, we try to + scale up the chroma components via IDCT scaling rather than upsampling. + This saves time if the upsampler gets to use 1:1 scaling. + Note this code assumes that the supported DCT scalings are powers of 2. } + + compptr := jpeg_component_info_ptr(cinfo^.comp_info); + for ci := 0 to pred(cinfo^.num_components) do + begin + ssize := cinfo^.min_DCT_scaled_size; + while (ssize < DCTSIZE) and + ((compptr^.h_samp_factor * ssize * 2 <= + cinfo^.max_h_samp_factor * cinfo^.min_DCT_scaled_size) and + (compptr^.v_samp_factor * ssize * 2 <= + cinfo^.max_v_samp_factor * cinfo^.min_DCT_scaled_size)) do + begin + ssize := ssize * 2; + end; + compptr^.DCT_scaled_size := ssize; + Inc(compptr); + end; + + { Recompute downsampled dimensions of components; + application needs to know these if using raw downsampled data. } + + compptr := jpeg_component_info_ptr(cinfo^.comp_info); + for ci := 0 to pred(cinfo^.num_components) do + begin + { Size in samples, after IDCT scaling } + compptr^.downsampled_width := JDIMENSION ( + jdiv_round_up(long (cinfo^.image_width) * + long (compptr^.h_samp_factor * compptr^.DCT_scaled_size), + long (cinfo^.max_h_samp_factor * DCTSIZE)) ); + compptr^.downsampled_height := JDIMENSION ( + jdiv_round_up(long (cinfo^.image_height) * + long (compptr^.v_samp_factor * compptr^.DCT_scaled_size), + long (cinfo^.max_v_samp_factor * DCTSIZE)) ); + Inc(compptr); + end; + +{$else} { !IDCT_SCALING_SUPPORTED } + + { Hardwire it to "no scaling" } + cinfo^.output_width := cinfo^.image_width; + cinfo^.output_height := cinfo^.image_height; + { jdinput.c has already initialized DCT_scaled_size to DCTSIZE, + and has computed unscaled downsampled_width and downsampled_height. } + +{$endif} { IDCT_SCALING_SUPPORTED } + + { Report number of components in selected colorspace. } + { Probably this should be in the color conversion module... } + case (cinfo^.out_color_space) of + JCS_GRAYSCALE: + cinfo^.out_color_components := 1; +{$ifndef RGB_PIXELSIZE_IS_3} + JCS_RGB: + cinfo^.out_color_components := RGB_PIXELSIZE; +{$else} + JCS_RGB, +{$endif} { else share code with YCbCr } + JCS_YCbCr: + cinfo^.out_color_components := 3; + JCS_CMYK, + JCS_YCCK: + cinfo^.out_color_components := 4; + else { else must be same colorspace as in file } + cinfo^.out_color_components := cinfo^.num_components; + end; + if (cinfo^.quantize_colors) then + cinfo^.output_components := 1 + else + cinfo^.output_components := cinfo^.out_color_components; + + { See if upsampler will want to emit more than one row at a time } + if (use_merged_upsample(cinfo)) then + cinfo^.rec_outbuf_height := cinfo^.max_v_samp_factor + else + cinfo^.rec_outbuf_height := 1; +end; + + +{ Several decompression processes need to range-limit values to the range + 0..MAXJSAMPLE; the input value may fall somewhat outside this range + due to noise introduced by quantization, roundoff error, etc. These + processes are inner loops and need to be as fast as possible. On most + machines, particularly CPUs with pipelines or instruction prefetch, + a (subscript-check-less) C table lookup + x := sample_range_limit[x]; + is faster than explicit tests + if (x < 0) x := 0; + else if (x > MAXJSAMPLE) x := MAXJSAMPLE; + These processes all use a common table prepared by the routine below. + + For most steps we can mathematically guarantee that the initial value + of x is within MAXJSAMPLE+1 of the legal range, so a table running from + -(MAXJSAMPLE+1) to 2*MAXJSAMPLE+1 is sufficient. But for the initial + limiting step (just after the IDCT), a wildly out-of-range value is + possible if the input data is corrupt. To avoid any chance of indexing + off the end of memory and getting a bad-pointer trap, we perform the + post-IDCT limiting thus: + x := range_limit[x & MASK]; + where MASK is 2 bits wider than legal sample data, ie 10 bits for 8-bit + samples. Under normal circumstances this is more than enough range and + a correct output will be generated; with bogus input data the mask will + cause wraparound, and we will safely generate a bogus-but-in-range output. + For the post-IDCT step, we want to convert the data from signed to unsigned + representation by adding CENTERJSAMPLE at the same time that we limit it. + So the post-IDCT limiting table ends up looking like this: + CENTERJSAMPLE,CENTERJSAMPLE+1,...,MAXJSAMPLE, + MAXJSAMPLE (repeat 2*(MAXJSAMPLE+1)-CENTERJSAMPLE times), + 0 (repeat 2*(MAXJSAMPLE+1)-CENTERJSAMPLE times), + 0,1,...,CENTERJSAMPLE-1 + Negative inputs select values from the upper half of the table after + masking. + + We can save some space by overlapping the start of the post-IDCT table + with the simpler range limiting table. The post-IDCT table begins at + sample_range_limit + CENTERJSAMPLE. + + Note that the table is allocated in near data space on PCs; it's small + enough and used often enough to justify this. } + +{LOCAL} +procedure prepare_range_limit_table (cinfo : j_decompress_ptr); +{ Allocate and fill in the sample_range_limit table } +var + table : range_limit_table_ptr; + idct_table : JSAMPROW; + i : int; +begin + table := range_limit_table_ptr ( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + (5 * (MAXJSAMPLE+1) + CENTERJSAMPLE) * SIZEOF(JSAMPLE)) ); + + { First segment of "simple" table: limit[x] := 0 for x < 0 } + MEMZERO(table, (MAXJSAMPLE+1) * SIZEOF(JSAMPLE)); + + cinfo^.sample_range_limit := (table); + { allow negative subscripts of simple table } + { is noop, handled via type definition (Nomssi) } + { Main part of "simple" table: limit[x] := x } + for i := 0 to MAXJSAMPLE do + table^[i] := JSAMPLE (i); + idct_table := JSAMPROW(@ table^[CENTERJSAMPLE]); + { Point to where post-IDCT table starts } + { End of simple table, rest of first half of post-IDCT table } + for i := CENTERJSAMPLE to pred(2*(MAXJSAMPLE+1)) do + idct_table^[i] := MAXJSAMPLE; + { Second half of post-IDCT table } + MEMZERO(@(idct_table^[2 * (MAXJSAMPLE+1)]), + (2 * (MAXJSAMPLE+1) - CENTERJSAMPLE) * SIZEOF(JSAMPLE)); + MEMCOPY(@(idct_table^[(4 * (MAXJSAMPLE+1) - CENTERJSAMPLE)]), + @cinfo^.sample_range_limit^[0], CENTERJSAMPLE * SIZEOF(JSAMPLE)); + +end; + + +{ Master selection of decompression modules. + This is done once at jpeg_start_decompress time. We determine + which modules will be used and give them appropriate initialization calls. + We also initialize the decompressor input side to begin consuming data. + + Since jpeg_read_header has finished, we know what is in the SOF + and (first) SOS markers. We also have all the application parameter + settings. } + +{LOCAL} +procedure master_selection (cinfo : j_decompress_ptr); +var + master : my_master_ptr; + use_c_buffer : boolean; + samplesperrow : long; + jd_samplesperrow : JDIMENSION; +var + nscans : int; +begin + master := my_master_ptr (cinfo^.master); + + { Initialize dimensions and other stuff } + jpeg_calc_output_dimensions(cinfo); + prepare_range_limit_table(cinfo); + + { Width of an output scanline must be representable as JDIMENSION. } + samplesperrow := long(cinfo^.output_width) * long (cinfo^.out_color_components); + jd_samplesperrow := JDIMENSION (samplesperrow); + if (long(jd_samplesperrow) <> samplesperrow) then + ERREXIT(j_common_ptr(cinfo), JERR_WIDTH_OVERFLOW); + + { Initialize my private state } + master^.pass_number := 0; + master^.using_merged_upsample := use_merged_upsample(cinfo); + + { Color quantizer selection } + master^.quantizer_1pass := NIL; + master^.quantizer_2pass := NIL; + { No mode changes if not using buffered-image mode. } + if (not cinfo^.quantize_colors) or (not cinfo^.buffered_image) then + begin + cinfo^.enable_1pass_quant := FALSE; + cinfo^.enable_external_quant := FALSE; + cinfo^.enable_2pass_quant := FALSE; + end; + if (cinfo^.quantize_colors) then + begin + if (cinfo^.raw_data_out) then + ERREXIT(j_common_ptr(cinfo), JERR_NOTIMPL); + { 2-pass quantizer only works in 3-component color space. } + if (cinfo^.out_color_components <> 3) then + begin + cinfo^.enable_1pass_quant := TRUE; + cinfo^.enable_external_quant := FALSE; + cinfo^.enable_2pass_quant := FALSE; + cinfo^.colormap := NIL; + end + else + if (cinfo^.colormap <> NIL) then + begin + cinfo^.enable_external_quant := TRUE; + end + else + if (cinfo^.two_pass_quantize) then + begin + cinfo^.enable_2pass_quant := TRUE; + end + else + begin + cinfo^.enable_1pass_quant := TRUE; + end; + + if (cinfo^.enable_1pass_quant) then + begin +{$ifdef QUANT_1PASS_SUPPORTED} + jinit_1pass_quantizer(cinfo); + master^.quantizer_1pass := cinfo^.cquantize; +{$else} + ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); +{$endif} + end; + + { We use the 2-pass code to map to external colormaps. } + if (cinfo^.enable_2pass_quant) or (cinfo^.enable_external_quant) then + begin +{$ifdef QUANT_2PASS_SUPPORTED} + jinit_2pass_quantizer(cinfo); + master^.quantizer_2pass := cinfo^.cquantize; +{$else} + ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); +{$endif} + end; + { If both quantizers are initialized, the 2-pass one is left active; + this is necessary for starting with quantization to an external map. } + end; + + { Post-processing: in particular, color conversion first } + if (not cinfo^.raw_data_out) then + begin + if (master^.using_merged_upsample) then + begin +{$ifdef UPSAMPLE_MERGING_SUPPORTED} + jinit_merged_upsampler(cinfo); { does color conversion too } +{$else} + ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); +{$endif} + end + else + begin + jinit_color_deconverter(cinfo); + jinit_upsampler(cinfo); + end; + jinit_d_post_controller(cinfo, cinfo^.enable_2pass_quant); + end; + { Inverse DCT } + jinit_inverse_dct(cinfo); + { Entropy decoding: 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 D_PROGRESSIVE_SUPPORTED} + jinit_phuff_decoder(cinfo); +{$else} + ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); +{$endif} + end + else + jinit_huff_decoder(cinfo); + end; + + { Initialize principal buffer controllers. } + use_c_buffer := cinfo^.inputctl^.has_multiple_scans or cinfo^.buffered_image; + jinit_d_coef_controller(cinfo, use_c_buffer); + + if (not cinfo^.raw_data_out) then + jinit_d_main_controller(cinfo, FALSE { never need full buffer here }); + + { We can now tell the memory manager to allocate virtual arrays. } + cinfo^.mem^.realize_virt_arrays (j_common_ptr(cinfo)); + + { Initialize input side of decompressor to consume first scan. } + cinfo^.inputctl^.start_input_pass (cinfo); + +{$ifdef D_MULTISCAN_FILES_SUPPORTED} + { If jpeg_start_decompress will read the whole file, initialize + progress monitoring appropriately. The input step is counted + as one pass. } + + if (cinfo^.progress <> NIL) and (not cinfo^.buffered_image) and + (cinfo^.inputctl^.has_multiple_scans) then + begin + + { Estimate number of scans to set pass_limit. } + if (cinfo^.progressive_mode) then + begin + { Arbitrarily estimate 2 interleaved DC scans + 3 AC scans/component. } + nscans := 2 + 3 * cinfo^.num_components; + end + else + begin + { For a nonprogressive multiscan file, estimate 1 scan per component. } + nscans := cinfo^.num_components; + end; + cinfo^.progress^.pass_counter := Long(0); + cinfo^.progress^.pass_limit := long (cinfo^.total_iMCU_rows) * nscans; + cinfo^.progress^.completed_passes := 0; + if cinfo^.enable_2pass_quant then + cinfo^.progress^.total_passes := 3 + else + cinfo^.progress^.total_passes := 2; + { Count the input pass as done } + Inc(master^.pass_number); + end; +{$endif} { D_MULTISCAN_FILES_SUPPORTED } +end; + + +{ Per-pass setup. + This is called at the beginning of each output pass. We determine which + modules will be active during this pass and give them appropriate + start_pass calls. We also set is_dummy_pass to indicate whether this + is a "real" output pass or a dummy pass for color quantization. + (In the latter case, jdapistd.c will crank the pass to completion.) } + +{METHODDEF} +procedure prepare_for_output_pass (cinfo : j_decompress_ptr); +var + master : my_master_ptr; +begin + master := my_master_ptr (cinfo^.master); + + if (master^.pub.is_dummy_pass) then + begin +{$ifdef QUANT_2PASS_SUPPORTED} + { Final pass of 2-pass quantization } + master^.pub.is_dummy_pass := FALSE; + cinfo^.cquantize^.start_pass (cinfo, FALSE); + cinfo^.post^.start_pass (cinfo, JBUF_CRANK_DEST); + cinfo^.main^.start_pass (cinfo, JBUF_CRANK_DEST); +{$else} + ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); +{$endif} { QUANT_2PASS_SUPPORTED } + end + else + begin + if (cinfo^.quantize_colors) and (cinfo^.colormap = NIL) then + begin + { Select new quantization method } + if (cinfo^.two_pass_quantize) and (cinfo^.enable_2pass_quant) then + begin + cinfo^.cquantize := master^.quantizer_2pass; + master^.pub.is_dummy_pass := TRUE; + end + else + if (cinfo^.enable_1pass_quant) then + begin + cinfo^.cquantize := master^.quantizer_1pass; + end + else + begin + ERREXIT(j_common_ptr(cinfo), JERR_MODE_CHANGE); + end; + end; + cinfo^.idct^.start_pass (cinfo); + cinfo^.coef^.start_output_pass (cinfo); + if (not cinfo^.raw_data_out) then + begin + if (not master^.using_merged_upsample) then + cinfo^.cconvert^.start_pass (cinfo); + cinfo^.upsample^.start_pass (cinfo); + if (cinfo^.quantize_colors) then + cinfo^.cquantize^.start_pass (cinfo, master^.pub.is_dummy_pass); + if master^.pub.is_dummy_pass then + cinfo^.post^.start_pass (cinfo, JBUF_SAVE_AND_PASS) + else + cinfo^.post^.start_pass (cinfo, JBUF_PASS_THRU); + cinfo^.main^.start_pass (cinfo, JBUF_PASS_THRU); + end; + end; + + { Set up progress monitor's pass info if present } + if (cinfo^.progress <> NIL) then + begin + cinfo^.progress^.completed_passes := master^.pass_number; + if master^.pub.is_dummy_pass then + cinfo^.progress^.total_passes := master^.pass_number + 2 + else + cinfo^.progress^.total_passes := master^.pass_number + 1; + { In buffered-image mode, we assume one more output pass if EOI not + yet reached, but no more passes if EOI has been reached. } + + if (cinfo^.buffered_image) and (not cinfo^.inputctl^.eoi_reached) then + begin + if cinfo^.enable_2pass_quant then + Inc(cinfo^.progress^.total_passes, 2) + else + Inc(cinfo^.progress^.total_passes, 1); + end; + end; +end; + + +{ Finish up at end of an output pass. } + +{METHODDEF} +procedure finish_output_pass (cinfo : j_decompress_ptr); +var + master : my_master_ptr; +begin + master := my_master_ptr (cinfo^.master); + + if (cinfo^.quantize_colors) then + cinfo^.cquantize^.finish_pass (cinfo); + Inc(master^.pass_number); +end; + + +{$ifdef D_MULTISCAN_FILES_SUPPORTED} + +{ Switch to a new external colormap between output passes. } + +{GLOBAL} +procedure jpeg_new_colormap (cinfo : j_decompress_ptr); +var + master : my_master_ptr; +begin + master := my_master_ptr (cinfo^.master); + + { Prevent application from calling me at wrong times } + if (cinfo^.global_state <> DSTATE_BUFIMAGE) then + ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); + + if (cinfo^.quantize_colors) and (cinfo^.enable_external_quant) and + (cinfo^.colormap <> NIL) then + begin + { Select 2-pass quantizer for external colormap use } + cinfo^.cquantize := master^.quantizer_2pass; + { Notify quantizer of colormap change } + cinfo^.cquantize^.new_color_map (cinfo); + master^.pub.is_dummy_pass := FALSE; { just in case } + end + else + ERREXIT(j_common_ptr(cinfo), JERR_MODE_CHANGE); +end; + +{$endif} { D_MULTISCAN_FILES_SUPPORTED } + + +{ Initialize master decompression control and select active modules. + This is performed at the start of jpeg_start_decompress. } + +{GLOBAL} +procedure jinit_master_decompress (cinfo : j_decompress_ptr); +var + master : my_master_ptr; +begin + master := my_master_ptr ( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + SIZEOF(my_decomp_master)) ); + cinfo^.master := jpeg_decomp_master_ptr(master); + master^.pub.prepare_for_output_pass := prepare_for_output_pass; + master^.pub.finish_output_pass := finish_output_pass; + + master^.pub.is_dummy_pass := FALSE; + + master_selection(cinfo); +end; + +end. diff --git a/Imaging/JpegLib/imjdmerge.pas b/Imaging/JpegLib/imjdmerge.pas index 1b0387e..3e9c7fb 100644 --- a/Imaging/JpegLib/imjdmerge.pas +++ b/Imaging/JpegLib/imjdmerge.pas @@ -1,514 +1,514 @@ -unit imjdmerge; - -{ This file contains code for merged upsampling/color conversion. - - This file combines functions from jdsample.c and jdcolor.c; - read those files first to understand what's going on. - - When the chroma components are to be upsampled by simple replication - (ie, box filtering), we can save some work in color conversion by - calculating all the output pixels corresponding to a pair of chroma - samples at one time. In the conversion equations - R := Y + K1 * Cr - G := Y + K2 * Cb + K3 * Cr - B := Y + K4 * Cb - only the Y term varies among the group of pixels corresponding to a pair - of chroma samples, so the rest of the terms can be calculated just once. - At typical sampling ratios, this eliminates half or three-quarters of the - multiplications needed for color conversion. - - This file currently provides implementations for the following cases: - YCbCr => RGB color conversion only. - Sampling ratios of 2h1v or 2h2v. - No scaling needed at upsample time. - Corner-aligned (non-CCIR601) sampling alignment. - Other special cases could be added, but in most applications these are - the only common cases. (For uncommon cases we fall back on the more - general code in jdsample.c and jdcolor.c.) } - -{ Original: jdmerge.c ; Copyright (C) 1994-1996, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjpeglib, - imjutils; - -{ Module initialization routine for merged upsampling/color conversion. - - NB: this is called under the conditions determined by use_merged_upsample() - in jdmaster.c. That routine MUST correspond to the actual capabilities - of this module; no safety checks are made here. } - -{GLOBAL} -procedure jinit_merged_upsampler (cinfo : j_decompress_ptr); - -implementation - - -{ Private subobject } - -type { the same definition as in JdColor } - int_Color_Table = array[0..MAXJSAMPLE+1-1] of int; - int_CConvertPtr = ^int_Color_Table; - INT32_Color_Table = array[0..MAXJSAMPLE+1-1] of INT32; - INT32_CConvertPtr = ^INT32_Color_Table; - -type - my_upsample_ptr = ^my_upsampler; - my_upsampler = record - pub : jpeg_upsampler; { public fields } - - { Pointer to routine to do actual upsampling/conversion of one row group } - upmethod : procedure (cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - in_row_group_ctr : JDIMENSION; - output_buf : JSAMPARRAY); - - { Private state for YCC->RGB conversion } - Cr_r_tab : int_CConvertPtr; { => table for Cr to R conversion } - Cb_b_tab : int_CConvertPtr; { => table for Cb to B conversion } - Cr_g_tab : INT32_CConvertPtr; { => table for Cr to G conversion } - Cb_g_tab : INT32_CConvertPtr; { => table for Cb to G conversion } - - { For 2:1 vertical sampling, we produce two output rows at a time. - We need a "spare" row buffer to hold the second output row if the - application provides just a one-row buffer; we also use the spare - to discard the dummy last row if the image height is odd. } - - spare_row : JSAMPROW; - spare_full : boolean; { TRUE if spare buffer is occupied } - - out_row_width : JDIMENSION; { samples per output row } - rows_to_go : JDIMENSION; { counts rows remaining in image } - end; {my_upsampler;} - - -const - SCALEBITS = 16; { speediest right-shift on some machines } - ONE_HALF = (INT32(1) shl (SCALEBITS-1)); - - -{ Initialize tables for YCC->RGB colorspace conversion. - This is taken directly from jdcolor.c; see that file for more info. } - -{LOCAL} -procedure build_ycc_rgb_table (cinfo : j_decompress_ptr); -const - FIX_1_40200 = INT32( Round(1.40200 * (INT32(1) shl SCALEBITS)) ); - FIX_1_77200 = INT32( Round(1.77200 * (INT32(1) shl SCALEBITS)) ); - FIX_0_71414 = INT32( Round(0.71414 * (INT32(1) shl SCALEBITS)) ); - FIX_0_34414 = INT32( Round(0.34414 * (INT32(1) shl SCALEBITS)) ); -var - upsample : my_upsample_ptr; - i : int; - x : INT32; -var - shift_temp : INT32; -begin - upsample := my_upsample_ptr (cinfo^.upsample); - - upsample^.Cr_r_tab := int_CConvertPtr ( - cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE, - (MAXJSAMPLE+1) * SIZEOF(int)) ); - upsample^.Cb_b_tab := int_CConvertPtr ( - cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE, - (MAXJSAMPLE+1) * SIZEOF(int)) ); - upsample^.Cr_g_tab := INT32_CConvertPtr ( - cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE, - (MAXJSAMPLE+1) * SIZEOF(INT32)) ); - upsample^.Cb_g_tab := INT32_CConvertPtr ( - cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE, - (MAXJSAMPLE+1) * SIZEOF(INT32)) ); - - x := -CENTERJSAMPLE; - for i := 0 to pred(MAXJSAMPLE) do - begin - { i is the actual input pixel value, in the range 0..MAXJSAMPLE } - { The Cb or Cr value we are thinking of is x := i - CENTERJSAMPLE } - { Cr=>R value is nearest int to 1.40200 * x } - {upsample^.Cr_r_tab^[i] := int( - RIGHT_SHIFT(FIX_1_40200 * x + ONE_HALF, SCALEBITS) );} - shift_temp := FIX_1_40200 * x + ONE_HALF; - if shift_temp < 0 then { SHIFT arithmetic RIGHT } - upsample^.Cr_r_tab^[i] := int((shift_temp shr SCALEBITS) - or ( (not INT32(0)) shl (32-SCALEBITS))) - else - upsample^.Cr_r_tab^[i] := int(shift_temp shr SCALEBITS); - - - { Cb=>B value is nearest int to 1.77200 * x } - {upsample^.Cb_b_tab^[i] := int( - RIGHT_SHIFT(FIX_1_77200 * x + ONE_HALF, SCALEBITS) );} - shift_temp := FIX_1_77200 * x + ONE_HALF; - if shift_temp < 0 then { SHIFT arithmetic RIGHT } - upsample^.Cb_b_tab^[i] := int((shift_temp shr SCALEBITS) - or ( (not INT32(0)) shl (32-SCALEBITS))) - else - upsample^.Cb_b_tab^[i] := int(shift_temp shr SCALEBITS); - - { Cr=>G value is scaled-up -0.71414 * x } - upsample^.Cr_g_tab^[i] := (- FIX_0_71414) * x; - { Cb=>G value is scaled-up -0.34414 * x } - { We also add in ONE_HALF so that need not do it in inner loop } - upsample^.Cb_g_tab^[i] := (- FIX_0_34414) * x + ONE_HALF; - Inc(x); - end; -end; - - -{ Initialize for an upsampling pass. } - -{METHODDEF} -procedure start_pass_merged_upsample (cinfo : j_decompress_ptr); -var - upsample : my_upsample_ptr; -begin - upsample := my_upsample_ptr (cinfo^.upsample); - - { Mark the spare buffer empty } - upsample^.spare_full := FALSE; - { Initialize total-height counter for detecting bottom of image } - upsample^.rows_to_go := cinfo^.output_height; -end; - - -{ Control routine to do upsampling (and color conversion). - - The control routine just handles the row buffering considerations. } - -{METHODDEF} -procedure merged_2v_upsample (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); -{ 2:1 vertical sampling case: may need a spare row. } -var - upsample : my_upsample_ptr; - work_ptrs : array[0..2-1] of JSAMPROW; - num_rows : JDIMENSION; { number of rows returned to caller } -begin - upsample := my_upsample_ptr (cinfo^.upsample); - - if (upsample^.spare_full) then - begin - { If we have a spare row saved from a previous cycle, just return it. } - jcopy_sample_rows(JSAMPARRAY(@upsample^.spare_row), - 0, - JSAMPARRAY(@ output_buf^[out_row_ctr]), - 0, 1, upsample^.out_row_width); - num_rows := 1; - upsample^.spare_full := FALSE; - end - else - begin - { Figure number of rows to return to caller. } - num_rows := 2; - { Not more than the distance to the end of the image. } - if (num_rows > upsample^.rows_to_go) then - num_rows := upsample^.rows_to_go; - { And not more than what the client can accept: } - Dec(out_rows_avail, {var} out_row_ctr); - if (num_rows > out_rows_avail) then - num_rows := out_rows_avail; - { Create output pointer array for upsampler. } - work_ptrs[0] := output_buf^[out_row_ctr]; - if (num_rows > 1) then - begin - work_ptrs[1] := output_buf^[out_row_ctr + 1]; - end - else - begin - work_ptrs[1] := upsample^.spare_row; - upsample^.spare_full := TRUE; - end; - { Now do the upsampling. } - upsample^.upmethod (cinfo, input_buf, {var}in_row_group_ctr, - JSAMPARRAY(@work_ptrs)); - end; - - { Adjust counts } - Inc(out_row_ctr, num_rows); - Dec(upsample^.rows_to_go, num_rows); - { When the buffer is emptied, declare this input row group consumed } - if (not upsample^.spare_full) then - Inc(in_row_group_ctr); -end; - - -{METHODDEF} -procedure merged_1v_upsample (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); -{ 1:1 vertical sampling case: much easier, never need a spare row. } -var - upsample : my_upsample_ptr; -begin - upsample := my_upsample_ptr (cinfo^.upsample); - - { Just do the upsampling. } - upsample^.upmethod (cinfo, input_buf, in_row_group_ctr, - JSAMPARRAY(@ output_buf^[out_row_ctr])); - { Adjust counts } - Inc(out_row_ctr); - Inc(in_row_group_ctr); -end; - - -{ These are the routines invoked by the control routines to do - the actual upsampling/conversion. One row group is processed per call. - - Note: since we may be writing directly into application-supplied buffers, - we have to be honest about the output width; we can't assume the buffer - has been rounded up to an even width. } - - -{ Upsample and color convert for the case of 2:1 horizontal and 1:1 vertical. } - -{METHODDEF} -procedure h2v1_merged_upsample (cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - in_row_group_ctr : JDIMENSION; - output_buf : JSAMPARRAY); -var - upsample : my_upsample_ptr; - {register} y, cred, cgreen, cblue : int; - cb, cr : int; - {register} outptr : JSAMPROW; - inptr0, inptr1, inptr2 : JSAMPLE_PTR; - col : JDIMENSION; - { copy these pointers into registers if possible } - {register} range_limit : range_limit_table_ptr; - Crrtab : int_CConvertPtr; - Cbbtab : int_CConvertPtr; - Crgtab : INT32_CConvertPtr; - Cbgtab : INT32_CConvertPtr; -var - shift_temp : INT32; -begin - upsample := my_upsample_ptr (cinfo^.upsample); - range_limit := cinfo^.sample_range_limit; - Crrtab := upsample^.Cr_r_tab; - Cbbtab := upsample^.Cb_b_tab; - Crgtab := upsample^.Cr_g_tab; - Cbgtab := upsample^.Cb_g_tab; - - inptr0 := JSAMPLE_PTR(input_buf^[0]^[in_row_group_ctr]); - inptr1 := JSAMPLE_PTR(input_buf^[1]^[in_row_group_ctr]); - inptr2 := JSAMPLE_PTR(input_buf^[2]^[in_row_group_ctr]); - outptr := output_buf^[0]; - { Loop for each pair of output pixels } - for col := pred(cinfo^.output_width shr 1) downto 0 do - begin - { Do the chroma part of the calculation } - cb := GETJSAMPLE(inptr1^); - Inc(inptr1); - cr := GETJSAMPLE(inptr2^); - Inc(inptr2); - cred := Crrtab^[cr]; - {cgreen := int( RIGHT_SHIFT(Cbgtab[cb] + Crgtab[cr], SCALEBITS) );} - shift_temp := Cbgtab^[cb] + Crgtab^[cr]; - if shift_temp < 0 then { SHIFT arithmetic RIGHT } - cgreen := int((shift_temp shr SCALEBITS) - or ( (not INT32(0)) shl (32-SCALEBITS))) - else - cgreen := int(shift_temp shr SCALEBITS); - - cblue := Cbbtab^[cb]; - { Fetch 2 Y values and emit 2 pixels } - y := GETJSAMPLE(inptr0^); - Inc(inptr0); - outptr^[RGB_RED] := range_limit^[y + cred]; - outptr^[RGB_GREEN] := range_limit^[y + cgreen]; - outptr^[RGB_BLUE] := range_limit^[y + cblue]; - Inc(JSAMPLE_PTR(outptr), RGB_PIXELSIZE); - y := GETJSAMPLE(inptr0^); - Inc(inptr0); - outptr^[RGB_RED] := range_limit^[y + cred]; - outptr^[RGB_GREEN] := range_limit^[y + cgreen]; - outptr^[RGB_BLUE] := range_limit^[y + cblue]; - Inc(JSAMPLE_PTR(outptr), RGB_PIXELSIZE); - end; - { If image width is odd, do the last output column separately } - if Odd(cinfo^.output_width) then - begin - cb := GETJSAMPLE(inptr1^); - cr := GETJSAMPLE(inptr2^); - cred := Crrtab^[cr]; - {cgreen := int ( RIGHT_SHIFT(Cbgtab[cb] + Crgtab[cr], SCALEBITS) );} - shift_temp := Cbgtab^[cb] + Crgtab^[cr]; - if shift_temp < 0 then { SHIFT arithmetic RIGHT } - cgreen := int((shift_temp shr SCALEBITS) - or ( (not INT32(0)) shl (32-SCALEBITS))) - else - cgreen := int(shift_temp shr SCALEBITS); - - cblue := Cbbtab^[cb]; - y := GETJSAMPLE(inptr0^); - outptr^[RGB_RED] := range_limit^[y + cred]; - outptr^[RGB_GREEN] := range_limit^[y + cgreen]; - outptr^[RGB_BLUE] := range_limit^[y + cblue]; - end; -end; - - -{ Upsample and color convert for the case of 2:1 horizontal and 2:1 vertical. } - -{METHODDEF} -procedure h2v2_merged_upsample (cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - in_row_group_ctr : JDIMENSION; - output_buf : JSAMPARRAY); -var - upsample : my_upsample_ptr; - {register} y, cred, cgreen, cblue : int; - cb, cr : int; - {register} outptr0, outptr1 : JSAMPROW; - inptr00, inptr01, inptr1, inptr2 : JSAMPLE_PTR; - col : JDIMENSION; - { copy these pointers into registers if possible } - {register} range_limit : range_limit_table_ptr; - Crrtab : int_CConvertPtr; - Cbbtab : int_CConvertPtr; - Crgtab : INT32_CConvertPtr; - Cbgtab : INT32_CConvertPtr; -var - shift_temp : INT32; -begin - upsample := my_upsample_ptr (cinfo^.upsample); - range_limit := cinfo^.sample_range_limit; - Crrtab := upsample^.Cr_r_tab; - Cbbtab := upsample^.Cb_b_tab; - Crgtab := upsample^.Cr_g_tab; - Cbgtab := upsample^.Cb_g_tab; - - inptr00 := JSAMPLE_PTR(input_buf^[0]^[in_row_group_ctr*2]); - inptr01 := JSAMPLE_PTR(input_buf^[0]^[in_row_group_ctr*2 + 1]); - inptr1 := JSAMPLE_PTR(input_buf^[1]^[in_row_group_ctr]); - inptr2 := JSAMPLE_PTR(input_buf^[2]^[in_row_group_ctr]); - outptr0 := output_buf^[0]; - outptr1 := output_buf^[1]; - { Loop for each group of output pixels } - for col := pred(cinfo^.output_width shr 1) downto 0 do - begin - { Do the chroma part of the calculation } - cb := GETJSAMPLE(inptr1^); - Inc(inptr1); - cr := GETJSAMPLE(inptr2^); - Inc(inptr2); - cred := Crrtab^[cr]; - {cgreen := int( RIGHT_SHIFT(Cbgtab[cb] + Crgtab[cr], SCALEBITS) );} - shift_temp := Cbgtab^[cb] + Crgtab^[cr]; - if shift_temp < 0 then { SHIFT arithmetic RIGHT } - cgreen := int((shift_temp shr SCALEBITS) - or ( (not INT32(0)) shl (32-SCALEBITS))) - else - cgreen := int(shift_temp shr SCALEBITS); - - cblue := Cbbtab^[cb]; - { Fetch 4 Y values and emit 4 pixels } - y := GETJSAMPLE(inptr00^); - Inc(inptr00); - outptr0^[RGB_RED] := range_limit^[y + cred]; - outptr0^[RGB_GREEN] := range_limit^[y + cgreen]; - outptr0^[RGB_BLUE] := range_limit^[y + cblue]; - Inc(JSAMPLE_PTR(outptr0), RGB_PIXELSIZE); - y := GETJSAMPLE(inptr00^); - Inc(inptr00); - outptr0^[RGB_RED] := range_limit^[y + cred]; - outptr0^[RGB_GREEN] := range_limit^[y + cgreen]; - outptr0^[RGB_BLUE] := range_limit^[y + cblue]; - Inc(JSAMPLE_PTR(outptr0), RGB_PIXELSIZE); - y := GETJSAMPLE(inptr01^); - Inc(inptr01); - outptr1^[RGB_RED] := range_limit^[y + cred]; - outptr1^[RGB_GREEN] := range_limit^[y + cgreen]; - outptr1^[RGB_BLUE] := range_limit^[y + cblue]; - Inc(JSAMPLE_PTR(outptr1), RGB_PIXELSIZE); - y := GETJSAMPLE(inptr01^); - Inc(inptr01); - outptr1^[RGB_RED] := range_limit^[y + cred]; - outptr1^[RGB_GREEN] := range_limit^[y + cgreen]; - outptr1^[RGB_BLUE] := range_limit^[y + cblue]; - Inc(JSAMPLE_PTR(outptr1), RGB_PIXELSIZE); - end; - { If image width is odd, do the last output column separately } - if Odd(cinfo^.output_width) then - begin - cb := GETJSAMPLE(inptr1^); - cr := GETJSAMPLE(inptr2^); - cred := Crrtab^[cr]; - {cgreen := int (RIGHT_SHIFT(Cbgtab[cb] + Crgtab[cr], SCALEBITS));} - shift_temp := Cbgtab^[cb] + Crgtab^[cr]; - if shift_temp < 0 then { SHIFT arithmetic RIGHT } - cgreen := int((shift_temp shr SCALEBITS) - or ( (not INT32(0)) shl (32-SCALEBITS))) - else - cgreen := int(shift_temp shr SCALEBITS); - - cblue := Cbbtab^[cb]; - y := GETJSAMPLE(inptr00^); - outptr0^[RGB_RED] := range_limit^[y + cred]; - outptr0^[RGB_GREEN] := range_limit^[y + cgreen]; - outptr0^[RGB_BLUE] := range_limit^[y + cblue]; - y := GETJSAMPLE(inptr01^); - outptr1^[RGB_RED] := range_limit^[y + cred]; - outptr1^[RGB_GREEN] := range_limit^[y + cgreen]; - outptr1^[RGB_BLUE] := range_limit^[y + cblue]; - end; -end; - - -{ Module initialization routine for merged upsampling/color conversion. - - NB: this is called under the conditions determined by use_merged_upsample() - in jdmaster.c. That routine MUST correspond to the actual capabilities - of this module; no safety checks are made here. } - - -{GLOBAL} -procedure jinit_merged_upsampler (cinfo : j_decompress_ptr); -var - upsample : my_upsample_ptr; -begin - upsample := my_upsample_ptr ( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_upsampler)) ); - cinfo^.upsample := jpeg_upsampler_ptr (upsample); - upsample^.pub.start_pass := start_pass_merged_upsample; - upsample^.pub.need_context_rows := FALSE; - - upsample^.out_row_width := cinfo^.output_width * JDIMENSION(cinfo^.out_color_components); - - if (cinfo^.max_v_samp_factor = 2) then - begin - upsample^.pub.upsample := merged_2v_upsample; - upsample^.upmethod := h2v2_merged_upsample; - { Allocate a spare row buffer } - upsample^.spare_row := JSAMPROW( - cinfo^.mem^.alloc_large ( j_common_ptr(cinfo), JPOOL_IMAGE, - size_t (upsample^.out_row_width * SIZEOF(JSAMPLE))) ); - end - else - begin - upsample^.pub.upsample := merged_1v_upsample; - upsample^.upmethod := h2v1_merged_upsample; - { No spare row needed } - upsample^.spare_row := NIL; - end; - - build_ycc_rgb_table(cinfo); -end; - -end. +unit imjdmerge; + +{ This file contains code for merged upsampling/color conversion. + + This file combines functions from jdsample.c and jdcolor.c; + read those files first to understand what's going on. + + When the chroma components are to be upsampled by simple replication + (ie, box filtering), we can save some work in color conversion by + calculating all the output pixels corresponding to a pair of chroma + samples at one time. In the conversion equations + R := Y + K1 * Cr + G := Y + K2 * Cb + K3 * Cr + B := Y + K4 * Cb + only the Y term varies among the group of pixels corresponding to a pair + of chroma samples, so the rest of the terms can be calculated just once. + At typical sampling ratios, this eliminates half or three-quarters of the + multiplications needed for color conversion. + + This file currently provides implementations for the following cases: + YCbCr => RGB color conversion only. + Sampling ratios of 2h1v or 2h2v. + No scaling needed at upsample time. + Corner-aligned (non-CCIR601) sampling alignment. + Other special cases could be added, but in most applications these are + the only common cases. (For uncommon cases we fall back on the more + general code in jdsample.c and jdcolor.c.) } + +{ Original: jdmerge.c ; Copyright (C) 1994-1996, Thomas G. Lane. } + +interface + +{$I imjconfig.inc} + +uses + imjmorecfg, + imjinclude, + imjpeglib, + imjutils; + +{ Module initialization routine for merged upsampling/color conversion. + + NB: this is called under the conditions determined by use_merged_upsample() + in jdmaster.c. That routine MUST correspond to the actual capabilities + of this module; no safety checks are made here. } + +{GLOBAL} +procedure jinit_merged_upsampler (cinfo : j_decompress_ptr); + +implementation + + +{ Private subobject } + +type { the same definition as in JdColor } + int_Color_Table = array[0..MAXJSAMPLE+1-1] of int; + int_CConvertPtr = ^int_Color_Table; + INT32_Color_Table = array[0..MAXJSAMPLE+1-1] of INT32; + INT32_CConvertPtr = ^INT32_Color_Table; + +type + my_upsample_ptr = ^my_upsampler; + my_upsampler = record + pub : jpeg_upsampler; { public fields } + + { Pointer to routine to do actual upsampling/conversion of one row group } + upmethod : procedure (cinfo : j_decompress_ptr; + input_buf : JSAMPIMAGE; + in_row_group_ctr : JDIMENSION; + output_buf : JSAMPARRAY); + + { Private state for YCC->RGB conversion } + Cr_r_tab : int_CConvertPtr; { => table for Cr to R conversion } + Cb_b_tab : int_CConvertPtr; { => table for Cb to B conversion } + Cr_g_tab : INT32_CConvertPtr; { => table for Cr to G conversion } + Cb_g_tab : INT32_CConvertPtr; { => table for Cb to G conversion } + + { For 2:1 vertical sampling, we produce two output rows at a time. + We need a "spare" row buffer to hold the second output row if the + application provides just a one-row buffer; we also use the spare + to discard the dummy last row if the image height is odd. } + + spare_row : JSAMPROW; + spare_full : boolean; { TRUE if spare buffer is occupied } + + out_row_width : JDIMENSION; { samples per output row } + rows_to_go : JDIMENSION; { counts rows remaining in image } + end; {my_upsampler;} + + +const + SCALEBITS = 16; { speediest right-shift on some machines } + ONE_HALF = (INT32(1) shl (SCALEBITS-1)); + + +{ Initialize tables for YCC->RGB colorspace conversion. + This is taken directly from jdcolor.c; see that file for more info. } + +{LOCAL} +procedure build_ycc_rgb_table (cinfo : j_decompress_ptr); +const + FIX_1_40200 = INT32( Round(1.40200 * (INT32(1) shl SCALEBITS)) ); + FIX_1_77200 = INT32( Round(1.77200 * (INT32(1) shl SCALEBITS)) ); + FIX_0_71414 = INT32( Round(0.71414 * (INT32(1) shl SCALEBITS)) ); + FIX_0_34414 = INT32( Round(0.34414 * (INT32(1) shl SCALEBITS)) ); +var + upsample : my_upsample_ptr; + i : int; + x : INT32; +var + shift_temp : INT32; +begin + upsample := my_upsample_ptr (cinfo^.upsample); + + upsample^.Cr_r_tab := int_CConvertPtr ( + cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE, + (MAXJSAMPLE+1) * SIZEOF(int)) ); + upsample^.Cb_b_tab := int_CConvertPtr ( + cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE, + (MAXJSAMPLE+1) * SIZEOF(int)) ); + upsample^.Cr_g_tab := INT32_CConvertPtr ( + cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE, + (MAXJSAMPLE+1) * SIZEOF(INT32)) ); + upsample^.Cb_g_tab := INT32_CConvertPtr ( + cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE, + (MAXJSAMPLE+1) * SIZEOF(INT32)) ); + + x := -CENTERJSAMPLE; + for i := 0 to pred(MAXJSAMPLE) do + begin + { i is the actual input pixel value, in the range 0..MAXJSAMPLE } + { The Cb or Cr value we are thinking of is x := i - CENTERJSAMPLE } + { Cr=>R value is nearest int to 1.40200 * x } + {upsample^.Cr_r_tab^[i] := int( + RIGHT_SHIFT(FIX_1_40200 * x + ONE_HALF, SCALEBITS) );} + shift_temp := FIX_1_40200 * x + ONE_HALF; + if shift_temp < 0 then { SHIFT arithmetic RIGHT } + upsample^.Cr_r_tab^[i] := int((shift_temp shr SCALEBITS) + or ( (not INT32(0)) shl (32-SCALEBITS))) + else + upsample^.Cr_r_tab^[i] := int(shift_temp shr SCALEBITS); + + + { Cb=>B value is nearest int to 1.77200 * x } + {upsample^.Cb_b_tab^[i] := int( + RIGHT_SHIFT(FIX_1_77200 * x + ONE_HALF, SCALEBITS) );} + shift_temp := FIX_1_77200 * x + ONE_HALF; + if shift_temp < 0 then { SHIFT arithmetic RIGHT } + upsample^.Cb_b_tab^[i] := int((shift_temp shr SCALEBITS) + or ( (not INT32(0)) shl (32-SCALEBITS))) + else + upsample^.Cb_b_tab^[i] := int(shift_temp shr SCALEBITS); + + { Cr=>G value is scaled-up -0.71414 * x } + upsample^.Cr_g_tab^[i] := (- FIX_0_71414) * x; + { Cb=>G value is scaled-up -0.34414 * x } + { We also add in ONE_HALF so that need not do it in inner loop } + upsample^.Cb_g_tab^[i] := (- FIX_0_34414) * x + ONE_HALF; + Inc(x); + end; +end; + + +{ Initialize for an upsampling pass. } + +{METHODDEF} +procedure start_pass_merged_upsample (cinfo : j_decompress_ptr); +var + upsample : my_upsample_ptr; +begin + upsample := my_upsample_ptr (cinfo^.upsample); + + { Mark the spare buffer empty } + upsample^.spare_full := FALSE; + { Initialize total-height counter for detecting bottom of image } + upsample^.rows_to_go := cinfo^.output_height; +end; + + +{ Control routine to do upsampling (and color conversion). + + The control routine just handles the row buffering considerations. } + +{METHODDEF} +procedure merged_2v_upsample (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); +{ 2:1 vertical sampling case: may need a spare row. } +var + upsample : my_upsample_ptr; + work_ptrs : array[0..2-1] of JSAMPROW; + num_rows : JDIMENSION; { number of rows returned to caller } +begin + upsample := my_upsample_ptr (cinfo^.upsample); + + if (upsample^.spare_full) then + begin + { If we have a spare row saved from a previous cycle, just return it. } + jcopy_sample_rows(JSAMPARRAY(@upsample^.spare_row), + 0, + JSAMPARRAY(@ output_buf^[out_row_ctr]), + 0, 1, upsample^.out_row_width); + num_rows := 1; + upsample^.spare_full := FALSE; + end + else + begin + { Figure number of rows to return to caller. } + num_rows := 2; + { Not more than the distance to the end of the image. } + if (num_rows > upsample^.rows_to_go) then + num_rows := upsample^.rows_to_go; + { And not more than what the client can accept: } + Dec(out_rows_avail, {var} out_row_ctr); + if (num_rows > out_rows_avail) then + num_rows := out_rows_avail; + { Create output pointer array for upsampler. } + work_ptrs[0] := output_buf^[out_row_ctr]; + if (num_rows > 1) then + begin + work_ptrs[1] := output_buf^[out_row_ctr + 1]; + end + else + begin + work_ptrs[1] := upsample^.spare_row; + upsample^.spare_full := TRUE; + end; + { Now do the upsampling. } + upsample^.upmethod (cinfo, input_buf, {var}in_row_group_ctr, + JSAMPARRAY(@work_ptrs)); + end; + + { Adjust counts } + Inc(out_row_ctr, num_rows); + Dec(upsample^.rows_to_go, num_rows); + { When the buffer is emptied, declare this input row group consumed } + if (not upsample^.spare_full) then + Inc(in_row_group_ctr); +end; + + +{METHODDEF} +procedure merged_1v_upsample (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); +{ 1:1 vertical sampling case: much easier, never need a spare row. } +var + upsample : my_upsample_ptr; +begin + upsample := my_upsample_ptr (cinfo^.upsample); + + { Just do the upsampling. } + upsample^.upmethod (cinfo, input_buf, in_row_group_ctr, + JSAMPARRAY(@ output_buf^[out_row_ctr])); + { Adjust counts } + Inc(out_row_ctr); + Inc(in_row_group_ctr); +end; + + +{ These are the routines invoked by the control routines to do + the actual upsampling/conversion. One row group is processed per call. + + Note: since we may be writing directly into application-supplied buffers, + we have to be honest about the output width; we can't assume the buffer + has been rounded up to an even width. } + + +{ Upsample and color convert for the case of 2:1 horizontal and 1:1 vertical. } + +{METHODDEF} +procedure h2v1_merged_upsample (cinfo : j_decompress_ptr; + input_buf : JSAMPIMAGE; + in_row_group_ctr : JDIMENSION; + output_buf : JSAMPARRAY); +var + upsample : my_upsample_ptr; + {register} y, cred, cgreen, cblue : int; + cb, cr : int; + {register} outptr : JSAMPROW; + inptr0, inptr1, inptr2 : JSAMPLE_PTR; + col : JDIMENSION; + { copy these pointers into registers if possible } + {register} range_limit : range_limit_table_ptr; + Crrtab : int_CConvertPtr; + Cbbtab : int_CConvertPtr; + Crgtab : INT32_CConvertPtr; + Cbgtab : INT32_CConvertPtr; +var + shift_temp : INT32; +begin + upsample := my_upsample_ptr (cinfo^.upsample); + range_limit := cinfo^.sample_range_limit; + Crrtab := upsample^.Cr_r_tab; + Cbbtab := upsample^.Cb_b_tab; + Crgtab := upsample^.Cr_g_tab; + Cbgtab := upsample^.Cb_g_tab; + + inptr0 := JSAMPLE_PTR(input_buf^[0]^[in_row_group_ctr]); + inptr1 := JSAMPLE_PTR(input_buf^[1]^[in_row_group_ctr]); + inptr2 := JSAMPLE_PTR(input_buf^[2]^[in_row_group_ctr]); + outptr := output_buf^[0]; + { Loop for each pair of output pixels } + for col := pred(cinfo^.output_width shr 1) downto 0 do + begin + { Do the chroma part of the calculation } + cb := GETJSAMPLE(inptr1^); + Inc(inptr1); + cr := GETJSAMPLE(inptr2^); + Inc(inptr2); + cred := Crrtab^[cr]; + {cgreen := int( RIGHT_SHIFT(Cbgtab[cb] + Crgtab[cr], SCALEBITS) );} + shift_temp := Cbgtab^[cb] + Crgtab^[cr]; + if shift_temp < 0 then { SHIFT arithmetic RIGHT } + cgreen := int((shift_temp shr SCALEBITS) + or ( (not INT32(0)) shl (32-SCALEBITS))) + else + cgreen := int(shift_temp shr SCALEBITS); + + cblue := Cbbtab^[cb]; + { Fetch 2 Y values and emit 2 pixels } + y := GETJSAMPLE(inptr0^); + Inc(inptr0); + outptr^[RGB_RED] := range_limit^[y + cred]; + outptr^[RGB_GREEN] := range_limit^[y + cgreen]; + outptr^[RGB_BLUE] := range_limit^[y + cblue]; + Inc(JSAMPLE_PTR(outptr), RGB_PIXELSIZE); + y := GETJSAMPLE(inptr0^); + Inc(inptr0); + outptr^[RGB_RED] := range_limit^[y + cred]; + outptr^[RGB_GREEN] := range_limit^[y + cgreen]; + outptr^[RGB_BLUE] := range_limit^[y + cblue]; + Inc(JSAMPLE_PTR(outptr), RGB_PIXELSIZE); + end; + { If image width is odd, do the last output column separately } + if Odd(cinfo^.output_width) then + begin + cb := GETJSAMPLE(inptr1^); + cr := GETJSAMPLE(inptr2^); + cred := Crrtab^[cr]; + {cgreen := int ( RIGHT_SHIFT(Cbgtab[cb] + Crgtab[cr], SCALEBITS) );} + shift_temp := Cbgtab^[cb] + Crgtab^[cr]; + if shift_temp < 0 then { SHIFT arithmetic RIGHT } + cgreen := int((shift_temp shr SCALEBITS) + or ( (not INT32(0)) shl (32-SCALEBITS))) + else + cgreen := int(shift_temp shr SCALEBITS); + + cblue := Cbbtab^[cb]; + y := GETJSAMPLE(inptr0^); + outptr^[RGB_RED] := range_limit^[y + cred]; + outptr^[RGB_GREEN] := range_limit^[y + cgreen]; + outptr^[RGB_BLUE] := range_limit^[y + cblue]; + end; +end; + + +{ Upsample and color convert for the case of 2:1 horizontal and 2:1 vertical. } + +{METHODDEF} +procedure h2v2_merged_upsample (cinfo : j_decompress_ptr; + input_buf : JSAMPIMAGE; + in_row_group_ctr : JDIMENSION; + output_buf : JSAMPARRAY); +var + upsample : my_upsample_ptr; + {register} y, cred, cgreen, cblue : int; + cb, cr : int; + {register} outptr0, outptr1 : JSAMPROW; + inptr00, inptr01, inptr1, inptr2 : JSAMPLE_PTR; + col : JDIMENSION; + { copy these pointers into registers if possible } + {register} range_limit : range_limit_table_ptr; + Crrtab : int_CConvertPtr; + Cbbtab : int_CConvertPtr; + Crgtab : INT32_CConvertPtr; + Cbgtab : INT32_CConvertPtr; +var + shift_temp : INT32; +begin + upsample := my_upsample_ptr (cinfo^.upsample); + range_limit := cinfo^.sample_range_limit; + Crrtab := upsample^.Cr_r_tab; + Cbbtab := upsample^.Cb_b_tab; + Crgtab := upsample^.Cr_g_tab; + Cbgtab := upsample^.Cb_g_tab; + + inptr00 := JSAMPLE_PTR(input_buf^[0]^[in_row_group_ctr*2]); + inptr01 := JSAMPLE_PTR(input_buf^[0]^[in_row_group_ctr*2 + 1]); + inptr1 := JSAMPLE_PTR(input_buf^[1]^[in_row_group_ctr]); + inptr2 := JSAMPLE_PTR(input_buf^[2]^[in_row_group_ctr]); + outptr0 := output_buf^[0]; + outptr1 := output_buf^[1]; + { Loop for each group of output pixels } + for col := pred(cinfo^.output_width shr 1) downto 0 do + begin + { Do the chroma part of the calculation } + cb := GETJSAMPLE(inptr1^); + Inc(inptr1); + cr := GETJSAMPLE(inptr2^); + Inc(inptr2); + cred := Crrtab^[cr]; + {cgreen := int( RIGHT_SHIFT(Cbgtab[cb] + Crgtab[cr], SCALEBITS) );} + shift_temp := Cbgtab^[cb] + Crgtab^[cr]; + if shift_temp < 0 then { SHIFT arithmetic RIGHT } + cgreen := int((shift_temp shr SCALEBITS) + or ( (not INT32(0)) shl (32-SCALEBITS))) + else + cgreen := int(shift_temp shr SCALEBITS); + + cblue := Cbbtab^[cb]; + { Fetch 4 Y values and emit 4 pixels } + y := GETJSAMPLE(inptr00^); + Inc(inptr00); + outptr0^[RGB_RED] := range_limit^[y + cred]; + outptr0^[RGB_GREEN] := range_limit^[y + cgreen]; + outptr0^[RGB_BLUE] := range_limit^[y + cblue]; + Inc(JSAMPLE_PTR(outptr0), RGB_PIXELSIZE); + y := GETJSAMPLE(inptr00^); + Inc(inptr00); + outptr0^[RGB_RED] := range_limit^[y + cred]; + outptr0^[RGB_GREEN] := range_limit^[y + cgreen]; + outptr0^[RGB_BLUE] := range_limit^[y + cblue]; + Inc(JSAMPLE_PTR(outptr0), RGB_PIXELSIZE); + y := GETJSAMPLE(inptr01^); + Inc(inptr01); + outptr1^[RGB_RED] := range_limit^[y + cred]; + outptr1^[RGB_GREEN] := range_limit^[y + cgreen]; + outptr1^[RGB_BLUE] := range_limit^[y + cblue]; + Inc(JSAMPLE_PTR(outptr1), RGB_PIXELSIZE); + y := GETJSAMPLE(inptr01^); + Inc(inptr01); + outptr1^[RGB_RED] := range_limit^[y + cred]; + outptr1^[RGB_GREEN] := range_limit^[y + cgreen]; + outptr1^[RGB_BLUE] := range_limit^[y + cblue]; + Inc(JSAMPLE_PTR(outptr1), RGB_PIXELSIZE); + end; + { If image width is odd, do the last output column separately } + if Odd(cinfo^.output_width) then + begin + cb := GETJSAMPLE(inptr1^); + cr := GETJSAMPLE(inptr2^); + cred := Crrtab^[cr]; + {cgreen := int (RIGHT_SHIFT(Cbgtab[cb] + Crgtab[cr], SCALEBITS));} + shift_temp := Cbgtab^[cb] + Crgtab^[cr]; + if shift_temp < 0 then { SHIFT arithmetic RIGHT } + cgreen := int((shift_temp shr SCALEBITS) + or ( (not INT32(0)) shl (32-SCALEBITS))) + else + cgreen := int(shift_temp shr SCALEBITS); + + cblue := Cbbtab^[cb]; + y := GETJSAMPLE(inptr00^); + outptr0^[RGB_RED] := range_limit^[y + cred]; + outptr0^[RGB_GREEN] := range_limit^[y + cgreen]; + outptr0^[RGB_BLUE] := range_limit^[y + cblue]; + y := GETJSAMPLE(inptr01^); + outptr1^[RGB_RED] := range_limit^[y + cred]; + outptr1^[RGB_GREEN] := range_limit^[y + cgreen]; + outptr1^[RGB_BLUE] := range_limit^[y + cblue]; + end; +end; + + +{ Module initialization routine for merged upsampling/color conversion. + + NB: this is called under the conditions determined by use_merged_upsample() + in jdmaster.c. That routine MUST correspond to the actual capabilities + of this module; no safety checks are made here. } + + +{GLOBAL} +procedure jinit_merged_upsampler (cinfo : j_decompress_ptr); +var + upsample : my_upsample_ptr; +begin + upsample := my_upsample_ptr ( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + SIZEOF(my_upsampler)) ); + cinfo^.upsample := jpeg_upsampler_ptr (upsample); + upsample^.pub.start_pass := start_pass_merged_upsample; + upsample^.pub.need_context_rows := FALSE; + + upsample^.out_row_width := cinfo^.output_width * JDIMENSION(cinfo^.out_color_components); + + if (cinfo^.max_v_samp_factor = 2) then + begin + upsample^.pub.upsample := merged_2v_upsample; + upsample^.upmethod := h2v2_merged_upsample; + { Allocate a spare row buffer } + upsample^.spare_row := JSAMPROW( + cinfo^.mem^.alloc_large ( j_common_ptr(cinfo), JPOOL_IMAGE, + size_t (upsample^.out_row_width * SIZEOF(JSAMPLE))) ); + end + else + begin + upsample^.pub.upsample := merged_1v_upsample; + upsample^.upmethod := h2v1_merged_upsample; + { No spare row needed } + upsample^.spare_row := NIL; + end; + + build_ycc_rgb_table(cinfo); +end; + +end. diff --git a/Imaging/JpegLib/imjdphuff.pas b/Imaging/JpegLib/imjdphuff.pas index f5cf0df..a49bed1 100644 --- a/Imaging/JpegLib/imjdphuff.pas +++ b/Imaging/JpegLib/imjdphuff.pas @@ -1,1061 +1,1061 @@ -unit imjdphuff; - -{ This file contains Huffman entropy decoding routines for progressive JPEG. - - Much of the complexity here has to do with supporting input suspension. - If the data source module demands suspension, we want to be able to back - up to the start of the current MCU. To do this, we copy state variables - into local working storage, and update them back to the permanent - storage only upon successful completion of an MCU. } - -{ Original: jdphuff.c ; Copyright (C) 1995-1997, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjpeglib, - imjdeferr, - imjerror, - imjutils, - imjdhuff; { Declarations shared with jdhuff.c } - - -{GLOBAL} -procedure jinit_phuff_decoder (cinfo : j_decompress_ptr); - -implementation - -{ Expanded entropy decoder object for progressive Huffman decoding. - - The savable_state subrecord contains fields that change within an MCU, - but must not be updated permanently until we complete the MCU. } - -type - savable_state = record - EOBRUN : uInt; { remaining EOBs in EOBRUN } - last_dc_val : array[00..MAX_COMPS_IN_SCAN-1] of int; - { last DC coef for each component } - end; - - -type - phuff_entropy_ptr = ^phuff_entropy_decoder; - phuff_entropy_decoder = record - pub : jpeg_entropy_decoder; { public fields } - - { These fields are loaded into local variables at start of each MCU. - In case of suspension, we exit WITHOUT updating them. } - - bitstate : bitread_perm_state; { Bit buffer at start of MCU } - saved : savable_state; { Other state at start of MCU } - - { These fields are NOT loaded into local working state. } - restarts_to_go : uInt; { MCUs left in this restart interval } - - { Pointers to derived tables (these workspaces have image lifespan) } - derived_tbls : array[0..NUM_HUFF_TBLS-1] of d_derived_tbl_ptr; - - ac_derived_tbl : d_derived_tbl_ptr; { active table during an AC scan } - end; - - - -{ Forward declarations } -{METHODDEF} -function decode_mcu_DC_first (cinfo : j_decompress_ptr; - var MCU_data : array of JBLOCKROW) : boolean; - forward; -{METHODDEF} -function decode_mcu_AC_first (cinfo : j_decompress_ptr; - var MCU_data : array of JBLOCKROW) : boolean; - forward; -{METHODDEF} -function decode_mcu_DC_refine (cinfo : j_decompress_ptr; - var MCU_data : array of JBLOCKROW) : boolean; - forward; -{METHODDEF} -function decode_mcu_AC_refine (cinfo : j_decompress_ptr; - var MCU_data : array of JBLOCKROW) : boolean; - forward; - -{ Initialize for a Huffman-compressed scan. } - -{METHODDEF} -procedure start_pass_phuff_decoder (cinfo : j_decompress_ptr); -var - entropy : phuff_entropy_ptr; - is_DC_band, bad : boolean; - ci, coefi, tbl : int; - coef_bit_ptr : coef_bits_ptr; - compptr : jpeg_component_info_ptr; -var - cindex : int; - expected : int; -begin - entropy := phuff_entropy_ptr (cinfo^.entropy); - - is_DC_band := (cinfo^.Ss = 0); - - { Validate scan parameters } - bad := FALSE; - if (is_DC_band) then - begin - if (cinfo^.Se <> 0) then - bad := TRUE; - end - else - begin - { need not check Ss/Se < 0 since they came from unsigned bytes } - if (cinfo^.Ss > cinfo^.Se) or (cinfo^.Se >= DCTSIZE2) then - bad := TRUE; - { AC scans may have only one component } - if (cinfo^.comps_in_scan <> 1) then - bad := TRUE; - end; - if (cinfo^.Ah <> 0) then - begin - { Successive approximation refinement scan: must have Al = Ah-1. } - if (cinfo^.Al <> cinfo^.Ah-1) then - bad := TRUE; - end; - if (cinfo^.Al > 13) then { need not check for < 0 } - bad := TRUE; - { Arguably the maximum Al value should be less than 13 for 8-bit precision, - but the spec doesn't say so, and we try to be liberal about what we - accept. Note: large Al values could result in out-of-range DC - coefficients during early scans, leading to bizarre displays due to - overflows in the IDCT math. But we won't crash. } - - if (bad) then - ERREXIT4(j_common_ptr(cinfo), JERR_BAD_PROGRESSION, - cinfo^.Ss, cinfo^.Se, cinfo^.Ah, cinfo^.Al); - { Update progression status, and verify that scan order is legal. - Note that inter-scan inconsistencies are treated as warnings - not fatal errors ... not clear if this is right way to behave. } - - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - cindex := cinfo^.cur_comp_info[ci]^.component_index; - coef_bit_ptr := coef_bits_ptr(@(cinfo^.coef_bits^[cindex])); {^[0] ??? - Nomssi } - if (not is_DC_band) and (coef_bit_ptr^[0] < 0) then - { AC without prior DC scan } - WARNMS2(j_common_ptr(cinfo), JWRN_BOGUS_PROGRESSION, cindex, 0); - for coefi := cinfo^.Ss to cinfo^.Se do - begin - if (coef_bit_ptr^[coefi] < 0) then - expected := 0 - else - expected := coef_bit_ptr^[coefi]; - if (cinfo^.Ah <> expected) then - WARNMS2(j_common_ptr(cinfo), JWRN_BOGUS_PROGRESSION, cindex, coefi); - coef_bit_ptr^[coefi] := cinfo^.Al; - end; - end; - - { Select MCU decoding routine } - if (cinfo^.Ah = 0) then - begin - if (is_DC_band) then - entropy^.pub.decode_mcu := decode_mcu_DC_first - else - entropy^.pub.decode_mcu := decode_mcu_AC_first; - end - else - begin - if (is_DC_band) then - entropy^.pub.decode_mcu := decode_mcu_DC_refine - else - entropy^.pub.decode_mcu := decode_mcu_AC_refine; - end; - - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - { Make sure requested tables are present, and compute derived tables. - We may build same derived table more than once, but it's not expensive. } - - if (is_DC_band) then - begin - if (cinfo^.Ah = 0) then - begin { DC refinement needs no table } - tbl := compptr^.dc_tbl_no; - jpeg_make_d_derived_tbl(cinfo, TRUE, tbl, - entropy^.derived_tbls[tbl]); - end; - end - else - begin - tbl := compptr^.ac_tbl_no; - jpeg_make_d_derived_tbl(cinfo, FALSE, tbl, - entropy^.derived_tbls[tbl]); - { remember the single active table } - entropy^.ac_derived_tbl := entropy^.derived_tbls[tbl]; - end; - { Initialize DC predictions to 0 } - entropy^.saved.last_dc_val[ci] := 0; - end; - - { Initialize bitread state variables } - entropy^.bitstate.bits_left := 0; - entropy^.bitstate.get_buffer := 0; { unnecessary, but keeps Purify quiet } - entropy^.pub.insufficient_data := FALSE; - - { Initialize private state variables } - entropy^.saved.EOBRUN := 0; - - { Initialize restart counter } - entropy^.restarts_to_go := cinfo^.restart_interval; -end; - - -{ Figure F.12: extend sign bit. - On some machines, a shift and add will be faster than a table lookup. } - -{$ifdef AVOID_TABLES} - -#define HUFF_EXTEND(x,s) - ((x) < (1shl((s)-1)) ? (x) + (((-1)shl(s)) + 1) : (x)) - -{$else} - -{ #define HUFF_EXTEND(x,s) - if (x) < extend_test[s] then - (x) + extend_offset[s] - else - (x)} - -const - extend_test : Array[0..16-1] of int = { entry n is 2**(n-1) } - ($0000, $0001, $0002, $0004, $0008, $0010, $0020, $0040, - $0080, $0100, $0200, $0400, $0800, $1000, $2000, $4000); - -const - extend_offset : array[0..16-1] of int = { entry n is (-1 shl n) + 1 } - ( 0, ((-1) shl 1) + 1, ((-1) shl 2) + 1, ((-1) shl 3) + 1, ((-1) shl 4) + 1, - ((-1) shl 5) + 1, ((-1) shl 6) + 1, ((-1) shl 7) + 1, ((-1) shl 8) + 1, - ((-1) shl 9) + 1, ((-1) shl 10) + 1, ((-1) shl 11) + 1, ((-1) shl 12) + 1, - ((-1) shl 13) + 1, ((-1) shl 14) + 1, ((-1) shl 15) + 1 ); - -{$endif} { AVOID_TABLES } - - -{ Check for a restart marker & resynchronize decoder. - return:=s FALSE if must suspend. } - -{LOCAL} -function process_restart (cinfo : j_decompress_ptr) : boolean; -var - entropy : phuff_entropy_ptr; - ci : int; -begin - entropy := phuff_entropy_ptr (cinfo^.entropy); - - { Throw away any unused bits remaining in bit buffer; } - { include any full bytes in next_marker's count of discarded bytes } - Inc(cinfo^.marker^.discarded_bytes, entropy^.bitstate.bits_left div 8); - entropy^.bitstate.bits_left := 0; - - { Advance past the RSTn marker } - if (not cinfo^.marker^.read_restart_marker (cinfo)) then - begin - process_restart := FALSE; - exit; - end; - - { Re-initialize DC predictions to 0 } - for ci := 0 to pred(cinfo^.comps_in_scan) do - entropy^.saved.last_dc_val[ci] := 0; - { Re-init EOB run count, too } - entropy^.saved.EOBRUN := 0; - - { Reset restart counter } - entropy^.restarts_to_go := cinfo^.restart_interval; - - { Reset out-of-data flag, unless read_restart_marker left us smack up - against a marker. In that case we will end up treating the next data - segment as empty, and we can avoid producing bogus output pixels by - leaving the flag set. } - if (cinfo^.unread_marker = 0) then - entropy^.pub.insufficient_data := FALSE; - - process_restart := TRUE; -end; - - -{ Huffman MCU decoding. - Each of these routines decodes and returns one MCU's worth of - Huffman-compressed coefficients. - The coefficients are reordered from zigzag order into natural array order, - but are not dequantized. - - The i'th block of the MCU is stored into the block pointed to by - MCU_data[i]. WE ASSUME THIS AREA IS INITIALLY ZEROED BY THE CALLER. - - We return FALSE if data source requested suspension. In that case no - changes have been made to permanent state. (Exception: some output - coefficients may already have been assigned. This is harmless for - spectral selection, since we'll just re-assign them on the next call. - Successive approximation AC refinement has to be more careful, however.) } - - -{ MCU decoding for DC initial scan (either spectral selection, - or first pass of successive approximation). } - -{METHODDEF} -function decode_mcu_DC_first (cinfo : j_decompress_ptr; - var MCU_data : array of JBLOCKROW) : boolean; -label - label1; -var - entropy : phuff_entropy_ptr; - Al : int; - {register} s, r : int; - blkn, ci : int; - block : JBLOCK_PTR; - {BITREAD_STATE_VARS;} - get_buffer : bit_buf_type ; {register} - bits_left : int; {register} - br_state : bitread_working_state; - - state : savable_state; - tbl : d_derived_tbl_ptr; - compptr : jpeg_component_info_ptr; -var - nb, look : int; {register} -begin - entropy := phuff_entropy_ptr (cinfo^.entropy); - Al := cinfo^.Al; - - { Process restart marker if needed; may have to suspend } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - if (not process_restart(cinfo)) then - begin - decode_mcu_DC_first := FALSE; - exit; - end; - end; - - { If we've run out of data, just leave the MCU set to zeroes. - This way, we return uniform gray for the remainder of the segment. } - - if not entropy^.pub.insufficient_data then - begin - - { Load up working state } - {BITREAD_LOAD_STATE(cinfo,entropy^.bitstate);} - br_state.cinfo := cinfo; - br_state.next_input_byte := cinfo^.src^.next_input_byte; - br_state.bytes_in_buffer := cinfo^.src^.bytes_in_buffer; - get_buffer := entropy^.bitstate.get_buffer; - bits_left := entropy^.bitstate.bits_left; - - {ASSIGN_STATE(state, entropy^.saved);} - state := entropy^.saved; - - { Outer loop handles each block in the MCU } - - for blkn := 0 to pred(cinfo^.blocks_in_MCU) do - begin - block := JBLOCK_PTR(MCU_data[blkn]); - ci := cinfo^.MCU_membership[blkn]; - compptr := cinfo^.cur_comp_info[ci]; - tbl := entropy^.derived_tbls[compptr^.dc_tbl_no]; - - { Decode a single block's worth of coefficients } - - { Section F.2.2.1: decode the DC coefficient difference } - {HUFF_DECODE(s, br_state, tbl, return FALSE, label1);} - if (bits_left < HUFF_LOOKAHEAD) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then - begin - decode_mcu_DC_first := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - if (bits_left < HUFF_LOOKAHEAD) then - begin - nb := 1; - goto label1; - end; - end; - {look := PEEK_BITS(HUFF_LOOKAHEAD);} - look := int(get_buffer shr (bits_left - HUFF_LOOKAHEAD)) and - pred(1 shl HUFF_LOOKAHEAD); - - nb := tbl^.look_nbits[look]; - if (nb <> 0) then - begin - {DROP_BITS(nb);} - Dec(bits_left, nb); - - s := tbl^.look_sym[look]; - end - else - begin - nb := HUFF_LOOKAHEAD+1; - label1: - s := jpeg_huff_decode(br_state,get_buffer,bits_left,tbl,nb); - if (s < 0) then - begin - decode_mcu_DC_first := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - if (s <> 0) then - begin - {CHECK_BIT_BUFFER(br_state, s, return FALSE);} - if (bits_left < s) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,s)) then - begin - decode_mcu_DC_first := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - {r := GET_BITS(s);} - Dec(bits_left, s); - r := (int(get_buffer shr bits_left)) and ( pred(1 shl s) ); - - {s := HUFF_EXTEND(r, s);} - if (r < extend_test[s]) then - s := r + extend_offset[s] - else - s := r; - end; - - { Convert DC difference to actual value, update last_dc_val } - Inc(s, state.last_dc_val[ci]); - state.last_dc_val[ci] := s; - { Scale and output the DC coefficient (assumes jpeg_natural_order[0]=0) } - block^[0] := JCOEF (s shl Al); - end; - - { Completed MCU, so update state } - {BITREAD_SAVE_STATE(cinfo,entropy^.bitstate);} - cinfo^.src^.next_input_byte := br_state.next_input_byte; - cinfo^.src^.bytes_in_buffer := br_state.bytes_in_buffer; - entropy^.bitstate.get_buffer := get_buffer; - entropy^.bitstate.bits_left := bits_left; - - {ASSIGN_STATE(entropy^.saved, state);} - entropy^.saved := state; - end; - - { Account for restart interval (no-op if not using restarts) } - Dec(entropy^.restarts_to_go); - - decode_mcu_DC_first := TRUE; -end; - - -{ MCU decoding for AC initial scan (either spectral selection, - or first pass of successive approximation). } - -{METHODDEF} -function decode_mcu_AC_first (cinfo : j_decompress_ptr; - var MCU_data : array of JBLOCKROW) : boolean; -label - label2; -var - entropy : phuff_entropy_ptr; - Se : int; - Al : int; - {register} s, k, r : int; - EOBRUN : uInt; - block : JBLOCK_PTR; - {BITREAD_STATE_VARS;} - get_buffer : bit_buf_type ; {register} - bits_left : int; {register} - br_state : bitread_working_state; - - tbl : d_derived_tbl_ptr; -var - nb, look : int; {register} -begin - entropy := phuff_entropy_ptr (cinfo^.entropy); - Se := cinfo^.Se; - Al := cinfo^.Al; - - { Process restart marker if needed; may have to suspend } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - if (not process_restart(cinfo)) then - begin - decode_mcu_AC_first := FALSE; - exit; - end; - end; - - { If we've run out of data, just leave the MCU set to zeroes. - This way, we return uniform gray for the remainder of the segment. } - if not entropy^.pub.insufficient_data then - begin - - { Load up working state. - We can avoid loading/saving bitread state if in an EOB run. } - - EOBRUN := entropy^.saved.EOBRUN; { only part of saved state we care about } - - { There is always only one block per MCU } - - if (EOBRUN > 0) then { if it's a band of zeroes... } - Dec(EOBRUN) { ...process it now (we do nothing) } - else - begin - {BITREAD_LOAD_STATE(cinfo,entropy^.bitstate);} - br_state.cinfo := cinfo; - br_state.next_input_byte := cinfo^.src^.next_input_byte; - br_state.bytes_in_buffer := cinfo^.src^.bytes_in_buffer; - get_buffer := entropy^.bitstate.get_buffer; - bits_left := entropy^.bitstate.bits_left; - - block := JBLOCK_PTR(MCU_data[0]); - tbl := entropy^.ac_derived_tbl; - - k := cinfo^.Ss; - while (k <= Se) do - begin - {HUFF_DECODE(s, br_state, tbl, return FALSE, label2);} - if (bits_left < HUFF_LOOKAHEAD) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then - begin - decode_mcu_AC_first := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - if (bits_left < HUFF_LOOKAHEAD) then - begin - nb := 1; - goto label2; - end; - end; - {look := PEEK_BITS(HUFF_LOOKAHEAD);} - look := int(get_buffer shr (bits_left - HUFF_LOOKAHEAD)) and - pred(1 shl HUFF_LOOKAHEAD); - - nb := tbl^.look_nbits[look]; - if (nb <> 0) then - begin - {DROP_BITS(nb);} - Dec(bits_left, nb); - - s := tbl^.look_sym[look]; - end - else - begin - nb := HUFF_LOOKAHEAD+1; - label2: - s := jpeg_huff_decode(br_state,get_buffer,bits_left,tbl,nb); - if (s < 0) then - begin - decode_mcu_AC_first := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - r := s shr 4; - s := s and 15; - if (s <> 0) then - begin - Inc(k, r); - {CHECK_BIT_BUFFER(br_state, s, return FALSE);} - if (bits_left < s) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,s)) then - begin - decode_mcu_AC_first := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - {r := GET_BITS(s);} - Dec(bits_left, s); - r := (int(get_buffer shr bits_left)) and ( pred(1 shl s) ); - - {s := HUFF_EXTEND(r, s);} - if (r < extend_test[s]) then - s := r + extend_offset[s] - else - s := r; - - { Scale and output coefficient in natural (dezigzagged) order } - block^[jpeg_natural_order[k]] := JCOEF (s shl Al); - end - else - begin - if (r = 15) then - begin { ZRL } - Inc(k, 15); { skip 15 zeroes in band } - end - else - begin { EOBr, run length is 2^r + appended bits } - EOBRUN := 1 shl r; - if (r <> 0) then - begin { EOBr, r > 0 } - {CHECK_BIT_BUFFER(br_state, r, return FALSE);} - if (bits_left < r) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,r)) then - begin - decode_mcu_AC_first := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - {r := GET_BITS(r);} - Dec(bits_left, r); - r := (int(get_buffer shr bits_left)) and ( pred(1 shl r) ); - - Inc(EOBRUN, r); - end; - Dec(EOBRUN); { this band is processed at this moment } - break; { force end-of-band } - end; - end; - Inc(k); - end; - - {BITREAD_SAVE_STATE(cinfo,entropy^.bitstate);} - cinfo^.src^.next_input_byte := br_state.next_input_byte; - cinfo^.src^.bytes_in_buffer := br_state.bytes_in_buffer; - entropy^.bitstate.get_buffer := get_buffer; - entropy^.bitstate.bits_left := bits_left; - end; - - { Completed MCU, so update state } - entropy^.saved.EOBRUN := EOBRUN; { only part of saved state we care about } - end; - - { Account for restart interval (no-op if not using restarts) } - Dec(entropy^.restarts_to_go); - - decode_mcu_AC_first := TRUE; -end; - - -{ MCU decoding for DC successive approximation refinement scan. - Note: we assume such scans can be multi-component, although the spec - is not very clear on the point. } - -{METHODDEF} -function decode_mcu_DC_refine (cinfo : j_decompress_ptr; - var MCU_data : array of JBLOCKROW) : boolean; - -var - entropy : phuff_entropy_ptr; - p1 : int; { 1 in the bit position being coded } - blkn : int; - block : JBLOCK_PTR; - {BITREAD_STATE_VARS;} - get_buffer : bit_buf_type ; {register} - bits_left : int; {register} - br_state : bitread_working_state; -begin - entropy := phuff_entropy_ptr (cinfo^.entropy); - p1 := 1 shl cinfo^.Al; - - { Process restart marker if needed; may have to suspend } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - if (not process_restart(cinfo)) then - begin - decode_mcu_DC_refine := FALSE; - exit; - end; - end; - - { Not worth the cycles to check insufficient_data here, - since we will not change the data anyway if we read zeroes. } - - { Load up working state } - {BITREAD_LOAD_STATE(cinfo,entropy^.bitstate);} - br_state.cinfo := cinfo; - br_state.next_input_byte := cinfo^.src^.next_input_byte; - br_state.bytes_in_buffer := cinfo^.src^.bytes_in_buffer; - get_buffer := entropy^.bitstate.get_buffer; - bits_left := entropy^.bitstate.bits_left; - - { Outer loop handles each block in the MCU } - - for blkn := 0 to pred(cinfo^.blocks_in_MCU) do - begin - block := JBLOCK_PTR(MCU_data[blkn]); - - { Encoded data is simply the next bit of the two's-complement DC value } - {CHECK_BIT_BUFFER(br_state, 1, return FALSE);} - if (bits_left < 1) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,1)) then - begin - decode_mcu_DC_refine := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - {if (GET_BITS(1)) then} - Dec(bits_left); - if (int(get_buffer shr bits_left)) and ( pred(1 shl 1) ) <> 0 then - block^[0] := block^[0] or p1; - { Note: since we use OR, repeating the assignment later is safe } - end; - - { Completed MCU, so update state } - {BITREAD_SAVE_STATE(cinfo,entropy^.bitstate);} - cinfo^.src^.next_input_byte := br_state.next_input_byte; - cinfo^.src^.bytes_in_buffer := br_state.bytes_in_buffer; - entropy^.bitstate.get_buffer := get_buffer; - entropy^.bitstate.bits_left := bits_left; - - { Account for restart interval (no-op if not using restarts) } - Dec(entropy^.restarts_to_go); - - decode_mcu_DC_refine := TRUE; -end; - - -{ MCU decoding for AC successive approximation refinement scan. } - -{METHODDEF} -function decode_mcu_AC_refine (cinfo : j_decompress_ptr; - var MCU_data : array of JBLOCKROW) : boolean; -label - undoit, label3; -var - entropy : phuff_entropy_ptr; - Se : int; - p1 : int; { 1 in the bit position being coded } - m1 : int; { -1 in the bit position being coded } - {register} s, k, r : int; - EOBRUN : uInt; - block : JBLOCK_PTR; - thiscoef : JCOEF_PTR; - {BITREAD_STATE_VARS;} - get_buffer : bit_buf_type ; {register} - bits_left : int; {register} - br_state : bitread_working_state; - - tbl : d_derived_tbl_ptr; - num_newnz : int; - newnz_pos : array[0..DCTSIZE2-1] of int; -var - pos : int; -var - nb, look : int; {register} -begin - num_newnz := 0; - block := nil; - - entropy := phuff_entropy_ptr (cinfo^.entropy); - Se := cinfo^.Se; - p1 := 1 shl cinfo^.Al; { 1 in the bit position being coded } - m1 := (-1) shl cinfo^.Al; { -1 in the bit position being coded } - - { Process restart marker if needed; may have to suspend } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - if (not process_restart(cinfo)) then - begin - decode_mcu_AC_refine := FALSE; - exit; - end; - end; - - { If we've run out of data, don't modify the MCU. } - if not entropy^.pub.insufficient_data then - begin - - { Load up working state } - {BITREAD_LOAD_STATE(cinfo,entropy^.bitstate);} - br_state.cinfo := cinfo; - br_state.next_input_byte := cinfo^.src^.next_input_byte; - br_state.bytes_in_buffer := cinfo^.src^.bytes_in_buffer; - get_buffer := entropy^.bitstate.get_buffer; - bits_left := entropy^.bitstate.bits_left; - - EOBRUN := entropy^.saved.EOBRUN; { only part of saved state we care about } - - { There is always only one block per MCU } - block := JBLOCK_PTR(MCU_data[0]); - tbl := entropy^.ac_derived_tbl; - - { If we are forced to suspend, we must undo the assignments to any newly - nonzero coefficients in the block, because otherwise we'd get confused - next time about which coefficients were already nonzero. - But we need not undo addition of bits to already-nonzero coefficients; - instead, we can test the current bit position to see if we already did it.} - - num_newnz := 0; - - { initialize coefficient loop counter to start of band } - k := cinfo^.Ss; - - if (EOBRUN = 0) then - begin - while (k <= Se) do - begin - {HUFF_DECODE(s, br_state, tbl, goto undoit, label3);} - if (bits_left < HUFF_LOOKAHEAD) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then - goto undoit; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - if (bits_left < HUFF_LOOKAHEAD) then - begin - nb := 1; - goto label3; - end; - end; - {look := PEEK_BITS(HUFF_LOOKAHEAD);} - look := int(get_buffer shr (bits_left - HUFF_LOOKAHEAD)) and - pred(1 shl HUFF_LOOKAHEAD); - - nb := tbl^.look_nbits[look]; - if (nb <> 0) then - begin - {DROP_BITS(nb);} - Dec(bits_left, nb); - - s := tbl^.look_sym[look]; - end - else - begin - nb := HUFF_LOOKAHEAD+1; - label3: - s := jpeg_huff_decode(br_state,get_buffer,bits_left,tbl,nb); - if (s < 0) then - goto undoit; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - r := s shr 4; - s := s and 15; - if (s <> 0) then - begin - if (s <> 1) then { size of new coef should always be 1 } - WARNMS(j_common_ptr(cinfo), JWRN_HUFF_BAD_CODE); - {CHECK_BIT_BUFFER(br_state, 1, goto undoit);} - if (bits_left < 1) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,1)) then - goto undoit; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - {if (GET_BITS(1)) then} - Dec(bits_left); - if (int(get_buffer shr bits_left)) and ( pred(1 shl 1) )<>0 then - s := p1 { newly nonzero coef is positive } - else - s := m1; { newly nonzero coef is negative } - end - else - begin - if (r <> 15) then - begin - EOBRUN := 1 shl r; { EOBr, run length is 2^r + appended bits } - if (r <> 0) then - begin - {CHECK_BIT_BUFFER(br_state, r, goto undoit);} - if (bits_left < r) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,r)) then - goto undoit; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - {r := GET_BITS(r);} - Dec(bits_left, r); - r := (int(get_buffer shr bits_left)) and ( pred(1 shl r) ); - - Inc(EOBRUN, r); - end; - break; { rest of block is handled by EOB logic } - end; - { note s := 0 for processing ZRL } - end; - { Advance over already-nonzero coefs and r still-zero coefs, - appending correction bits to the nonzeroes. A correction bit is 1 - if the absolute value of the coefficient must be increased. } - - repeat - thiscoef :=@(block^[jpeg_natural_order[k]]); - if (thiscoef^ <> 0) then - begin - {CHECK_BIT_BUFFER(br_state, 1, goto undoit);} - if (bits_left < 1) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,1)) then - goto undoit; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - {if (GET_BITS(1)) then} - Dec(bits_left); - if (int(get_buffer shr bits_left)) and ( pred(1 shl 1) )<>0 then - begin - if ((thiscoef^ and p1) = 0) then - begin { do nothing if already set it } - if (thiscoef^ >= 0) then - Inc(thiscoef^, p1) - else - Inc(thiscoef^, m1); - end; - end; - end - else - begin - Dec(r); - if (r < 0) then - break; { reached target zero coefficient } - end; - Inc(k); - until (k > Se); - if (s <> 0) then - begin - pos := jpeg_natural_order[k]; - { Output newly nonzero coefficient } - block^[pos] := JCOEF (s); - { Remember its position in case we have to suspend } - newnz_pos[num_newnz] := pos; - Inc(num_newnz); - end; - Inc(k); - end; - end; - - if (EOBRUN > 0) then - begin - { Scan any remaining coefficient positions after the end-of-band - (the last newly nonzero coefficient, if any). Append a correction - bit to each already-nonzero coefficient. A correction bit is 1 - if the absolute value of the coefficient must be increased. } - - while (k <= Se) do - begin - thiscoef := @(block^[jpeg_natural_order[k]]); - if (thiscoef^ <> 0) then - begin - {CHECK_BIT_BUFFER(br_state, 1, goto undoit);} - if (bits_left < 1) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,1)) then - goto undoit; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - {if (GET_BITS(1)) then} - Dec(bits_left); - if (int(get_buffer shr bits_left)) and ( pred(1 shl 1) )<>0 then - begin - if ((thiscoef^ and p1) = 0) then - begin { do nothing if already changed it } - if (thiscoef^ >= 0) then - Inc(thiscoef^, p1) - else - Inc(thiscoef^, m1); - end; - end; - end; - Inc(k); - end; - { Count one block completed in EOB run } - Dec(EOBRUN); - end; - - { Completed MCU, so update state } - {BITREAD_SAVE_STATE(cinfo,entropy^.bitstate);} - cinfo^.src^.next_input_byte := br_state.next_input_byte; - cinfo^.src^.bytes_in_buffer := br_state.bytes_in_buffer; - entropy^.bitstate.get_buffer := get_buffer; - entropy^.bitstate.bits_left := bits_left; - - entropy^.saved.EOBRUN := EOBRUN; { only part of saved state we care about } - end; - - { Account for restart interval (no-op if not using restarts) } - Dec(entropy^.restarts_to_go); - - decode_mcu_AC_refine := TRUE; - exit; - -undoit: - { Re-zero any output coefficients that we made newly nonzero } - while (num_newnz > 0) do - begin - Dec(num_newnz); - block^[newnz_pos[num_newnz]] := 0; - end; - - decode_mcu_AC_refine := FALSE; -end; - - -{ Module initialization routine for progressive Huffman entropy decoding. } - -{GLOBAL} -procedure jinit_phuff_decoder (cinfo : j_decompress_ptr); -var - entropy : phuff_entropy_ptr; - coef_bit_ptr : int_ptr; - ci, i : int; -begin - entropy := phuff_entropy_ptr( - cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE, - SIZEOF(phuff_entropy_decoder)) ); - cinfo^.entropy := jpeg_entropy_decoder_ptr (entropy); - entropy^.pub.start_pass := start_pass_phuff_decoder; - - { Mark derived tables unallocated } - for i := 0 to pred(NUM_HUFF_TBLS) do - begin - entropy^.derived_tbls[i] := NIL; - end; - - { Create progression status table } - cinfo^.coef_bits := coef_bits_ptrrow ( - cinfo^.mem^.alloc_small ( j_common_ptr (cinfo), JPOOL_IMAGE, - cinfo^.num_components*DCTSIZE2*SIZEOF(int)) ); - coef_bit_ptr := @cinfo^.coef_bits^[0][0]; - for ci := 0 to pred(cinfo^.num_components) do - for i := 0 to pred(DCTSIZE2) do - begin - coef_bit_ptr^ := -1; - Inc(coef_bit_ptr); - end; -end; - -end. +unit imjdphuff; + +{ This file contains Huffman entropy decoding routines for progressive JPEG. + + Much of the complexity here has to do with supporting input suspension. + If the data source module demands suspension, we want to be able to back + up to the start of the current MCU. To do this, we copy state variables + into local working storage, and update them back to the permanent + storage only upon successful completion of an MCU. } + +{ Original: jdphuff.c ; Copyright (C) 1995-1997, Thomas G. Lane. } + +interface + +{$I imjconfig.inc} + +uses + imjmorecfg, + imjinclude, + imjpeglib, + imjdeferr, + imjerror, + imjutils, + imjdhuff; { Declarations shared with jdhuff.c } + + +{GLOBAL} +procedure jinit_phuff_decoder (cinfo : j_decompress_ptr); + +implementation + +{ Expanded entropy decoder object for progressive Huffman decoding. + + The savable_state subrecord contains fields that change within an MCU, + but must not be updated permanently until we complete the MCU. } + +type + savable_state = record + EOBRUN : uInt; { remaining EOBs in EOBRUN } + last_dc_val : array[00..MAX_COMPS_IN_SCAN-1] of int; + { last DC coef for each component } + end; + + +type + phuff_entropy_ptr = ^phuff_entropy_decoder; + phuff_entropy_decoder = record + pub : jpeg_entropy_decoder; { public fields } + + { These fields are loaded into local variables at start of each MCU. + In case of suspension, we exit WITHOUT updating them. } + + bitstate : bitread_perm_state; { Bit buffer at start of MCU } + saved : savable_state; { Other state at start of MCU } + + { These fields are NOT loaded into local working state. } + restarts_to_go : uInt; { MCUs left in this restart interval } + + { Pointers to derived tables (these workspaces have image lifespan) } + derived_tbls : array[0..NUM_HUFF_TBLS-1] of d_derived_tbl_ptr; + + ac_derived_tbl : d_derived_tbl_ptr; { active table during an AC scan } + end; + + + +{ Forward declarations } +{METHODDEF} +function decode_mcu_DC_first (cinfo : j_decompress_ptr; + var MCU_data : array of JBLOCKROW) : boolean; + forward; +{METHODDEF} +function decode_mcu_AC_first (cinfo : j_decompress_ptr; + var MCU_data : array of JBLOCKROW) : boolean; + forward; +{METHODDEF} +function decode_mcu_DC_refine (cinfo : j_decompress_ptr; + var MCU_data : array of JBLOCKROW) : boolean; + forward; +{METHODDEF} +function decode_mcu_AC_refine (cinfo : j_decompress_ptr; + var MCU_data : array of JBLOCKROW) : boolean; + forward; + +{ Initialize for a Huffman-compressed scan. } + +{METHODDEF} +procedure start_pass_phuff_decoder (cinfo : j_decompress_ptr); +var + entropy : phuff_entropy_ptr; + is_DC_band, bad : boolean; + ci, coefi, tbl : int; + coef_bit_ptr : coef_bits_ptr; + compptr : jpeg_component_info_ptr; +var + cindex : int; + expected : int; +begin + entropy := phuff_entropy_ptr (cinfo^.entropy); + + is_DC_band := (cinfo^.Ss = 0); + + { Validate scan parameters } + bad := FALSE; + if (is_DC_band) then + begin + if (cinfo^.Se <> 0) then + bad := TRUE; + end + else + begin + { need not check Ss/Se < 0 since they came from unsigned bytes } + if (cinfo^.Ss > cinfo^.Se) or (cinfo^.Se >= DCTSIZE2) then + bad := TRUE; + { AC scans may have only one component } + if (cinfo^.comps_in_scan <> 1) then + bad := TRUE; + end; + if (cinfo^.Ah <> 0) then + begin + { Successive approximation refinement scan: must have Al = Ah-1. } + if (cinfo^.Al <> cinfo^.Ah-1) then + bad := TRUE; + end; + if (cinfo^.Al > 13) then { need not check for < 0 } + bad := TRUE; + { Arguably the maximum Al value should be less than 13 for 8-bit precision, + but the spec doesn't say so, and we try to be liberal about what we + accept. Note: large Al values could result in out-of-range DC + coefficients during early scans, leading to bizarre displays due to + overflows in the IDCT math. But we won't crash. } + + if (bad) then + ERREXIT4(j_common_ptr(cinfo), JERR_BAD_PROGRESSION, + cinfo^.Ss, cinfo^.Se, cinfo^.Ah, cinfo^.Al); + { Update progression status, and verify that scan order is legal. + Note that inter-scan inconsistencies are treated as warnings + not fatal errors ... not clear if this is right way to behave. } + + for ci := 0 to pred(cinfo^.comps_in_scan) do + begin + cindex := cinfo^.cur_comp_info[ci]^.component_index; + coef_bit_ptr := coef_bits_ptr(@(cinfo^.coef_bits^[cindex])); {^[0] ??? + Nomssi } + if (not is_DC_band) and (coef_bit_ptr^[0] < 0) then + { AC without prior DC scan } + WARNMS2(j_common_ptr(cinfo), JWRN_BOGUS_PROGRESSION, cindex, 0); + for coefi := cinfo^.Ss to cinfo^.Se do + begin + if (coef_bit_ptr^[coefi] < 0) then + expected := 0 + else + expected := coef_bit_ptr^[coefi]; + if (cinfo^.Ah <> expected) then + WARNMS2(j_common_ptr(cinfo), JWRN_BOGUS_PROGRESSION, cindex, coefi); + coef_bit_ptr^[coefi] := cinfo^.Al; + end; + end; + + { Select MCU decoding routine } + if (cinfo^.Ah = 0) then + begin + if (is_DC_band) then + entropy^.pub.decode_mcu := decode_mcu_DC_first + else + entropy^.pub.decode_mcu := decode_mcu_AC_first; + end + else + begin + if (is_DC_band) then + entropy^.pub.decode_mcu := decode_mcu_DC_refine + else + entropy^.pub.decode_mcu := decode_mcu_AC_refine; + end; + + for ci := 0 to pred(cinfo^.comps_in_scan) do + begin + compptr := cinfo^.cur_comp_info[ci]; + { Make sure requested tables are present, and compute derived tables. + We may build same derived table more than once, but it's not expensive. } + + if (is_DC_band) then + begin + if (cinfo^.Ah = 0) then + begin { DC refinement needs no table } + tbl := compptr^.dc_tbl_no; + jpeg_make_d_derived_tbl(cinfo, TRUE, tbl, + entropy^.derived_tbls[tbl]); + end; + end + else + begin + tbl := compptr^.ac_tbl_no; + jpeg_make_d_derived_tbl(cinfo, FALSE, tbl, + entropy^.derived_tbls[tbl]); + { remember the single active table } + entropy^.ac_derived_tbl := entropy^.derived_tbls[tbl]; + end; + { Initialize DC predictions to 0 } + entropy^.saved.last_dc_val[ci] := 0; + end; + + { Initialize bitread state variables } + entropy^.bitstate.bits_left := 0; + entropy^.bitstate.get_buffer := 0; { unnecessary, but keeps Purify quiet } + entropy^.pub.insufficient_data := FALSE; + + { Initialize private state variables } + entropy^.saved.EOBRUN := 0; + + { Initialize restart counter } + entropy^.restarts_to_go := cinfo^.restart_interval; +end; + + +{ Figure F.12: extend sign bit. + On some machines, a shift and add will be faster than a table lookup. } + +{$ifdef AVOID_TABLES} + +#define HUFF_EXTEND(x,s) + ((x) < (1shl((s)-1)) ? (x) + (((-1)shl(s)) + 1) : (x)) + +{$else} + +{ #define HUFF_EXTEND(x,s) + if (x) < extend_test[s] then + (x) + extend_offset[s] + else + (x)} + +const + extend_test : Array[0..16-1] of int = { entry n is 2**(n-1) } + ($0000, $0001, $0002, $0004, $0008, $0010, $0020, $0040, + $0080, $0100, $0200, $0400, $0800, $1000, $2000, $4000); + +const + extend_offset : array[0..16-1] of int = { entry n is (-1 shl n) + 1 } + ( 0, ((-1) shl 1) + 1, ((-1) shl 2) + 1, ((-1) shl 3) + 1, ((-1) shl 4) + 1, + ((-1) shl 5) + 1, ((-1) shl 6) + 1, ((-1) shl 7) + 1, ((-1) shl 8) + 1, + ((-1) shl 9) + 1, ((-1) shl 10) + 1, ((-1) shl 11) + 1, ((-1) shl 12) + 1, + ((-1) shl 13) + 1, ((-1) shl 14) + 1, ((-1) shl 15) + 1 ); + +{$endif} { AVOID_TABLES } + + +{ Check for a restart marker & resynchronize decoder. + return:=s FALSE if must suspend. } + +{LOCAL} +function process_restart (cinfo : j_decompress_ptr) : boolean; +var + entropy : phuff_entropy_ptr; + ci : int; +begin + entropy := phuff_entropy_ptr (cinfo^.entropy); + + { Throw away any unused bits remaining in bit buffer; } + { include any full bytes in next_marker's count of discarded bytes } + Inc(cinfo^.marker^.discarded_bytes, entropy^.bitstate.bits_left div 8); + entropy^.bitstate.bits_left := 0; + + { Advance past the RSTn marker } + if (not cinfo^.marker^.read_restart_marker (cinfo)) then + begin + process_restart := FALSE; + exit; + end; + + { Re-initialize DC predictions to 0 } + for ci := 0 to pred(cinfo^.comps_in_scan) do + entropy^.saved.last_dc_val[ci] := 0; + { Re-init EOB run count, too } + entropy^.saved.EOBRUN := 0; + + { Reset restart counter } + entropy^.restarts_to_go := cinfo^.restart_interval; + + { Reset out-of-data flag, unless read_restart_marker left us smack up + against a marker. In that case we will end up treating the next data + segment as empty, and we can avoid producing bogus output pixels by + leaving the flag set. } + if (cinfo^.unread_marker = 0) then + entropy^.pub.insufficient_data := FALSE; + + process_restart := TRUE; +end; + + +{ Huffman MCU decoding. + Each of these routines decodes and returns one MCU's worth of + Huffman-compressed coefficients. + The coefficients are reordered from zigzag order into natural array order, + but are not dequantized. + + The i'th block of the MCU is stored into the block pointed to by + MCU_data[i]. WE ASSUME THIS AREA IS INITIALLY ZEROED BY THE CALLER. + + We return FALSE if data source requested suspension. In that case no + changes have been made to permanent state. (Exception: some output + coefficients may already have been assigned. This is harmless for + spectral selection, since we'll just re-assign them on the next call. + Successive approximation AC refinement has to be more careful, however.) } + + +{ MCU decoding for DC initial scan (either spectral selection, + or first pass of successive approximation). } + +{METHODDEF} +function decode_mcu_DC_first (cinfo : j_decompress_ptr; + var MCU_data : array of JBLOCKROW) : boolean; +label + label1; +var + entropy : phuff_entropy_ptr; + Al : int; + {register} s, r : int; + blkn, ci : int; + block : JBLOCK_PTR; + {BITREAD_STATE_VARS;} + get_buffer : bit_buf_type ; {register} + bits_left : int; {register} + br_state : bitread_working_state; + + state : savable_state; + tbl : d_derived_tbl_ptr; + compptr : jpeg_component_info_ptr; +var + nb, look : int; {register} +begin + entropy := phuff_entropy_ptr (cinfo^.entropy); + Al := cinfo^.Al; + + { Process restart marker if needed; may have to suspend } + if (cinfo^.restart_interval <> 0) then + begin + if (entropy^.restarts_to_go = 0) then + if (not process_restart(cinfo)) then + begin + decode_mcu_DC_first := FALSE; + exit; + end; + end; + + { If we've run out of data, just leave the MCU set to zeroes. + This way, we return uniform gray for the remainder of the segment. } + + if not entropy^.pub.insufficient_data then + begin + + { Load up working state } + {BITREAD_LOAD_STATE(cinfo,entropy^.bitstate);} + br_state.cinfo := cinfo; + br_state.next_input_byte := cinfo^.src^.next_input_byte; + br_state.bytes_in_buffer := cinfo^.src^.bytes_in_buffer; + get_buffer := entropy^.bitstate.get_buffer; + bits_left := entropy^.bitstate.bits_left; + + {ASSIGN_STATE(state, entropy^.saved);} + state := entropy^.saved; + + { Outer loop handles each block in the MCU } + + for blkn := 0 to pred(cinfo^.blocks_in_MCU) do + begin + block := JBLOCK_PTR(MCU_data[blkn]); + ci := cinfo^.MCU_membership[blkn]; + compptr := cinfo^.cur_comp_info[ci]; + tbl := entropy^.derived_tbls[compptr^.dc_tbl_no]; + + { Decode a single block's worth of coefficients } + + { Section F.2.2.1: decode the DC coefficient difference } + {HUFF_DECODE(s, br_state, tbl, return FALSE, label1);} + if (bits_left < HUFF_LOOKAHEAD) then + begin + if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then + begin + decode_mcu_DC_first := FALSE; + exit; + end; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + if (bits_left < HUFF_LOOKAHEAD) then + begin + nb := 1; + goto label1; + end; + end; + {look := PEEK_BITS(HUFF_LOOKAHEAD);} + look := int(get_buffer shr (bits_left - HUFF_LOOKAHEAD)) and + pred(1 shl HUFF_LOOKAHEAD); + + nb := tbl^.look_nbits[look]; + if (nb <> 0) then + begin + {DROP_BITS(nb);} + Dec(bits_left, nb); + + s := tbl^.look_sym[look]; + end + else + begin + nb := HUFF_LOOKAHEAD+1; + label1: + s := jpeg_huff_decode(br_state,get_buffer,bits_left,tbl,nb); + if (s < 0) then + begin + decode_mcu_DC_first := FALSE; + exit; + end; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + end; + + if (s <> 0) then + begin + {CHECK_BIT_BUFFER(br_state, s, return FALSE);} + if (bits_left < s) then + begin + if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,s)) then + begin + decode_mcu_DC_first := FALSE; + exit; + end; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + end; + + {r := GET_BITS(s);} + Dec(bits_left, s); + r := (int(get_buffer shr bits_left)) and ( pred(1 shl s) ); + + {s := HUFF_EXTEND(r, s);} + if (r < extend_test[s]) then + s := r + extend_offset[s] + else + s := r; + end; + + { Convert DC difference to actual value, update last_dc_val } + Inc(s, state.last_dc_val[ci]); + state.last_dc_val[ci] := s; + { Scale and output the DC coefficient (assumes jpeg_natural_order[0]=0) } + block^[0] := JCOEF (s shl Al); + end; + + { Completed MCU, so update state } + {BITREAD_SAVE_STATE(cinfo,entropy^.bitstate);} + cinfo^.src^.next_input_byte := br_state.next_input_byte; + cinfo^.src^.bytes_in_buffer := br_state.bytes_in_buffer; + entropy^.bitstate.get_buffer := get_buffer; + entropy^.bitstate.bits_left := bits_left; + + {ASSIGN_STATE(entropy^.saved, state);} + entropy^.saved := state; + end; + + { Account for restart interval (no-op if not using restarts) } + Dec(entropy^.restarts_to_go); + + decode_mcu_DC_first := TRUE; +end; + + +{ MCU decoding for AC initial scan (either spectral selection, + or first pass of successive approximation). } + +{METHODDEF} +function decode_mcu_AC_first (cinfo : j_decompress_ptr; + var MCU_data : array of JBLOCKROW) : boolean; +label + label2; +var + entropy : phuff_entropy_ptr; + Se : int; + Al : int; + {register} s, k, r : int; + EOBRUN : uInt; + block : JBLOCK_PTR; + {BITREAD_STATE_VARS;} + get_buffer : bit_buf_type ; {register} + bits_left : int; {register} + br_state : bitread_working_state; + + tbl : d_derived_tbl_ptr; +var + nb, look : int; {register} +begin + entropy := phuff_entropy_ptr (cinfo^.entropy); + Se := cinfo^.Se; + Al := cinfo^.Al; + + { Process restart marker if needed; may have to suspend } + if (cinfo^.restart_interval <> 0) then + begin + if (entropy^.restarts_to_go = 0) then + if (not process_restart(cinfo)) then + begin + decode_mcu_AC_first := FALSE; + exit; + end; + end; + + { If we've run out of data, just leave the MCU set to zeroes. + This way, we return uniform gray for the remainder of the segment. } + if not entropy^.pub.insufficient_data then + begin + + { Load up working state. + We can avoid loading/saving bitread state if in an EOB run. } + + EOBRUN := entropy^.saved.EOBRUN; { only part of saved state we care about } + + { There is always only one block per MCU } + + if (EOBRUN > 0) then { if it's a band of zeroes... } + Dec(EOBRUN) { ...process it now (we do nothing) } + else + begin + {BITREAD_LOAD_STATE(cinfo,entropy^.bitstate);} + br_state.cinfo := cinfo; + br_state.next_input_byte := cinfo^.src^.next_input_byte; + br_state.bytes_in_buffer := cinfo^.src^.bytes_in_buffer; + get_buffer := entropy^.bitstate.get_buffer; + bits_left := entropy^.bitstate.bits_left; + + block := JBLOCK_PTR(MCU_data[0]); + tbl := entropy^.ac_derived_tbl; + + k := cinfo^.Ss; + while (k <= Se) do + begin + {HUFF_DECODE(s, br_state, tbl, return FALSE, label2);} + if (bits_left < HUFF_LOOKAHEAD) then + begin + if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then + begin + decode_mcu_AC_first := FALSE; + exit; + end; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + if (bits_left < HUFF_LOOKAHEAD) then + begin + nb := 1; + goto label2; + end; + end; + {look := PEEK_BITS(HUFF_LOOKAHEAD);} + look := int(get_buffer shr (bits_left - HUFF_LOOKAHEAD)) and + pred(1 shl HUFF_LOOKAHEAD); + + nb := tbl^.look_nbits[look]; + if (nb <> 0) then + begin + {DROP_BITS(nb);} + Dec(bits_left, nb); + + s := tbl^.look_sym[look]; + end + else + begin + nb := HUFF_LOOKAHEAD+1; + label2: + s := jpeg_huff_decode(br_state,get_buffer,bits_left,tbl,nb); + if (s < 0) then + begin + decode_mcu_AC_first := FALSE; + exit; + end; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + end; + + r := s shr 4; + s := s and 15; + if (s <> 0) then + begin + Inc(k, r); + {CHECK_BIT_BUFFER(br_state, s, return FALSE);} + if (bits_left < s) then + begin + if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,s)) then + begin + decode_mcu_AC_first := FALSE; + exit; + end; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + end; + + {r := GET_BITS(s);} + Dec(bits_left, s); + r := (int(get_buffer shr bits_left)) and ( pred(1 shl s) ); + + {s := HUFF_EXTEND(r, s);} + if (r < extend_test[s]) then + s := r + extend_offset[s] + else + s := r; + + { Scale and output coefficient in natural (dezigzagged) order } + block^[jpeg_natural_order[k]] := JCOEF (s shl Al); + end + else + begin + if (r = 15) then + begin { ZRL } + Inc(k, 15); { skip 15 zeroes in band } + end + else + begin { EOBr, run length is 2^r + appended bits } + EOBRUN := 1 shl r; + if (r <> 0) then + begin { EOBr, r > 0 } + {CHECK_BIT_BUFFER(br_state, r, return FALSE);} + if (bits_left < r) then + begin + if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,r)) then + begin + decode_mcu_AC_first := FALSE; + exit; + end; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + end; + + {r := GET_BITS(r);} + Dec(bits_left, r); + r := (int(get_buffer shr bits_left)) and ( pred(1 shl r) ); + + Inc(EOBRUN, r); + end; + Dec(EOBRUN); { this band is processed at this moment } + break; { force end-of-band } + end; + end; + Inc(k); + end; + + {BITREAD_SAVE_STATE(cinfo,entropy^.bitstate);} + cinfo^.src^.next_input_byte := br_state.next_input_byte; + cinfo^.src^.bytes_in_buffer := br_state.bytes_in_buffer; + entropy^.bitstate.get_buffer := get_buffer; + entropy^.bitstate.bits_left := bits_left; + end; + + { Completed MCU, so update state } + entropy^.saved.EOBRUN := EOBRUN; { only part of saved state we care about } + end; + + { Account for restart interval (no-op if not using restarts) } + Dec(entropy^.restarts_to_go); + + decode_mcu_AC_first := TRUE; +end; + + +{ MCU decoding for DC successive approximation refinement scan. + Note: we assume such scans can be multi-component, although the spec + is not very clear on the point. } + +{METHODDEF} +function decode_mcu_DC_refine (cinfo : j_decompress_ptr; + var MCU_data : array of JBLOCKROW) : boolean; + +var + entropy : phuff_entropy_ptr; + p1 : int; { 1 in the bit position being coded } + blkn : int; + block : JBLOCK_PTR; + {BITREAD_STATE_VARS;} + get_buffer : bit_buf_type ; {register} + bits_left : int; {register} + br_state : bitread_working_state; +begin + entropy := phuff_entropy_ptr (cinfo^.entropy); + p1 := 1 shl cinfo^.Al; + + { Process restart marker if needed; may have to suspend } + if (cinfo^.restart_interval <> 0) then + begin + if (entropy^.restarts_to_go = 0) then + if (not process_restart(cinfo)) then + begin + decode_mcu_DC_refine := FALSE; + exit; + end; + end; + + { Not worth the cycles to check insufficient_data here, + since we will not change the data anyway if we read zeroes. } + + { Load up working state } + {BITREAD_LOAD_STATE(cinfo,entropy^.bitstate);} + br_state.cinfo := cinfo; + br_state.next_input_byte := cinfo^.src^.next_input_byte; + br_state.bytes_in_buffer := cinfo^.src^.bytes_in_buffer; + get_buffer := entropy^.bitstate.get_buffer; + bits_left := entropy^.bitstate.bits_left; + + { Outer loop handles each block in the MCU } + + for blkn := 0 to pred(cinfo^.blocks_in_MCU) do + begin + block := JBLOCK_PTR(MCU_data[blkn]); + + { Encoded data is simply the next bit of the two's-complement DC value } + {CHECK_BIT_BUFFER(br_state, 1, return FALSE);} + if (bits_left < 1) then + begin + if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,1)) then + begin + decode_mcu_DC_refine := FALSE; + exit; + end; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + end; + + {if (GET_BITS(1)) then} + Dec(bits_left); + if (int(get_buffer shr bits_left)) and ( pred(1 shl 1) ) <> 0 then + block^[0] := block^[0] or p1; + { Note: since we use OR, repeating the assignment later is safe } + end; + + { Completed MCU, so update state } + {BITREAD_SAVE_STATE(cinfo,entropy^.bitstate);} + cinfo^.src^.next_input_byte := br_state.next_input_byte; + cinfo^.src^.bytes_in_buffer := br_state.bytes_in_buffer; + entropy^.bitstate.get_buffer := get_buffer; + entropy^.bitstate.bits_left := bits_left; + + { Account for restart interval (no-op if not using restarts) } + Dec(entropy^.restarts_to_go); + + decode_mcu_DC_refine := TRUE; +end; + + +{ MCU decoding for AC successive approximation refinement scan. } + +{METHODDEF} +function decode_mcu_AC_refine (cinfo : j_decompress_ptr; + var MCU_data : array of JBLOCKROW) : boolean; +label + undoit, label3; +var + entropy : phuff_entropy_ptr; + Se : int; + p1 : int; { 1 in the bit position being coded } + m1 : int; { -1 in the bit position being coded } + {register} s, k, r : int; + EOBRUN : uInt; + block : JBLOCK_PTR; + thiscoef : JCOEF_PTR; + {BITREAD_STATE_VARS;} + get_buffer : bit_buf_type ; {register} + bits_left : int; {register} + br_state : bitread_working_state; + + tbl : d_derived_tbl_ptr; + num_newnz : int; + newnz_pos : array[0..DCTSIZE2-1] of int; +var + pos : int; +var + nb, look : int; {register} +begin + num_newnz := 0; + block := nil; + + entropy := phuff_entropy_ptr (cinfo^.entropy); + Se := cinfo^.Se; + p1 := 1 shl cinfo^.Al; { 1 in the bit position being coded } + m1 := (-1) shl cinfo^.Al; { -1 in the bit position being coded } + + { Process restart marker if needed; may have to suspend } + if (cinfo^.restart_interval <> 0) then + begin + if (entropy^.restarts_to_go = 0) then + if (not process_restart(cinfo)) then + begin + decode_mcu_AC_refine := FALSE; + exit; + end; + end; + + { If we've run out of data, don't modify the MCU. } + if not entropy^.pub.insufficient_data then + begin + + { Load up working state } + {BITREAD_LOAD_STATE(cinfo,entropy^.bitstate);} + br_state.cinfo := cinfo; + br_state.next_input_byte := cinfo^.src^.next_input_byte; + br_state.bytes_in_buffer := cinfo^.src^.bytes_in_buffer; + get_buffer := entropy^.bitstate.get_buffer; + bits_left := entropy^.bitstate.bits_left; + + EOBRUN := entropy^.saved.EOBRUN; { only part of saved state we care about } + + { There is always only one block per MCU } + block := JBLOCK_PTR(MCU_data[0]); + tbl := entropy^.ac_derived_tbl; + + { If we are forced to suspend, we must undo the assignments to any newly + nonzero coefficients in the block, because otherwise we'd get confused + next time about which coefficients were already nonzero. + But we need not undo addition of bits to already-nonzero coefficients; + instead, we can test the current bit position to see if we already did it.} + + num_newnz := 0; + + { initialize coefficient loop counter to start of band } + k := cinfo^.Ss; + + if (EOBRUN = 0) then + begin + while (k <= Se) do + begin + {HUFF_DECODE(s, br_state, tbl, goto undoit, label3);} + if (bits_left < HUFF_LOOKAHEAD) then + begin + if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then + goto undoit; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + if (bits_left < HUFF_LOOKAHEAD) then + begin + nb := 1; + goto label3; + end; + end; + {look := PEEK_BITS(HUFF_LOOKAHEAD);} + look := int(get_buffer shr (bits_left - HUFF_LOOKAHEAD)) and + pred(1 shl HUFF_LOOKAHEAD); + + nb := tbl^.look_nbits[look]; + if (nb <> 0) then + begin + {DROP_BITS(nb);} + Dec(bits_left, nb); + + s := tbl^.look_sym[look]; + end + else + begin + nb := HUFF_LOOKAHEAD+1; + label3: + s := jpeg_huff_decode(br_state,get_buffer,bits_left,tbl,nb); + if (s < 0) then + goto undoit; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + end; + + r := s shr 4; + s := s and 15; + if (s <> 0) then + begin + if (s <> 1) then { size of new coef should always be 1 } + WARNMS(j_common_ptr(cinfo), JWRN_HUFF_BAD_CODE); + {CHECK_BIT_BUFFER(br_state, 1, goto undoit);} + if (bits_left < 1) then + begin + if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,1)) then + goto undoit; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + end; + + {if (GET_BITS(1)) then} + Dec(bits_left); + if (int(get_buffer shr bits_left)) and ( pred(1 shl 1) )<>0 then + s := p1 { newly nonzero coef is positive } + else + s := m1; { newly nonzero coef is negative } + end + else + begin + if (r <> 15) then + begin + EOBRUN := 1 shl r; { EOBr, run length is 2^r + appended bits } + if (r <> 0) then + begin + {CHECK_BIT_BUFFER(br_state, r, goto undoit);} + if (bits_left < r) then + begin + if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,r)) then + goto undoit; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + end; + + {r := GET_BITS(r);} + Dec(bits_left, r); + r := (int(get_buffer shr bits_left)) and ( pred(1 shl r) ); + + Inc(EOBRUN, r); + end; + break; { rest of block is handled by EOB logic } + end; + { note s := 0 for processing ZRL } + end; + { Advance over already-nonzero coefs and r still-zero coefs, + appending correction bits to the nonzeroes. A correction bit is 1 + if the absolute value of the coefficient must be increased. } + + repeat + thiscoef :=@(block^[jpeg_natural_order[k]]); + if (thiscoef^ <> 0) then + begin + {CHECK_BIT_BUFFER(br_state, 1, goto undoit);} + if (bits_left < 1) then + begin + if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,1)) then + goto undoit; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + end; + + {if (GET_BITS(1)) then} + Dec(bits_left); + if (int(get_buffer shr bits_left)) and ( pred(1 shl 1) )<>0 then + begin + if ((thiscoef^ and p1) = 0) then + begin { do nothing if already set it } + if (thiscoef^ >= 0) then + Inc(thiscoef^, p1) + else + Inc(thiscoef^, m1); + end; + end; + end + else + begin + Dec(r); + if (r < 0) then + break; { reached target zero coefficient } + end; + Inc(k); + until (k > Se); + if (s <> 0) then + begin + pos := jpeg_natural_order[k]; + { Output newly nonzero coefficient } + block^[pos] := JCOEF (s); + { Remember its position in case we have to suspend } + newnz_pos[num_newnz] := pos; + Inc(num_newnz); + end; + Inc(k); + end; + end; + + if (EOBRUN > 0) then + begin + { Scan any remaining coefficient positions after the end-of-band + (the last newly nonzero coefficient, if any). Append a correction + bit to each already-nonzero coefficient. A correction bit is 1 + if the absolute value of the coefficient must be increased. } + + while (k <= Se) do + begin + thiscoef := @(block^[jpeg_natural_order[k]]); + if (thiscoef^ <> 0) then + begin + {CHECK_BIT_BUFFER(br_state, 1, goto undoit);} + if (bits_left < 1) then + begin + if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,1)) then + goto undoit; + get_buffer := br_state.get_buffer; + bits_left := br_state.bits_left; + end; + + {if (GET_BITS(1)) then} + Dec(bits_left); + if (int(get_buffer shr bits_left)) and ( pred(1 shl 1) )<>0 then + begin + if ((thiscoef^ and p1) = 0) then + begin { do nothing if already changed it } + if (thiscoef^ >= 0) then + Inc(thiscoef^, p1) + else + Inc(thiscoef^, m1); + end; + end; + end; + Inc(k); + end; + { Count one block completed in EOB run } + Dec(EOBRUN); + end; + + { Completed MCU, so update state } + {BITREAD_SAVE_STATE(cinfo,entropy^.bitstate);} + cinfo^.src^.next_input_byte := br_state.next_input_byte; + cinfo^.src^.bytes_in_buffer := br_state.bytes_in_buffer; + entropy^.bitstate.get_buffer := get_buffer; + entropy^.bitstate.bits_left := bits_left; + + entropy^.saved.EOBRUN := EOBRUN; { only part of saved state we care about } + end; + + { Account for restart interval (no-op if not using restarts) } + Dec(entropy^.restarts_to_go); + + decode_mcu_AC_refine := TRUE; + exit; + +undoit: + { Re-zero any output coefficients that we made newly nonzero } + while (num_newnz > 0) do + begin + Dec(num_newnz); + block^[newnz_pos[num_newnz]] := 0; + end; + + decode_mcu_AC_refine := FALSE; +end; + + +{ Module initialization routine for progressive Huffman entropy decoding. } + +{GLOBAL} +procedure jinit_phuff_decoder (cinfo : j_decompress_ptr); +var + entropy : phuff_entropy_ptr; + coef_bit_ptr : int_ptr; + ci, i : int; +begin + entropy := phuff_entropy_ptr( + cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE, + SIZEOF(phuff_entropy_decoder)) ); + cinfo^.entropy := jpeg_entropy_decoder_ptr (entropy); + entropy^.pub.start_pass := start_pass_phuff_decoder; + + { Mark derived tables unallocated } + for i := 0 to pred(NUM_HUFF_TBLS) do + begin + entropy^.derived_tbls[i] := NIL; + end; + + { Create progression status table } + cinfo^.coef_bits := coef_bits_ptrrow ( + cinfo^.mem^.alloc_small ( j_common_ptr (cinfo), JPOOL_IMAGE, + cinfo^.num_components*DCTSIZE2*SIZEOF(int)) ); + coef_bit_ptr := @cinfo^.coef_bits^[0][0]; + for ci := 0 to pred(cinfo^.num_components) do + for i := 0 to pred(DCTSIZE2) do + begin + coef_bit_ptr^ := -1; + Inc(coef_bit_ptr); + end; +end; + +end. diff --git a/Imaging/JpegLib/imjdpostct.pas b/Imaging/JpegLib/imjdpostct.pas index 3be825a..f3078c3 100644 --- a/Imaging/JpegLib/imjdpostct.pas +++ b/Imaging/JpegLib/imjdpostct.pas @@ -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. diff --git a/Imaging/JpegLib/imjdsample.pas b/Imaging/JpegLib/imjdsample.pas index c980468..ed2488c 100644 --- a/Imaging/JpegLib/imjdsample.pas +++ b/Imaging/JpegLib/imjdsample.pas @@ -1,592 +1,592 @@ -unit imjdsample; - -{ Original: jdsample.c; Copyright (C) 1991-1996, Thomas G. Lane. } - -{ This file contains upsampling routines. - - Upsampling input data is counted in "row groups". A row group - is defined to be (v_samp_factor * DCT_scaled_size / min_DCT_scaled_size) - sample rows of each component. Upsampling will normally produce - max_v_samp_factor pixel rows from each row group (but this could vary - if the upsampler is applying a scale factor of its own). - - An excellent reference for image resampling is - Digital Image Warping, George Wolberg, 1990. - Pub. by IEEE Computer Society Press, Los Alamitos, CA. ISBN 0-8186-8944-7.} - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjutils, - imjpeglib, - imjdeferr, - imjerror; - - -{ Pointer to routine to upsample a single component } -type - upsample1_ptr = procedure (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - var output_data_ptr : JSAMPARRAY); - -{ Module initialization routine for upsampling. } - -{GLOBAL} -procedure jinit_upsampler (cinfo : j_decompress_ptr); - -implementation - -{ Private subobject } - -type - my_upsample_ptr = ^my_upsampler; - my_upsampler = record - pub : jpeg_upsampler; { public fields } - - { Color conversion buffer. When using separate upsampling and color - conversion steps, this buffer holds one upsampled row group until it - has been color converted and output. - Note: we do not allocate any storage for component(s) which are full-size, - ie do not need rescaling. The corresponding entry of color_buf[] is - simply set to point to the input data array, thereby avoiding copying.} - - color_buf : array[0..MAX_COMPONENTS-1] of JSAMPARRAY; - - { Per-component upsampling method pointers } - methods : array[0..MAX_COMPONENTS-1] of upsample1_ptr; - - next_row_out : int; { counts rows emitted from color_buf } - rows_to_go : JDIMENSION; { counts rows remaining in image } - - { Height of an input row group for each component. } - rowgroup_height : array[0..MAX_COMPONENTS-1] of int; - - { These arrays save pixel expansion factors so that int_expand need not - recompute them each time. They are unused for other upsampling methods.} - h_expand : array[0..MAX_COMPONENTS-1] of UINT8 ; - v_expand : array[0..MAX_COMPONENTS-1] of UINT8 ; - end; - - -{ Initialize for an upsampling pass. } - -{METHODDEF} -procedure start_pass_upsample (cinfo : j_decompress_ptr); -var - upsample : my_upsample_ptr; -begin - upsample := my_upsample_ptr (cinfo^.upsample); - - { Mark the conversion buffer empty } - upsample^.next_row_out := cinfo^.max_v_samp_factor; - { Initialize total-height counter for detecting bottom of image } - upsample^.rows_to_go := cinfo^.output_height; -end; - - -{ Control routine to do upsampling (and color conversion). - - In this version we upsample each component independently. - We upsample one row group into the conversion buffer, then apply - color conversion a row at a time. } - -{METHODDEF} -procedure sep_upsample (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 - upsample : my_upsample_ptr; - ci : int; - compptr : jpeg_component_info_ptr; - num_rows : JDIMENSION; -begin - upsample := my_upsample_ptr (cinfo^.upsample); - - { Fill the conversion buffer, if it's empty } - if (upsample^.next_row_out >= cinfo^.max_v_samp_factor) then - begin - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - { Invoke per-component upsample method. Notice we pass a POINTER - to color_buf[ci], so that fullsize_upsample can change it. } - - upsample^.methods[ci] (cinfo, compptr, - JSAMPARRAY(@ input_buf^[ci]^ - [LongInt(in_row_group_ctr) * upsample^.rowgroup_height[ci]]), - upsample^.color_buf[ci]); - - Inc(compptr); - end; - upsample^.next_row_out := 0; - end; - - { Color-convert and emit rows } - - { How many we have in the buffer: } - num_rows := JDIMENSION (cinfo^.max_v_samp_factor - upsample^.next_row_out); - { Not more than the distance to the end of the image. Need this test - in case the image height is not a multiple of max_v_samp_factor: } - - if (num_rows > upsample^.rows_to_go) then - num_rows := upsample^.rows_to_go; - { And not more than what the client can accept: } - Dec(out_rows_avail, out_row_ctr); - if (num_rows > out_rows_avail) then - num_rows := out_rows_avail; - - cinfo^.cconvert^.color_convert (cinfo, - JSAMPIMAGE(@(upsample^.color_buf)), - JDIMENSION (upsample^.next_row_out), - JSAMPARRAY(@(output_buf^[out_row_ctr])), - int (num_rows)); - - { Adjust counts } - Inc(out_row_ctr, num_rows); - Dec(upsample^.rows_to_go, num_rows); - Inc(upsample^.next_row_out, num_rows); - { When the buffer is emptied, declare this input row group consumed } - if (upsample^.next_row_out >= cinfo^.max_v_samp_factor) then - Inc(in_row_group_ctr); -end; - - -{ These are the routines invoked by sep_upsample to upsample pixel values - of a single component. One row group is processed per call. } - - -{ For full-size components, we just make color_buf[ci] point at the - input buffer, and thus avoid copying any data. Note that this is - safe only because sep_upsample doesn't declare the input row group - "consumed" until we are done color converting and emitting it. } - -{METHODDEF} -procedure fullsize_upsample (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - var output_data_ptr : JSAMPARRAY); -begin - output_data_ptr := input_data; -end; - - -{ This is a no-op version used for "uninteresting" components. - These components will not be referenced by color conversion. } - -{METHODDEF} -procedure noop_upsample (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - var output_data_ptr : JSAMPARRAY); -begin - output_data_ptr := NIL; { safety check } -end; - - -{ This version handles any integral sampling ratios. - This is not used for typical JPEG files, so it need not be fast. - Nor, for that matter, is it particularly accurate: the algorithm is - simple replication of the input pixel onto the corresponding output - pixels. The hi-falutin sampling literature refers to this as a - "box filter". A box filter tends to introduce visible artifacts, - so if you are actually going to use 3:1 or 4:1 sampling ratios - you would be well advised to improve this code. } - -{METHODDEF} -procedure int_upsample (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - var output_data_ptr : JSAMPARRAY); -var - upsample : my_upsample_ptr; - output_data : JSAMPARRAY; - {register} inptr, outptr : JSAMPLE_PTR; - {register} invalue : JSAMPLE; - {register} h : int; - {outend} - h_expand, v_expand : int; - inrow, outrow : int; -var - outcount : int; { Nomssi: avoid pointer arithmetic } -begin - upsample := my_upsample_ptr (cinfo^.upsample); - output_data := output_data_ptr; - - h_expand := upsample^.h_expand[compptr^.component_index]; - v_expand := upsample^.v_expand[compptr^.component_index]; - - inrow := 0; - outrow := 0; - while (outrow < cinfo^.max_v_samp_factor) do - begin - { Generate one output row with proper horizontal expansion } - inptr := JSAMPLE_PTR(input_data^[inrow]); - outptr := JSAMPLE_PTR(output_data^[outrow]); - outcount := cinfo^.output_width; - while (outcount > 0) do { Nomssi } - begin - invalue := inptr^; { don't need GETJSAMPLE() here } - Inc(inptr); - for h := pred(h_expand) downto 0 do - begin - outptr^ := invalue; - inc(outptr); { <-- fix: this was left out in PasJpeg 1.0 } - Dec(outcount); { thanks to Jannie Gerber for the report } - end; - end; - - { Generate any additional output rows by duplicating the first one } - if (v_expand > 1) then - begin - jcopy_sample_rows(output_data, outrow, output_data, outrow+1, - v_expand-1, cinfo^.output_width); - end; - Inc(inrow); - Inc(outrow, v_expand); - end; -end; - - -{ Fast processing for the common case of 2:1 horizontal and 1:1 vertical. - It's still a box filter. } - -{METHODDEF} -procedure h2v1_upsample (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - var output_data_ptr : JSAMPARRAY); -var - output_data : JSAMPARRAY; - {register} inptr, outptr : JSAMPLE_PTR; - {register} invalue : JSAMPLE; - {outend : JSAMPROW;} - outcount : int; - inrow : int; -begin - output_data := output_data_ptr; - - for inrow := 0 to pred(cinfo^.max_v_samp_factor) do - begin - inptr := JSAMPLE_PTR(input_data^[inrow]); - outptr := JSAMPLE_PTR(output_data^[inrow]); - {outend := outptr + cinfo^.output_width;} - outcount := cinfo^.output_width; - while (outcount > 0) do - begin - invalue := inptr^; { don't need GETJSAMPLE() here } - Inc(inptr); - outptr^ := invalue; - Inc(outptr); - outptr^ := invalue; - Inc(outptr); - Dec(outcount, 2); { Nomssi: to avoid pointer arithmetic } - end; - end; -end; - - -{ Fast processing for the common case of 2:1 horizontal and 2:1 vertical. - It's still a box filter. } - -{METHODDEF} -procedure h2v2_upsample (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - var output_data_ptr : JSAMPARRAY); -var - output_data : JSAMPARRAY; - {register} inptr, outptr : JSAMPLE_PTR; - {register} invalue : JSAMPLE; - {outend : JSAMPROW;} - outcount : int; - inrow, outrow : int; -begin - output_data := output_data_ptr; - - inrow := 0; - outrow := 0; - while (outrow < cinfo^.max_v_samp_factor) do - begin - inptr := JSAMPLE_PTR(input_data^[inrow]); - outptr := JSAMPLE_PTR(output_data^[outrow]); - {outend := outptr + cinfo^.output_width;} - outcount := cinfo^.output_width; - while (outcount > 0) do - begin - invalue := inptr^; { don't need GETJSAMPLE() here } - Inc(inptr); - outptr^ := invalue; - Inc(outptr); - outptr^ := invalue; - Inc(outptr); - Dec(outcount, 2); - end; - jcopy_sample_rows(output_data, outrow, output_data, outrow+1, - 1, cinfo^.output_width); - Inc(inrow); - Inc(outrow, 2); - end; -end; - - -{ Fancy processing for the common case of 2:1 horizontal and 1:1 vertical. - - The upsampling algorithm is linear interpolation between pixel centers, - also known as a "triangle filter". This is a good compromise between - speed and visual quality. The centers of the output pixels are 1/4 and 3/4 - of the way between input pixel centers. - - A note about the "bias" calculations: when rounding fractional values to - integer, we do not want to always round 0.5 up to the next integer. - If we did that, we'd introduce a noticeable bias towards larger values. - Instead, this code is arranged so that 0.5 will be rounded up or down at - alternate pixel locations (a simple ordered dither pattern). } - -{METHODDEF} -procedure h2v1_fancy_upsample (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - var output_data_ptr : JSAMPARRAY); -var - output_data : JSAMPARRAY; - {register} pre_inptr, inptr, outptr : JSAMPLE_PTR; - {register} invalue : int; - {register} colctr : JDIMENSION; - inrow : int; -begin - output_data := output_data_ptr; - - for inrow := 0 to pred(cinfo^.max_v_samp_factor) do - begin - inptr := JSAMPLE_PTR(input_data^[inrow]); - outptr := JSAMPLE_PTR(output_data^[inrow]); - { Special case for first column } - pre_inptr := inptr; - invalue := GETJSAMPLE(inptr^); - Inc(inptr); - outptr^ := JSAMPLE (invalue); - Inc(outptr); - outptr^ := JSAMPLE ((invalue * 3 + GETJSAMPLE(inptr^) + 2) shr 2); - Inc(outptr); - - for colctr := pred(compptr^.downsampled_width - 2) downto 0 do - begin - { General case: 3/4 * nearer pixel + 1/4 * further pixel } - invalue := GETJSAMPLE(inptr^) * 3; - Inc(inptr); - outptr^ := JSAMPLE ((invalue + GETJSAMPLE(pre_inptr^) + 1) shr 2); - Inc(pre_inptr); - Inc(outptr); - outptr^ := JSAMPLE ((invalue + GETJSAMPLE(inptr^) + 2) shr 2); - Inc(outptr); - end; - - { Special case for last column } - invalue := GETJSAMPLE(inptr^); - outptr^ := JSAMPLE ((invalue * 3 + GETJSAMPLE(pre_inptr^) + 1) shr 2); - Inc(outptr); - outptr^ := JSAMPLE (invalue); - {Inc(outptr); - value never used } - end; -end; - - -{ Fancy processing for the common case of 2:1 horizontal and 2:1 vertical. - Again a triangle filter; see comments for h2v1 case, above. - - It is OK for us to reference the adjacent input rows because we demanded - context from the main buffer controller (see initialization code). } - -{METHODDEF} -procedure h2v2_fancy_upsample (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - var output_data_ptr : JSAMPARRAY); -var - output_data : JSAMPARRAY; - {register} inptr0, inptr1, outptr : JSAMPLE_PTR; -{$ifdef BITS_IN_JSAMPLE_IS_8} - {register} thiscolsum, lastcolsum, nextcolsum : int; -{$else} - {register} thiscolsum, lastcolsum, nextcolsum : INT32; -{$endif} - {register} colctr : JDIMENSION; - inrow, outrow, v : int; -var - prev_input_data : JSAMPARRAY; { Nomssi work around } -begin - output_data := output_data_ptr; - - outrow := 0; - inrow := 0; - while (outrow < cinfo^.max_v_samp_factor) do - begin - for v := 0 to pred(2) do - begin - { inptr0 points to nearest input row, inptr1 points to next nearest } - inptr0 := JSAMPLE_PTR(input_data^[inrow]); - if (v = 0) then { next nearest is row above } - begin - {inptr1 := JSAMPLE_PTR(input_data^[inrow-1]);} - prev_input_data := input_data; { work around } - Dec(JSAMPROW_PTR(prev_input_data)); { negative offsets } - inptr1 := JSAMPLE_PTR(prev_input_data^[inrow]); - end - else { next nearest is row below } - inptr1 := JSAMPLE_PTR(input_data^[inrow+1]); - outptr := JSAMPLE_PTR(output_data^[outrow]); - Inc(outrow); - - { Special case for first column } - thiscolsum := GETJSAMPLE(inptr0^) * 3 + GETJSAMPLE(inptr1^); - Inc(inptr0); - Inc(inptr1); - nextcolsum := GETJSAMPLE(inptr0^) * 3 + GETJSAMPLE(inptr1^); - Inc(inptr0); - Inc(inptr1); - - outptr^ := JSAMPLE ((thiscolsum * 4 + 8) shr 4); - Inc(outptr); - outptr^ := JSAMPLE ((thiscolsum * 3 + nextcolsum + 7) shr 4); - Inc(outptr); - lastcolsum := thiscolsum; thiscolsum := nextcolsum; - - for colctr := pred(compptr^.downsampled_width - 2) downto 0 do - begin - { General case: 3/4 * nearer pixel + 1/4 * further pixel in each } - { dimension, thus 9/16, 3/16, 3/16, 1/16 overall } - nextcolsum := GETJSAMPLE(inptr0^) * 3 + GETJSAMPLE(inptr1^); - Inc(inptr0); - Inc(inptr1); - outptr^ := JSAMPLE ((thiscolsum * 3 + lastcolsum + 8) shr 4); - Inc(outptr); - outptr^ := JSAMPLE ((thiscolsum * 3 + nextcolsum + 7) shr 4); - Inc(outptr); - lastcolsum := thiscolsum; - thiscolsum := nextcolsum; - end; - - { Special case for last column } - outptr^ := JSAMPLE ((thiscolsum * 3 + lastcolsum + 8) shr 4); - Inc(outptr); - outptr^ := JSAMPLE ((thiscolsum * 4 + 7) shr 4); - {Inc(outptr); - value never used } - end; - Inc(inrow); - end; -end; - - -{ Module initialization routine for upsampling. } - -{GLOBAL} -procedure jinit_upsampler (cinfo : j_decompress_ptr); -var - upsample : my_upsample_ptr; - ci : int; - compptr : jpeg_component_info_ptr; - need_buffer, do_fancy : boolean; - h_in_group, v_in_group, h_out_group, v_out_group : int; -begin - upsample := my_upsample_ptr ( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_upsampler)) ); - cinfo^.upsample := jpeg_upsampler_ptr (upsample); - upsample^.pub.start_pass := start_pass_upsample; - upsample^.pub.upsample := sep_upsample; - upsample^.pub.need_context_rows := FALSE; { until we find out differently } - - if (cinfo^.CCIR601_sampling) then { this isn't supported } - ERREXIT(j_common_ptr(cinfo), JERR_CCIR601_NOTIMPL); - - { jdmainct.c doesn't support context rows when min_DCT_scaled_size := 1, - so don't ask for it. } - - do_fancy := cinfo^.do_fancy_upsampling and (cinfo^.min_DCT_scaled_size > 1); - - { Verify we can handle the sampling factors, select per-component methods, - and create storage as needed. } - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - { Compute size of an "input group" after IDCT scaling. This many samples - are to be converted to max_h_samp_factor * max_v_samp_factor pixels. } - - h_in_group := (compptr^.h_samp_factor * compptr^.DCT_scaled_size) div - cinfo^.min_DCT_scaled_size; - v_in_group := (compptr^.v_samp_factor * compptr^.DCT_scaled_size) div - cinfo^.min_DCT_scaled_size; - h_out_group := cinfo^.max_h_samp_factor; - v_out_group := cinfo^.max_v_samp_factor; - upsample^.rowgroup_height[ci] := v_in_group; { save for use later } - need_buffer := TRUE; - if (not compptr^.component_needed) then - begin - { Don't bother to upsample an uninteresting component. } - upsample^.methods[ci] := noop_upsample; - need_buffer := FALSE; - end - else - if (h_in_group = h_out_group) and (v_in_group = v_out_group) then - begin - { Fullsize components can be processed without any work. } - upsample^.methods[ci] := fullsize_upsample; - need_buffer := FALSE; - end - else - if (h_in_group * 2 = h_out_group) and - (v_in_group = v_out_group) then - begin - { Special cases for 2h1v upsampling } - if (do_fancy) and (compptr^.downsampled_width > 2) then - upsample^.methods[ci] := h2v1_fancy_upsample - else - upsample^.methods[ci] := h2v1_upsample; - end - else - if (h_in_group * 2 = h_out_group) and - (v_in_group * 2 = v_out_group) then - begin - { Special cases for 2h2v upsampling } - if (do_fancy) and (compptr^.downsampled_width > 2) then - begin - upsample^.methods[ci] := h2v2_fancy_upsample; - upsample^.pub.need_context_rows := TRUE; - end - else - upsample^.methods[ci] := h2v2_upsample; - end - else - if ((h_out_group mod h_in_group) = 0) and - ((v_out_group mod v_in_group) = 0) then - begin - { Generic integral-factors upsampling method } - upsample^.methods[ci] := int_upsample; - upsample^.h_expand[ci] := UINT8 (h_out_group div h_in_group); - upsample^.v_expand[ci] := UINT8 (v_out_group div v_in_group); - end - else - ERREXIT(j_common_ptr(cinfo), JERR_FRACT_SAMPLE_NOTIMPL); - if (need_buffer) then - begin - upsample^.color_buf[ci] := cinfo^.mem^.alloc_sarray - (j_common_ptr(cinfo), JPOOL_IMAGE, - JDIMENSION (jround_up( long (cinfo^.output_width), - long (cinfo^.max_h_samp_factor))), - JDIMENSION (cinfo^.max_v_samp_factor)); - end; - Inc(compptr); - end; -end; - -end. +unit imjdsample; + +{ Original: jdsample.c; Copyright (C) 1991-1996, Thomas G. Lane. } + +{ This file contains upsampling routines. + + Upsampling input data is counted in "row groups". A row group + is defined to be (v_samp_factor * DCT_scaled_size / min_DCT_scaled_size) + sample rows of each component. Upsampling will normally produce + max_v_samp_factor pixel rows from each row group (but this could vary + if the upsampler is applying a scale factor of its own). + + An excellent reference for image resampling is + Digital Image Warping, George Wolberg, 1990. + Pub. by IEEE Computer Society Press, Los Alamitos, CA. ISBN 0-8186-8944-7.} + +interface + +{$I imjconfig.inc} + +uses + imjmorecfg, + imjinclude, + imjutils, + imjpeglib, + imjdeferr, + imjerror; + + +{ Pointer to routine to upsample a single component } +type + upsample1_ptr = procedure (cinfo : j_decompress_ptr; + compptr : jpeg_component_info_ptr; + input_data : JSAMPARRAY; + var output_data_ptr : JSAMPARRAY); + +{ Module initialization routine for upsampling. } + +{GLOBAL} +procedure jinit_upsampler (cinfo : j_decompress_ptr); + +implementation + +{ Private subobject } + +type + my_upsample_ptr = ^my_upsampler; + my_upsampler = record + pub : jpeg_upsampler; { public fields } + + { Color conversion buffer. When using separate upsampling and color + conversion steps, this buffer holds one upsampled row group until it + has been color converted and output. + Note: we do not allocate any storage for component(s) which are full-size, + ie do not need rescaling. The corresponding entry of color_buf[] is + simply set to point to the input data array, thereby avoiding copying.} + + color_buf : array[0..MAX_COMPONENTS-1] of JSAMPARRAY; + + { Per-component upsampling method pointers } + methods : array[0..MAX_COMPONENTS-1] of upsample1_ptr; + + next_row_out : int; { counts rows emitted from color_buf } + rows_to_go : JDIMENSION; { counts rows remaining in image } + + { Height of an input row group for each component. } + rowgroup_height : array[0..MAX_COMPONENTS-1] of int; + + { These arrays save pixel expansion factors so that int_expand need not + recompute them each time. They are unused for other upsampling methods.} + h_expand : array[0..MAX_COMPONENTS-1] of UINT8 ; + v_expand : array[0..MAX_COMPONENTS-1] of UINT8 ; + end; + + +{ Initialize for an upsampling pass. } + +{METHODDEF} +procedure start_pass_upsample (cinfo : j_decompress_ptr); +var + upsample : my_upsample_ptr; +begin + upsample := my_upsample_ptr (cinfo^.upsample); + + { Mark the conversion buffer empty } + upsample^.next_row_out := cinfo^.max_v_samp_factor; + { Initialize total-height counter for detecting bottom of image } + upsample^.rows_to_go := cinfo^.output_height; +end; + + +{ Control routine to do upsampling (and color conversion). + + In this version we upsample each component independently. + We upsample one row group into the conversion buffer, then apply + color conversion a row at a time. } + +{METHODDEF} +procedure sep_upsample (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 + upsample : my_upsample_ptr; + ci : int; + compptr : jpeg_component_info_ptr; + num_rows : JDIMENSION; +begin + upsample := my_upsample_ptr (cinfo^.upsample); + + { Fill the conversion buffer, if it's empty } + if (upsample^.next_row_out >= cinfo^.max_v_samp_factor) then + begin + compptr := jpeg_component_info_ptr(cinfo^.comp_info); + for ci := 0 to pred(cinfo^.num_components) do + begin + { Invoke per-component upsample method. Notice we pass a POINTER + to color_buf[ci], so that fullsize_upsample can change it. } + + upsample^.methods[ci] (cinfo, compptr, + JSAMPARRAY(@ input_buf^[ci]^ + [LongInt(in_row_group_ctr) * upsample^.rowgroup_height[ci]]), + upsample^.color_buf[ci]); + + Inc(compptr); + end; + upsample^.next_row_out := 0; + end; + + { Color-convert and emit rows } + + { How many we have in the buffer: } + num_rows := JDIMENSION (cinfo^.max_v_samp_factor - upsample^.next_row_out); + { Not more than the distance to the end of the image. Need this test + in case the image height is not a multiple of max_v_samp_factor: } + + if (num_rows > upsample^.rows_to_go) then + num_rows := upsample^.rows_to_go; + { And not more than what the client can accept: } + Dec(out_rows_avail, out_row_ctr); + if (num_rows > out_rows_avail) then + num_rows := out_rows_avail; + + cinfo^.cconvert^.color_convert (cinfo, + JSAMPIMAGE(@(upsample^.color_buf)), + JDIMENSION (upsample^.next_row_out), + JSAMPARRAY(@(output_buf^[out_row_ctr])), + int (num_rows)); + + { Adjust counts } + Inc(out_row_ctr, num_rows); + Dec(upsample^.rows_to_go, num_rows); + Inc(upsample^.next_row_out, num_rows); + { When the buffer is emptied, declare this input row group consumed } + if (upsample^.next_row_out >= cinfo^.max_v_samp_factor) then + Inc(in_row_group_ctr); +end; + + +{ These are the routines invoked by sep_upsample to upsample pixel values + of a single component. One row group is processed per call. } + + +{ For full-size components, we just make color_buf[ci] point at the + input buffer, and thus avoid copying any data. Note that this is + safe only because sep_upsample doesn't declare the input row group + "consumed" until we are done color converting and emitting it. } + +{METHODDEF} +procedure fullsize_upsample (cinfo : j_decompress_ptr; + compptr : jpeg_component_info_ptr; + input_data : JSAMPARRAY; + var output_data_ptr : JSAMPARRAY); +begin + output_data_ptr := input_data; +end; + + +{ This is a no-op version used for "uninteresting" components. + These components will not be referenced by color conversion. } + +{METHODDEF} +procedure noop_upsample (cinfo : j_decompress_ptr; + compptr : jpeg_component_info_ptr; + input_data : JSAMPARRAY; + var output_data_ptr : JSAMPARRAY); +begin + output_data_ptr := NIL; { safety check } +end; + + +{ This version handles any integral sampling ratios. + This is not used for typical JPEG files, so it need not be fast. + Nor, for that matter, is it particularly accurate: the algorithm is + simple replication of the input pixel onto the corresponding output + pixels. The hi-falutin sampling literature refers to this as a + "box filter". A box filter tends to introduce visible artifacts, + so if you are actually going to use 3:1 or 4:1 sampling ratios + you would be well advised to improve this code. } + +{METHODDEF} +procedure int_upsample (cinfo : j_decompress_ptr; + compptr : jpeg_component_info_ptr; + input_data : JSAMPARRAY; + var output_data_ptr : JSAMPARRAY); +var + upsample : my_upsample_ptr; + output_data : JSAMPARRAY; + {register} inptr, outptr : JSAMPLE_PTR; + {register} invalue : JSAMPLE; + {register} h : int; + {outend} + h_expand, v_expand : int; + inrow, outrow : int; +var + outcount : int; { Nomssi: avoid pointer arithmetic } +begin + upsample := my_upsample_ptr (cinfo^.upsample); + output_data := output_data_ptr; + + h_expand := upsample^.h_expand[compptr^.component_index]; + v_expand := upsample^.v_expand[compptr^.component_index]; + + inrow := 0; + outrow := 0; + while (outrow < cinfo^.max_v_samp_factor) do + begin + { Generate one output row with proper horizontal expansion } + inptr := JSAMPLE_PTR(input_data^[inrow]); + outptr := JSAMPLE_PTR(output_data^[outrow]); + outcount := cinfo^.output_width; + while (outcount > 0) do { Nomssi } + begin + invalue := inptr^; { don't need GETJSAMPLE() here } + Inc(inptr); + for h := pred(h_expand) downto 0 do + begin + outptr^ := invalue; + inc(outptr); { <-- fix: this was left out in PasJpeg 1.0 } + Dec(outcount); { thanks to Jannie Gerber for the report } + end; + end; + + { Generate any additional output rows by duplicating the first one } + if (v_expand > 1) then + begin + jcopy_sample_rows(output_data, outrow, output_data, outrow+1, + v_expand-1, cinfo^.output_width); + end; + Inc(inrow); + Inc(outrow, v_expand); + end; +end; + + +{ Fast processing for the common case of 2:1 horizontal and 1:1 vertical. + It's still a box filter. } + +{METHODDEF} +procedure h2v1_upsample (cinfo : j_decompress_ptr; + compptr : jpeg_component_info_ptr; + input_data : JSAMPARRAY; + var output_data_ptr : JSAMPARRAY); +var + output_data : JSAMPARRAY; + {register} inptr, outptr : JSAMPLE_PTR; + {register} invalue : JSAMPLE; + {outend : JSAMPROW;} + outcount : int; + inrow : int; +begin + output_data := output_data_ptr; + + for inrow := 0 to pred(cinfo^.max_v_samp_factor) do + begin + inptr := JSAMPLE_PTR(input_data^[inrow]); + outptr := JSAMPLE_PTR(output_data^[inrow]); + {outend := outptr + cinfo^.output_width;} + outcount := cinfo^.output_width; + while (outcount > 0) do + begin + invalue := inptr^; { don't need GETJSAMPLE() here } + Inc(inptr); + outptr^ := invalue; + Inc(outptr); + outptr^ := invalue; + Inc(outptr); + Dec(outcount, 2); { Nomssi: to avoid pointer arithmetic } + end; + end; +end; + + +{ Fast processing for the common case of 2:1 horizontal and 2:1 vertical. + It's still a box filter. } + +{METHODDEF} +procedure h2v2_upsample (cinfo : j_decompress_ptr; + compptr : jpeg_component_info_ptr; + input_data : JSAMPARRAY; + var output_data_ptr : JSAMPARRAY); +var + output_data : JSAMPARRAY; + {register} inptr, outptr : JSAMPLE_PTR; + {register} invalue : JSAMPLE; + {outend : JSAMPROW;} + outcount : int; + inrow, outrow : int; +begin + output_data := output_data_ptr; + + inrow := 0; + outrow := 0; + while (outrow < cinfo^.max_v_samp_factor) do + begin + inptr := JSAMPLE_PTR(input_data^[inrow]); + outptr := JSAMPLE_PTR(output_data^[outrow]); + {outend := outptr + cinfo^.output_width;} + outcount := cinfo^.output_width; + while (outcount > 0) do + begin + invalue := inptr^; { don't need GETJSAMPLE() here } + Inc(inptr); + outptr^ := invalue; + Inc(outptr); + outptr^ := invalue; + Inc(outptr); + Dec(outcount, 2); + end; + jcopy_sample_rows(output_data, outrow, output_data, outrow+1, + 1, cinfo^.output_width); + Inc(inrow); + Inc(outrow, 2); + end; +end; + + +{ Fancy processing for the common case of 2:1 horizontal and 1:1 vertical. + + The upsampling algorithm is linear interpolation between pixel centers, + also known as a "triangle filter". This is a good compromise between + speed and visual quality. The centers of the output pixels are 1/4 and 3/4 + of the way between input pixel centers. + + A note about the "bias" calculations: when rounding fractional values to + integer, we do not want to always round 0.5 up to the next integer. + If we did that, we'd introduce a noticeable bias towards larger values. + Instead, this code is arranged so that 0.5 will be rounded up or down at + alternate pixel locations (a simple ordered dither pattern). } + +{METHODDEF} +procedure h2v1_fancy_upsample (cinfo : j_decompress_ptr; + compptr : jpeg_component_info_ptr; + input_data : JSAMPARRAY; + var output_data_ptr : JSAMPARRAY); +var + output_data : JSAMPARRAY; + {register} pre_inptr, inptr, outptr : JSAMPLE_PTR; + {register} invalue : int; + {register} colctr : JDIMENSION; + inrow : int; +begin + output_data := output_data_ptr; + + for inrow := 0 to pred(cinfo^.max_v_samp_factor) do + begin + inptr := JSAMPLE_PTR(input_data^[inrow]); + outptr := JSAMPLE_PTR(output_data^[inrow]); + { Special case for first column } + pre_inptr := inptr; + invalue := GETJSAMPLE(inptr^); + Inc(inptr); + outptr^ := JSAMPLE (invalue); + Inc(outptr); + outptr^ := JSAMPLE ((invalue * 3 + GETJSAMPLE(inptr^) + 2) shr 2); + Inc(outptr); + + for colctr := pred(compptr^.downsampled_width - 2) downto 0 do + begin + { General case: 3/4 * nearer pixel + 1/4 * further pixel } + invalue := GETJSAMPLE(inptr^) * 3; + Inc(inptr); + outptr^ := JSAMPLE ((invalue + GETJSAMPLE(pre_inptr^) + 1) shr 2); + Inc(pre_inptr); + Inc(outptr); + outptr^ := JSAMPLE ((invalue + GETJSAMPLE(inptr^) + 2) shr 2); + Inc(outptr); + end; + + { Special case for last column } + invalue := GETJSAMPLE(inptr^); + outptr^ := JSAMPLE ((invalue * 3 + GETJSAMPLE(pre_inptr^) + 1) shr 2); + Inc(outptr); + outptr^ := JSAMPLE (invalue); + {Inc(outptr); - value never used } + end; +end; + + +{ Fancy processing for the common case of 2:1 horizontal and 2:1 vertical. + Again a triangle filter; see comments for h2v1 case, above. + + It is OK for us to reference the adjacent input rows because we demanded + context from the main buffer controller (see initialization code). } + +{METHODDEF} +procedure h2v2_fancy_upsample (cinfo : j_decompress_ptr; + compptr : jpeg_component_info_ptr; + input_data : JSAMPARRAY; + var output_data_ptr : JSAMPARRAY); +var + output_data : JSAMPARRAY; + {register} inptr0, inptr1, outptr : JSAMPLE_PTR; +{$ifdef BITS_IN_JSAMPLE_IS_8} + {register} thiscolsum, lastcolsum, nextcolsum : int; +{$else} + {register} thiscolsum, lastcolsum, nextcolsum : INT32; +{$endif} + {register} colctr : JDIMENSION; + inrow, outrow, v : int; +var + prev_input_data : JSAMPARRAY; { Nomssi work around } +begin + output_data := output_data_ptr; + + outrow := 0; + inrow := 0; + while (outrow < cinfo^.max_v_samp_factor) do + begin + for v := 0 to pred(2) do + begin + { inptr0 points to nearest input row, inptr1 points to next nearest } + inptr0 := JSAMPLE_PTR(input_data^[inrow]); + if (v = 0) then { next nearest is row above } + begin + {inptr1 := JSAMPLE_PTR(input_data^[inrow-1]);} + prev_input_data := input_data; { work around } + Dec(JSAMPROW_PTR(prev_input_data)); { negative offsets } + inptr1 := JSAMPLE_PTR(prev_input_data^[inrow]); + end + else { next nearest is row below } + inptr1 := JSAMPLE_PTR(input_data^[inrow+1]); + outptr := JSAMPLE_PTR(output_data^[outrow]); + Inc(outrow); + + { Special case for first column } + thiscolsum := GETJSAMPLE(inptr0^) * 3 + GETJSAMPLE(inptr1^); + Inc(inptr0); + Inc(inptr1); + nextcolsum := GETJSAMPLE(inptr0^) * 3 + GETJSAMPLE(inptr1^); + Inc(inptr0); + Inc(inptr1); + + outptr^ := JSAMPLE ((thiscolsum * 4 + 8) shr 4); + Inc(outptr); + outptr^ := JSAMPLE ((thiscolsum * 3 + nextcolsum + 7) shr 4); + Inc(outptr); + lastcolsum := thiscolsum; thiscolsum := nextcolsum; + + for colctr := pred(compptr^.downsampled_width - 2) downto 0 do + begin + { General case: 3/4 * nearer pixel + 1/4 * further pixel in each } + { dimension, thus 9/16, 3/16, 3/16, 1/16 overall } + nextcolsum := GETJSAMPLE(inptr0^) * 3 + GETJSAMPLE(inptr1^); + Inc(inptr0); + Inc(inptr1); + outptr^ := JSAMPLE ((thiscolsum * 3 + lastcolsum + 8) shr 4); + Inc(outptr); + outptr^ := JSAMPLE ((thiscolsum * 3 + nextcolsum + 7) shr 4); + Inc(outptr); + lastcolsum := thiscolsum; + thiscolsum := nextcolsum; + end; + + { Special case for last column } + outptr^ := JSAMPLE ((thiscolsum * 3 + lastcolsum + 8) shr 4); + Inc(outptr); + outptr^ := JSAMPLE ((thiscolsum * 4 + 7) shr 4); + {Inc(outptr); - value never used } + end; + Inc(inrow); + end; +end; + + +{ Module initialization routine for upsampling. } + +{GLOBAL} +procedure jinit_upsampler (cinfo : j_decompress_ptr); +var + upsample : my_upsample_ptr; + ci : int; + compptr : jpeg_component_info_ptr; + need_buffer, do_fancy : boolean; + h_in_group, v_in_group, h_out_group, v_out_group : int; +begin + upsample := my_upsample_ptr ( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + SIZEOF(my_upsampler)) ); + cinfo^.upsample := jpeg_upsampler_ptr (upsample); + upsample^.pub.start_pass := start_pass_upsample; + upsample^.pub.upsample := sep_upsample; + upsample^.pub.need_context_rows := FALSE; { until we find out differently } + + if (cinfo^.CCIR601_sampling) then { this isn't supported } + ERREXIT(j_common_ptr(cinfo), JERR_CCIR601_NOTIMPL); + + { jdmainct.c doesn't support context rows when min_DCT_scaled_size := 1, + so don't ask for it. } + + do_fancy := cinfo^.do_fancy_upsampling and (cinfo^.min_DCT_scaled_size > 1); + + { Verify we can handle the sampling factors, select per-component methods, + and create storage as needed. } + + compptr := jpeg_component_info_ptr(cinfo^.comp_info); + for ci := 0 to pred(cinfo^.num_components) do + begin + { Compute size of an "input group" after IDCT scaling. This many samples + are to be converted to max_h_samp_factor * max_v_samp_factor pixels. } + + h_in_group := (compptr^.h_samp_factor * compptr^.DCT_scaled_size) div + cinfo^.min_DCT_scaled_size; + v_in_group := (compptr^.v_samp_factor * compptr^.DCT_scaled_size) div + cinfo^.min_DCT_scaled_size; + h_out_group := cinfo^.max_h_samp_factor; + v_out_group := cinfo^.max_v_samp_factor; + upsample^.rowgroup_height[ci] := v_in_group; { save for use later } + need_buffer := TRUE; + if (not compptr^.component_needed) then + begin + { Don't bother to upsample an uninteresting component. } + upsample^.methods[ci] := noop_upsample; + need_buffer := FALSE; + end + else + if (h_in_group = h_out_group) and (v_in_group = v_out_group) then + begin + { Fullsize components can be processed without any work. } + upsample^.methods[ci] := fullsize_upsample; + need_buffer := FALSE; + end + else + if (h_in_group * 2 = h_out_group) and + (v_in_group = v_out_group) then + begin + { Special cases for 2h1v upsampling } + if (do_fancy) and (compptr^.downsampled_width > 2) then + upsample^.methods[ci] := h2v1_fancy_upsample + else + upsample^.methods[ci] := h2v1_upsample; + end + else + if (h_in_group * 2 = h_out_group) and + (v_in_group * 2 = v_out_group) then + begin + { Special cases for 2h2v upsampling } + if (do_fancy) and (compptr^.downsampled_width > 2) then + begin + upsample^.methods[ci] := h2v2_fancy_upsample; + upsample^.pub.need_context_rows := TRUE; + end + else + upsample^.methods[ci] := h2v2_upsample; + end + else + if ((h_out_group mod h_in_group) = 0) and + ((v_out_group mod v_in_group) = 0) then + begin + { Generic integral-factors upsampling method } + upsample^.methods[ci] := int_upsample; + upsample^.h_expand[ci] := UINT8 (h_out_group div h_in_group); + upsample^.v_expand[ci] := UINT8 (v_out_group div v_in_group); + end + else + ERREXIT(j_common_ptr(cinfo), JERR_FRACT_SAMPLE_NOTIMPL); + if (need_buffer) then + begin + upsample^.color_buf[ci] := cinfo^.mem^.alloc_sarray + (j_common_ptr(cinfo), JPOOL_IMAGE, + JDIMENSION (jround_up( long (cinfo^.output_width), + long (cinfo^.max_h_samp_factor))), + JDIMENSION (cinfo^.max_v_samp_factor)); + end; + Inc(compptr); + end; +end; + +end. diff --git a/Imaging/JpegLib/imjerror.pas b/Imaging/JpegLib/imjerror.pas index e157d12..9a95e6d 100644 --- a/Imaging/JpegLib/imjerror.pas +++ b/Imaging/JpegLib/imjerror.pas @@ -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 : 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. diff --git a/Imaging/JpegLib/imjfdctflt.pas b/Imaging/JpegLib/imjfdctflt.pas index 2fd2053..28f881b 100644 --- a/Imaging/JpegLib/imjfdctflt.pas +++ b/Imaging/JpegLib/imjfdctflt.pas @@ -1,176 +1,176 @@ -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; + +{$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. diff --git a/Imaging/JpegLib/imjfdctfst.pas b/Imaging/JpegLib/imjfdctfst.pas index 0569282..51e4bc6 100644 --- a/Imaging/JpegLib/imjfdctfst.pas +++ b/Imaging/JpegLib/imjfdctfst.pas @@ -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. diff --git a/Imaging/JpegLib/imjfdctint.pas b/Imaging/JpegLib/imjfdctint.pas index 1be951c..bc94638 100644 --- a/Imaging/JpegLib/imjfdctint.pas +++ b/Imaging/JpegLib/imjfdctint.pas @@ -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. diff --git a/Imaging/JpegLib/imjidctasm.pas b/Imaging/JpegLib/imjidctasm.pas index a2f6010..3cf4e70 100644 --- a/Imaging/JpegLib/imjidctasm.pas +++ b/Imaging/JpegLib/imjidctasm.pas @@ -1,793 +1,793 @@ -unit imjidctasm; - -{ 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-1996, Thomas G. Lane. } -{ ;------------------------------------------------------------------------- - ; JIDCTINT.ASM - ; 80386 protected mode assembly translation of JIDCTINT.C - ; **** Optimized to all hell by Jason M. Felice (jasonf@apk.net) **** - ; **** E-mail welcome **** - ; - ; ** This code does not make O/S calls -- use it for OS/2, Win95, WinNT, - ; ** DOS prot. mode., Linux, whatever... have fun. - ; - ; ** Note, this code is dependant on the structure member order in the .h - ; ** files for the following structures: - ; -- amazingly NOT j_decompress_struct... cool. - ; -- jpeg_component_info (dependant on position of dct_table element) - ; - ; Originally created with the /Fa option of MSVC 4.0 (why work when you - ; don't have to?) - ; - ; (this code, when compiled is 1K bytes smaller than the optimized MSVC - ; release build, not to mention 120-130 ms faster in my profile test with 1 - ; small color and and 1 medium black-and-white jpeg: stats using TASM 4.0 - ; and MSVC 4.0 to create a non-console app; jpeg_idct_islow accumulated - ; 5,760 hits on all trials) - ; - ; TASM -t -ml -os jidctint.asm, jidctint.obj - ;------------------------------------------------------------------------- - Converted to Delphi 2.0 BASM for PasJPEG - by Jacques NOMSSI NZALI - October 13th 1996 - * assumes Delphi "register" calling convention - first 3 parameter are in EAX,EDX,ECX - * register allocation revised -} - -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. } - -const - CONST_BITS = 13; - -{$ifdef BITS_IN_JSAMPLE_IS_8} -const - PASS1_BITS = 2; -{$else} -const - 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} - - -{ for DESCALE } -const - ROUND_CONST = (INT32(1) shl (CONST_BITS-PASS1_BITS-1)); -const - ROUND_CONST_2 = (INT32(1) shl (CONST_BITS+PASS1_BITS+3-1)); - -{ 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 } -const - coefDCTSIZE = DCTSIZE*SizeOf(JCOEF); - wrkDCTSIZE = DCTSIZE*SizeOf(int); -var - tmp0, tmp1, tmp2, tmp3 : INT32; - tmp10, tmp11, tmp12, tmp13 : INT32; - z1, z2, z3, z4, z5 : INT32; -var - inptr : JCOEFPTR; - quantptr : ISLOW_MULT_TYPE_FIELD_PTR; - wsptr : PWorkspace; - outptr : JSAMPROW; -var - range_limit : JSAMPROW; - ctr : int; - workspace : TWorkspace; -var - dcval : int; -var - dcval_ : JSAMPLE; -asm - push edi - push esi - push ebx - - cld { The only direction we use, might as well set it now, as opposed } - { to inside 2 loops. } - -{ 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]));} - mov eax, [eax].jpeg_decompress_struct.sample_range_limit {eax=cinfo} - add eax, (MAXJSAMPLE+1 + CENTERJSAMPLE)*(Type JSAMPLE) - mov range_limit, eax - - { 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;} - mov esi, ecx { ecx=coef_block } - {quantptr := ISLOW_MULT_TYPE_FIELD_PTR (compptr^.dct_table);} - mov edi, [edx].jpeg_component_info.dct_table { edx=compptr } - - {wsptr := PWorkspace(@workspace);} - lea ecx, workspace - - {for ctr := pred(DCTSIZE) downto 0 do - begin} - mov ctr, DCTSIZE -@loop518: - { 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]) or (inptr^[DCTSIZE*2]) or (inptr^[DCTSIZE*3]) or - (inptr^[DCTSIZE*4]) or (inptr^[DCTSIZE*5]) or (inptr^[DCTSIZE*6]) or - (inptr^[DCTSIZE*7]) = 0) then - begin} - mov eax, DWORD PTR [esi+coefDCTSIZE*1] - or eax, DWORD PTR [esi+coefDCTSIZE*2] - or eax, DWORD PTR [esi+coefDCTSIZE*3] - mov edx, DWORD PTR [esi+coefDCTSIZE*4] - or eax, edx - or eax, DWORD PTR [esi+coefDCTSIZE*5] - or eax, DWORD PTR [esi+coefDCTSIZE*6] - or eax, DWORD PTR [esi+coefDCTSIZE*7] - jne @loop520 - - { AC terms all zero } - {dcval := ISLOW_MULT_TYPE(inptr^[DCTSIZE*0]) * - (quantptr^[DCTSIZE*0]) shl PASS1_BITS;} - mov eax, DWORD PTR [esi+coefDCTSIZE*0] - imul eax, DWORD PTR [edi+wrkDCTSIZE*0] - shl eax, 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;} - - mov DWORD PTR [ecx+ wrkDCTSIZE*0], eax - mov DWORD PTR [ecx+ wrkDCTSIZE*1], eax - mov DWORD PTR [ecx+ wrkDCTSIZE*2], eax - mov DWORD PTR [ecx+ wrkDCTSIZE*3], eax - mov DWORD PTR [ecx+ wrkDCTSIZE*4], eax - mov DWORD PTR [ecx+ wrkDCTSIZE*5], eax - mov DWORD PTR [ecx+ wrkDCTSIZE*6], eax - mov DWORD PTR [ecx+ wrkDCTSIZE*7], eax - - {Inc(JCOEF_PTR(inptr)); { advance pointers to next column } - {Inc(ISLOW_MULT_TYPE_PTR(quantptr)); - Inc(int_ptr(wsptr)); - continue;} - dec ctr - je @loop519 - - add esi, Type JCOEF - add edi, Type ISLOW_MULT_TYPE - add ecx, Type int { int_ptr } - jmp @loop518 - -@loop520: - - {end;} - - { Even part: reverse the even part of the forward DCT. } - { The rotator is sqrt(2)*c(-6). } - - {z2 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*2]) * quantptr^[DCTSIZE*2]; - z3 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*6]) * quantptr^[DCTSIZE*6]; - - z1 := (z2 + z3) * INT32(FIX_0_541196100); - tmp2 := z1 + INT32(z3) * INT32(- FIX_1_847759065); - tmp3 := z1 + INT32(z2) * INT32(FIX_0_765366865);} - - mov edx, DWORD PTR [esi+coefDCTSIZE*2] - imul edx, DWORD PTR [edi+wrkDCTSIZE*2] {z2} - - mov eax, DWORD PTR [esi+coefDCTSIZE*6] - imul eax, DWORD PTR [edi+wrkDCTSIZE*6] {z3} - - lea ebx, [eax+edx] - imul ebx, FIX_0_541196100 {z1} - - imul eax, (-FIX_1_847759065) - add eax, ebx - mov tmp2, eax - - imul edx, FIX_0_765366865 - add edx, ebx - mov tmp3, edx - - {z2 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*0]) * quantptr^[DCTSIZE*0]; - z3 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*4]) * quantptr^[DCTSIZE*4];} - - mov edx, DWORD PTR [esi+coefDCTSIZE*4] - imul edx, DWORD PTR [edi+wrkDCTSIZE*4] { z3 = edx } - - mov eax, DWORD PTR [esi+coefDCTSIZE*0] - imul eax, DWORD PTR [edi+wrkDCTSIZE*0] { z2 = eax } - - {tmp0 := (z2 + z3) shl CONST_BITS; - tmp1 := (z2 - z3) shl CONST_BITS;} - lea ebx,[eax+edx] - sub eax, edx - shl ebx, CONST_BITS { tmp0 = ebx } - shl eax, CONST_BITS { tmp1 = eax } - - {tmp10 := tmp0 + tmp3; - tmp13 := tmp0 - tmp3;} - mov edx, tmp3 - sub ebx, edx - mov tmp13, ebx - add edx, edx - add ebx, edx - mov tmp10, ebx - - {tmp11 := tmp1 + tmp2; - tmp12 := tmp1 - tmp2;} - mov ebx, tmp2 - sub eax, ebx - mov tmp12, eax - add ebx, ebx - add eax, ebx - mov tmp11, eax - - { 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 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*7]) * quantptr^[DCTSIZE*7];} - mov eax, DWORD PTR [esi+coefDCTSIZE*7] - imul eax, DWORD PTR [edi+wrkDCTSIZE*7] - mov edx, eax { edx = tmp0 } - {tmp0 := (tmp0) * INT32(FIX_0_298631336); { sqrt(2) * (-c1+c3+c5-c7) } - imul eax, FIX_0_298631336 - mov tmp0, eax - - {tmp3 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*1]) * quantptr^[DCTSIZE*1];} - mov eax, DWORD PTR [esi+coefDCTSIZE*1] - imul eax, DWORD PTR [edi+wrkDCTSIZE*1] - mov tmp3, eax - - {z1 := tmp0 + tmp3;} - {z1 := (z1) * INT32(- FIX_0_899976223); { sqrt(2) * (c7-c3) } - add eax, edx - imul eax, (-FIX_0_899976223) - mov z1, eax - - {tmp1 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*5]) * quantptr^[DCTSIZE*5];} - mov eax, DWORD PTR [esi+coefDCTSIZE*5] - imul eax, DWORD PTR [edi+wrkDCTSIZE*5] - mov ebx, eax { ebx = tmp1 } - {tmp1 := (tmp1) * INT32(FIX_2_053119869); { sqrt(2) * ( c1+c3-c5+c7) } - imul eax, FIX_2_053119869 - mov tmp1, eax - - {tmp2 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*3]) * quantptr^[DCTSIZE*3];} - mov eax, DWORD PTR [esi+coefDCTSIZE*3] - imul eax, DWORD PTR [edi+wrkDCTSIZE*3] - mov tmp2, eax - - {z3 := tmp0 + tmp2;} - add edx, eax { edx = z3 } - - {z2 := tmp1 + tmp2;} - {z2 := (z2) * INT32(- FIX_2_562915447); { sqrt(2) * (-c1-c3) } - add eax, ebx - imul eax, (-FIX_2_562915447) - mov z2, eax - - {z4 := tmp1 + tmp3;} - add ebx, tmp3 { ebx = z4 } - - {z5 := INT32(z3 + z4) * INT32(FIX_1_175875602); { sqrt(2) * c3 } - lea eax, [edx+ebx] - imul eax, FIX_1_175875602 { eax = z5 } - - {z4 := (z4) * INT32(- FIX_0_390180644); { sqrt(2) * (c5-c3) } - {Inc(z4, z5);} - imul ebx, (-FIX_0_390180644) - add ebx, eax - mov z4, ebx - - {z3 := (z3) * INT32(- FIX_1_961570560); { sqrt(2) * (-c3-c5) } - {Inc(z3, z5);} - imul edx, (-FIX_1_961570560) - add eax, edx { z3 = eax } - - {Inc(tmp0, z1 + z3);} - mov ebx, z1 - add ebx, eax - add tmp0, ebx - - {tmp2 := (tmp2) * INT32(FIX_3_072711026); { sqrt(2) * ( c1+c3+c5-c7) } - {Inc(tmp2, z2 + z3);} - mov ebx, tmp2 - imul ebx, FIX_3_072711026 - mov edx, z2 { z2 = edx } - add ebx, edx - add eax, ebx - mov tmp2, eax - - {Inc(tmp1, z2 + z4);} - mov eax, z4 { z4 = eax } - add edx, eax - add tmp1, edx - - {tmp3 := (tmp3) * INT32(FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) } - {Inc(tmp3, z1 + z4);} - mov edx, tmp3 - imul edx, FIX_1_501321110 - - add edx, eax - add edx, z1 { tmp3 = edx } - - { 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));} - mov eax, tmp10 - add eax, ROUND_CONST - lea ebx, [eax+edx] - sar ebx, CONST_BITS-PASS1_BITS - mov DWORD PTR [ecx+wrkDCTSIZE*0], ebx - - sub eax, edx - sar eax, CONST_BITS-PASS1_BITS - mov DWORD PTR [ecx+wrkDCTSIZE*7], eax - - {wsptr^[DCTSIZE*1] := int (DESCALE(tmp11 + tmp2, CONST_BITS-PASS1_BITS));} - {wsptr^[DCTSIZE*6] := int (DESCALE(tmp11 - tmp2, CONST_BITS-PASS1_BITS));} - mov eax, tmp11 - add eax, ROUND_CONST - mov edx, tmp2 - lea ebx, [eax+edx] - sar ebx, CONST_BITS-PASS1_BITS - mov DWORD PTR [ecx+wrkDCTSIZE*1], ebx - - sub eax, edx - sar eax, CONST_BITS-PASS1_BITS - mov DWORD PTR [ecx+wrkDCTSIZE*6], eax - - {wsptr^[DCTSIZE*2] := int (DESCALE(tmp12 + tmp1, CONST_BITS-PASS1_BITS));} - {wsptr^[DCTSIZE*5] := int (DESCALE(tmp12 - tmp1, CONST_BITS-PASS1_BITS));} - mov eax, tmp12 - add eax, ROUND_CONST - mov edx, tmp1 - lea ebx, [eax+edx] - sar ebx, CONST_BITS-PASS1_BITS - mov DWORD PTR [ecx+wrkDCTSIZE*2], ebx - - sub eax, edx - sar eax, CONST_BITS-PASS1_BITS - mov DWORD PTR [ecx+wrkDCTSIZE*5], eax - - {wsptr^[DCTSIZE*3] := int (DESCALE(tmp13 + tmp0, CONST_BITS-PASS1_BITS));} - {wsptr^[DCTSIZE*4] := int (DESCALE(tmp13 - tmp0, CONST_BITS-PASS1_BITS));} - mov eax, tmp13 - add eax, ROUND_CONST - mov edx, tmp0 - lea ebx, [eax+edx] - sar ebx, CONST_BITS-PASS1_BITS - mov DWORD PTR [ecx+wrkDCTSIZE*3], ebx - - sub eax, edx - sar eax, CONST_BITS-PASS1_BITS - mov DWORD PTR [ecx+wrkDCTSIZE*4], eax - - {Inc(JCOEF_PTR(inptr)); { advance pointers to next column } - {Inc(ISLOW_MULT_TYPE_PTR(quantptr)); - Inc(int_ptr(wsptr));} - dec ctr - je @loop519 - - add esi, Type JCOEF - add edi, Type ISLOW_MULT_TYPE - add ecx, Type int { int_ptr } - {end;} - jmp @loop518 -@loop519: - { Save to memory what we've registerized for the preceding loop. } - - { 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;} - lea esi, workspace - - {for ctr := 0 to pred(DCTSIZE) do - begin} - mov ctr, 0 -@loop523: - - {outptr := output_buf^[ctr];} - mov eax, ctr - mov ebx, output_buf - mov edi, DWORD PTR [ebx+eax*4] { 4 = SizeOf(pointer) } - - {Inc(JSAMPLE_PTR(outptr), output_col);} - add edi, LongWord(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]) or (wsptr^[2]) or (wsptr^[3]) or (wsptr^[4]) or - (wsptr^[5]) or (wsptr^[6]) or (wsptr^[7]) = 0) then - begin} - mov eax, DWORD PTR [esi+4*1] - or eax, DWORD PTR [esi+4*2] - or eax, DWORD PTR [esi+4*3] - jne @loop525 { Nomssi: early exit path may help } - or eax, DWORD PTR [esi+4*4] - or eax, DWORD PTR [esi+4*5] - or eax, DWORD PTR [esi+4*6] - or eax, DWORD PTR [esi+4*7] - jne @loop525 - - { AC terms all zero } - {JSAMPLE(dcval_) := range_limit^[int(DESCALE(INT32(wsptr^[0]), - PASS1_BITS+3)) and RANGE_MASK];} - mov eax, DWORD PTR [esi+4*0] - add eax, (INT32(1) shl (PASS1_BITS+3-1)) - sar eax, PASS1_BITS+3 - and eax, RANGE_MASK - mov ebx, range_limit - mov al, BYTE PTR [ebx+eax] - mov ah, al - - {outptr^[0] := dcval_; - outptr^[1] := dcval_; - outptr^[2] := dcval_; - outptr^[3] := dcval_; - outptr^[4] := dcval_; - outptr^[5] := dcval_; - outptr^[6] := dcval_; - outptr^[7] := dcval_;} - - stosw - stosw - stosw - stosw - - {Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } - {continue;} - add esi, wrkDCTSIZE - inc ctr - cmp ctr, DCTSIZE - jl @loop523 - jmp @loop524 - {end;} -@loop525: -{$endif} - - - { Even part: reverse the even part of the forward DCT. } - { The rotator is sqrt(2)*c(-6). } - - {z2 := INT32 (wsptr^[2]);} - mov edx, DWORD PTR [esi+4*2] { z2 = edx } - - {z3 := INT32 (wsptr^[6]);} - mov ecx, DWORD PTR [esi+4*6] { z3 = ecx } - - {z1 := (z2 + z3) * INT32(FIX_0_541196100);} - lea eax, [edx+ecx] - imul eax, FIX_0_541196100 - mov ebx, eax { z1 = ebx } - - {tmp2 := z1 + (z3) * INT32(- FIX_1_847759065);} - imul ecx, (-FIX_1_847759065) - add ecx, ebx { tmp2 = ecx } - - {tmp3 := z1 + (z2) * INT32(FIX_0_765366865);} - imul edx, FIX_0_765366865 - add ebx, edx { tmp3 = ebx } - - {tmp0 := (INT32(wsptr^[0]) + INT32(wsptr^[4])) shl CONST_BITS;} - {tmp1 := (INT32(wsptr^[0]) - INT32(wsptr^[4])) shl CONST_BITS;} - mov edx, DWORD PTR [esi+4*4] - mov eax, DWORD PTR [esi+4*0] - sub eax, edx - add edx, edx - add edx, eax - shl edx, CONST_BITS { tmp0 = edx } - shl eax, CONST_BITS { tmp1 = eax } - - {tmp10 := tmp0 + tmp3;} - {tmp13 := tmp0 - tmp3;} - sub edx, ebx - mov tmp13, edx - add ebx, ebx - add edx, ebx - mov tmp10, edx - - {tmp11 := tmp1 + tmp2;} - {tmp12 := tmp1 - tmp2;} - lea ebx, [ecx+eax] - mov tmp11, ebx - sub eax, ecx - mov tmp12, eax - - { Odd part per figure 8; the matrix is unitary and hence its - transpose is its inverse. i0..i3 are y7,y5,y3,y1 respectively. } - -{ The following lines no longer produce code, since wsptr has been - optimized to esi, it is more efficient to access these values - directly. - tmp0 := INT32(wsptr^[7]); - tmp1 := INT32(wsptr^[5]); - tmp2 := INT32(wsptr^[3]); - tmp3 := INT32(wsptr^[1]); } - - {z2 := tmp1 + tmp2;} - {z2 := (z2) * INT32(- FIX_2_562915447); { sqrt(2) * (-c1-c3) } - mov ebx, DWORD PTR [esi+4*3] { tmp2 } - mov ecx, DWORD PTR [esi+4*5] { tmp1 } - lea eax, [ebx+ecx] - imul eax, (-FIX_2_562915447) - mov z2, eax - - {z3 := tmp0 + tmp2;} - mov edx, DWORD PTR [esi+4*7] { tmp0 } - add ebx, edx { old z3 = ebx } - mov eax, ebx - {z3 := (z3) * INT32(- FIX_1_961570560); { sqrt(2) * (-c3-c5) } - imul eax, (-FIX_1_961570560) - mov z3, eax - - {z1 := tmp0 + tmp3;} - {z1 := (z1) * INT32(- FIX_0_899976223); { sqrt(2) * (c7-c3) } - mov eax, DWORD PTR [esi+4*1] { tmp3 } - add edx, eax - imul edx, (-FIX_0_899976223) { z1 = edx } - - {z4 := tmp1 + tmp3;} - add eax, ecx { +tmp1 } - add ebx, eax { z3 + z4 = ebx } - {z4 := (z4) * INT32(- FIX_0_390180644); { sqrt(2) * (c5-c3) } - imul eax, (-FIX_0_390180644) { z4 = eax } - - {z5 := (z3 + z4) * INT32(FIX_1_175875602); { sqrt(2) * c3 } - {Inc(z3, z5);} - imul ebx, FIX_1_175875602 - mov ecx, z3 - add ecx, ebx { ecx = z3 } - - {Inc(z4, z5);} - add ebx, eax { z4 = ebx } - - {tmp0 := (tmp0) * INT32(FIX_0_298631336); { sqrt(2) * (-c1+c3+c5-c7) } - {Inc(tmp0, z1 + z3);} - mov eax, DWORD PTR [esi+4*7] - imul eax, FIX_0_298631336 - add eax, edx - add eax, ecx - mov tmp0, eax - - {tmp1 := (tmp1) * INT32(FIX_2_053119869); { sqrt(2) * ( c1+c3-c5+c7) } - {Inc(tmp1, z2 + z4);} - mov eax, DWORD PTR [esi+4*5] - imul eax, FIX_2_053119869 - add eax, z2 - add eax, ebx - mov tmp1, eax - - {tmp2 := (tmp2) * INT32(FIX_3_072711026); { sqrt(2) * ( c1+c3+c5-c7) } - {Inc(tmp2, z2 + z3);} - mov eax, DWORD PTR [esi+4*3] - imul eax, FIX_3_072711026 - add eax, z2 - add ecx, eax { ecx = tmp2 } - - {tmp3 := (tmp3) * INT32(FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) } - {Inc(tmp3, z1 + z4);} - mov eax, DWORD PTR [esi+4*1] - imul eax, FIX_1_501321110 - add eax, edx - add ebx, eax { ebx = tmp3 } - - { 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];} - - mov edx, tmp10 - add edx, ROUND_CONST_2 - lea eax, [ebx+edx] - sub edx, ebx - - shr eax, CONST_BITS+PASS1_BITS+3 - and eax, RANGE_MASK - mov ebx, range_limit { once for all } - mov al, BYTE PTR [ebx+eax] - mov [edi+0], al - - shr edx, CONST_BITS+PASS1_BITS+3 - and edx, RANGE_MASK - mov al, BYTE PTR [ebx+edx] - mov [edi+7], al - - {outptr^[1] := range_limit^[ int(DESCALE(tmp11 + tmp2, - CONST_BITS+PASS1_BITS+3)) and RANGE_MASK];} - mov eax, tmp11 - add eax, ROUND_CONST_2 - lea edx, [eax+ecx] - shr edx, CONST_BITS+PASS1_BITS+3 - and edx, RANGE_MASK - mov dl, BYTE PTR [ebx+edx] - mov [edi+1], dl - - {outptr^[6] := range_limit^[ int(DESCALE(tmp11 - tmp2, - CONST_BITS+PASS1_BITS+3)) and RANGE_MASK];} - sub eax, ecx - shr eax, CONST_BITS+PASS1_BITS+3 - and eax, RANGE_MASK - mov al, BYTE PTR [ebx+eax] - mov [edi+6], al - - {outptr^[2] := range_limit^[ int(DESCALE(tmp12 + tmp1, - CONST_BITS+PASS1_BITS+3)) and RANGE_MASK];} - mov eax, tmp12 - add eax, ROUND_CONST_2 - mov ecx, tmp1 - lea edx, [eax+ecx] - shr edx, CONST_BITS+PASS1_BITS+3 - and edx, RANGE_MASK - mov dl, BYTE PTR [ebx+edx] - mov [edi+2], dl - - {outptr^[5] := range_limit^[ int(DESCALE(tmp12 - tmp1, - CONST_BITS+PASS1_BITS+3)) and RANGE_MASK];} - sub eax, ecx - shr eax, CONST_BITS+PASS1_BITS+3 - and eax, RANGE_MASK - mov al, BYTE PTR [ebx+eax] - mov [edi+5], al - - {outptr^[3] := range_limit^[ int(DESCALE(tmp13 + tmp0, - CONST_BITS+PASS1_BITS+3)) and RANGE_MASK];} - mov eax, tmp13 - add eax, ROUND_CONST_2 - mov ecx, tmp0 - lea edx, [eax+ecx] - shr edx, CONST_BITS+PASS1_BITS+3 - and edx, RANGE_MASK - mov dl, BYTE PTR [ebx+edx] - mov [edi+3], dl - - {outptr^[4] := range_limit^[ int(DESCALE(tmp13 - tmp0, - CONST_BITS+PASS1_BITS+3)) and RANGE_MASK];} - sub eax, ecx - shr eax, CONST_BITS+PASS1_BITS+3 - and eax, RANGE_MASK - mov al, BYTE PTR [ebx+eax] - mov [edi+4], al - - {Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } - add esi, wrkDCTSIZE - add edi, DCTSIZE - - {end;} - inc ctr - cmp ctr, DCTSIZE - jl @loop523 - -@loop524: -@loop496: - pop ebx - pop esi - pop edi -end; - -end. +unit imjidctasm; + +{ 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-1996, Thomas G. Lane. } +{ ;------------------------------------------------------------------------- + ; JIDCTINT.ASM + ; 80386 protected mode assembly translation of JIDCTINT.C + ; **** Optimized to all hell by Jason M. Felice (jasonf@apk.net) **** + ; **** E-mail welcome **** + ; + ; ** This code does not make O/S calls -- use it for OS/2, Win95, WinNT, + ; ** DOS prot. mode., Linux, whatever... have fun. + ; + ; ** Note, this code is dependant on the structure member order in the .h + ; ** files for the following structures: + ; -- amazingly NOT j_decompress_struct... cool. + ; -- jpeg_component_info (dependant on position of dct_table element) + ; + ; Originally created with the /Fa option of MSVC 4.0 (why work when you + ; don't have to?) + ; + ; (this code, when compiled is 1K bytes smaller than the optimized MSVC + ; release build, not to mention 120-130 ms faster in my profile test with 1 + ; small color and and 1 medium black-and-white jpeg: stats using TASM 4.0 + ; and MSVC 4.0 to create a non-console app; jpeg_idct_islow accumulated + ; 5,760 hits on all trials) + ; + ; TASM -t -ml -os jidctint.asm, jidctint.obj + ;------------------------------------------------------------------------- + Converted to Delphi 2.0 BASM for PasJPEG + by Jacques NOMSSI NZALI + October 13th 1996 + * assumes Delphi "register" calling convention + first 3 parameter are in EAX,EDX,ECX + * register allocation revised +} + +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. } + +const + CONST_BITS = 13; + +{$ifdef BITS_IN_JSAMPLE_IS_8} +const + PASS1_BITS = 2; +{$else} +const + 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} + + +{ for DESCALE } +const + ROUND_CONST = (INT32(1) shl (CONST_BITS-PASS1_BITS-1)); +const + ROUND_CONST_2 = (INT32(1) shl (CONST_BITS+PASS1_BITS+3-1)); + +{ 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 } +const + coefDCTSIZE = DCTSIZE*SizeOf(JCOEF); + wrkDCTSIZE = DCTSIZE*SizeOf(int); +var + tmp0, tmp1, tmp2, tmp3 : INT32; + tmp10, tmp11, tmp12, tmp13 : INT32; + z1, z2, z3, z4, z5 : INT32; +var + inptr : JCOEFPTR; + quantptr : ISLOW_MULT_TYPE_FIELD_PTR; + wsptr : PWorkspace; + outptr : JSAMPROW; +var + range_limit : JSAMPROW; + ctr : int; + workspace : TWorkspace; +var + dcval : int; +var + dcval_ : JSAMPLE; +asm + push edi + push esi + push ebx + + cld { The only direction we use, might as well set it now, as opposed } + { to inside 2 loops. } + +{ 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]));} + mov eax, [eax].jpeg_decompress_struct.sample_range_limit {eax=cinfo} + add eax, (MAXJSAMPLE+1 + CENTERJSAMPLE)*(Type JSAMPLE) + mov range_limit, eax + + { 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;} + mov esi, ecx { ecx=coef_block } + {quantptr := ISLOW_MULT_TYPE_FIELD_PTR (compptr^.dct_table);} + mov edi, [edx].jpeg_component_info.dct_table { edx=compptr } + + {wsptr := PWorkspace(@workspace);} + lea ecx, workspace + + {for ctr := pred(DCTSIZE) downto 0 do + begin} + mov ctr, DCTSIZE +@loop518: + { 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]) or (inptr^[DCTSIZE*2]) or (inptr^[DCTSIZE*3]) or + (inptr^[DCTSIZE*4]) or (inptr^[DCTSIZE*5]) or (inptr^[DCTSIZE*6]) or + (inptr^[DCTSIZE*7]) = 0) then + begin} + mov eax, DWORD PTR [esi+coefDCTSIZE*1] + or eax, DWORD PTR [esi+coefDCTSIZE*2] + or eax, DWORD PTR [esi+coefDCTSIZE*3] + mov edx, DWORD PTR [esi+coefDCTSIZE*4] + or eax, edx + or eax, DWORD PTR [esi+coefDCTSIZE*5] + or eax, DWORD PTR [esi+coefDCTSIZE*6] + or eax, DWORD PTR [esi+coefDCTSIZE*7] + jne @loop520 + + { AC terms all zero } + {dcval := ISLOW_MULT_TYPE(inptr^[DCTSIZE*0]) * + (quantptr^[DCTSIZE*0]) shl PASS1_BITS;} + mov eax, DWORD PTR [esi+coefDCTSIZE*0] + imul eax, DWORD PTR [edi+wrkDCTSIZE*0] + shl eax, 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;} + + mov DWORD PTR [ecx+ wrkDCTSIZE*0], eax + mov DWORD PTR [ecx+ wrkDCTSIZE*1], eax + mov DWORD PTR [ecx+ wrkDCTSIZE*2], eax + mov DWORD PTR [ecx+ wrkDCTSIZE*3], eax + mov DWORD PTR [ecx+ wrkDCTSIZE*4], eax + mov DWORD PTR [ecx+ wrkDCTSIZE*5], eax + mov DWORD PTR [ecx+ wrkDCTSIZE*6], eax + mov DWORD PTR [ecx+ wrkDCTSIZE*7], eax + + {Inc(JCOEF_PTR(inptr)); { advance pointers to next column } + {Inc(ISLOW_MULT_TYPE_PTR(quantptr)); + Inc(int_ptr(wsptr)); + continue;} + dec ctr + je @loop519 + + add esi, Type JCOEF + add edi, Type ISLOW_MULT_TYPE + add ecx, Type int { int_ptr } + jmp @loop518 + +@loop520: + + {end;} + + { Even part: reverse the even part of the forward DCT. } + { The rotator is sqrt(2)*c(-6). } + + {z2 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*2]) * quantptr^[DCTSIZE*2]; + z3 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*6]) * quantptr^[DCTSIZE*6]; + + z1 := (z2 + z3) * INT32(FIX_0_541196100); + tmp2 := z1 + INT32(z3) * INT32(- FIX_1_847759065); + tmp3 := z1 + INT32(z2) * INT32(FIX_0_765366865);} + + mov edx, DWORD PTR [esi+coefDCTSIZE*2] + imul edx, DWORD PTR [edi+wrkDCTSIZE*2] {z2} + + mov eax, DWORD PTR [esi+coefDCTSIZE*6] + imul eax, DWORD PTR [edi+wrkDCTSIZE*6] {z3} + + lea ebx, [eax+edx] + imul ebx, FIX_0_541196100 {z1} + + imul eax, (-FIX_1_847759065) + add eax, ebx + mov tmp2, eax + + imul edx, FIX_0_765366865 + add edx, ebx + mov tmp3, edx + + {z2 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*0]) * quantptr^[DCTSIZE*0]; + z3 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*4]) * quantptr^[DCTSIZE*4];} + + mov edx, DWORD PTR [esi+coefDCTSIZE*4] + imul edx, DWORD PTR [edi+wrkDCTSIZE*4] { z3 = edx } + + mov eax, DWORD PTR [esi+coefDCTSIZE*0] + imul eax, DWORD PTR [edi+wrkDCTSIZE*0] { z2 = eax } + + {tmp0 := (z2 + z3) shl CONST_BITS; + tmp1 := (z2 - z3) shl CONST_BITS;} + lea ebx,[eax+edx] + sub eax, edx + shl ebx, CONST_BITS { tmp0 = ebx } + shl eax, CONST_BITS { tmp1 = eax } + + {tmp10 := tmp0 + tmp3; + tmp13 := tmp0 - tmp3;} + mov edx, tmp3 + sub ebx, edx + mov tmp13, ebx + add edx, edx + add ebx, edx + mov tmp10, ebx + + {tmp11 := tmp1 + tmp2; + tmp12 := tmp1 - tmp2;} + mov ebx, tmp2 + sub eax, ebx + mov tmp12, eax + add ebx, ebx + add eax, ebx + mov tmp11, eax + + { 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 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*7]) * quantptr^[DCTSIZE*7];} + mov eax, DWORD PTR [esi+coefDCTSIZE*7] + imul eax, DWORD PTR [edi+wrkDCTSIZE*7] + mov edx, eax { edx = tmp0 } + {tmp0 := (tmp0) * INT32(FIX_0_298631336); { sqrt(2) * (-c1+c3+c5-c7) } + imul eax, FIX_0_298631336 + mov tmp0, eax + + {tmp3 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*1]) * quantptr^[DCTSIZE*1];} + mov eax, DWORD PTR [esi+coefDCTSIZE*1] + imul eax, DWORD PTR [edi+wrkDCTSIZE*1] + mov tmp3, eax + + {z1 := tmp0 + tmp3;} + {z1 := (z1) * INT32(- FIX_0_899976223); { sqrt(2) * (c7-c3) } + add eax, edx + imul eax, (-FIX_0_899976223) + mov z1, eax + + {tmp1 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*5]) * quantptr^[DCTSIZE*5];} + mov eax, DWORD PTR [esi+coefDCTSIZE*5] + imul eax, DWORD PTR [edi+wrkDCTSIZE*5] + mov ebx, eax { ebx = tmp1 } + {tmp1 := (tmp1) * INT32(FIX_2_053119869); { sqrt(2) * ( c1+c3-c5+c7) } + imul eax, FIX_2_053119869 + mov tmp1, eax + + {tmp2 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*3]) * quantptr^[DCTSIZE*3];} + mov eax, DWORD PTR [esi+coefDCTSIZE*3] + imul eax, DWORD PTR [edi+wrkDCTSIZE*3] + mov tmp2, eax + + {z3 := tmp0 + tmp2;} + add edx, eax { edx = z3 } + + {z2 := tmp1 + tmp2;} + {z2 := (z2) * INT32(- FIX_2_562915447); { sqrt(2) * (-c1-c3) } + add eax, ebx + imul eax, (-FIX_2_562915447) + mov z2, eax + + {z4 := tmp1 + tmp3;} + add ebx, tmp3 { ebx = z4 } + + {z5 := INT32(z3 + z4) * INT32(FIX_1_175875602); { sqrt(2) * c3 } + lea eax, [edx+ebx] + imul eax, FIX_1_175875602 { eax = z5 } + + {z4 := (z4) * INT32(- FIX_0_390180644); { sqrt(2) * (c5-c3) } + {Inc(z4, z5);} + imul ebx, (-FIX_0_390180644) + add ebx, eax + mov z4, ebx + + {z3 := (z3) * INT32(- FIX_1_961570560); { sqrt(2) * (-c3-c5) } + {Inc(z3, z5);} + imul edx, (-FIX_1_961570560) + add eax, edx { z3 = eax } + + {Inc(tmp0, z1 + z3);} + mov ebx, z1 + add ebx, eax + add tmp0, ebx + + {tmp2 := (tmp2) * INT32(FIX_3_072711026); { sqrt(2) * ( c1+c3+c5-c7) } + {Inc(tmp2, z2 + z3);} + mov ebx, tmp2 + imul ebx, FIX_3_072711026 + mov edx, z2 { z2 = edx } + add ebx, edx + add eax, ebx + mov tmp2, eax + + {Inc(tmp1, z2 + z4);} + mov eax, z4 { z4 = eax } + add edx, eax + add tmp1, edx + + {tmp3 := (tmp3) * INT32(FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) } + {Inc(tmp3, z1 + z4);} + mov edx, tmp3 + imul edx, FIX_1_501321110 + + add edx, eax + add edx, z1 { tmp3 = edx } + + { 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));} + mov eax, tmp10 + add eax, ROUND_CONST + lea ebx, [eax+edx] + sar ebx, CONST_BITS-PASS1_BITS + mov DWORD PTR [ecx+wrkDCTSIZE*0], ebx + + sub eax, edx + sar eax, CONST_BITS-PASS1_BITS + mov DWORD PTR [ecx+wrkDCTSIZE*7], eax + + {wsptr^[DCTSIZE*1] := int (DESCALE(tmp11 + tmp2, CONST_BITS-PASS1_BITS));} + {wsptr^[DCTSIZE*6] := int (DESCALE(tmp11 - tmp2, CONST_BITS-PASS1_BITS));} + mov eax, tmp11 + add eax, ROUND_CONST + mov edx, tmp2 + lea ebx, [eax+edx] + sar ebx, CONST_BITS-PASS1_BITS + mov DWORD PTR [ecx+wrkDCTSIZE*1], ebx + + sub eax, edx + sar eax, CONST_BITS-PASS1_BITS + mov DWORD PTR [ecx+wrkDCTSIZE*6], eax + + {wsptr^[DCTSIZE*2] := int (DESCALE(tmp12 + tmp1, CONST_BITS-PASS1_BITS));} + {wsptr^[DCTSIZE*5] := int (DESCALE(tmp12 - tmp1, CONST_BITS-PASS1_BITS));} + mov eax, tmp12 + add eax, ROUND_CONST + mov edx, tmp1 + lea ebx, [eax+edx] + sar ebx, CONST_BITS-PASS1_BITS + mov DWORD PTR [ecx+wrkDCTSIZE*2], ebx + + sub eax, edx + sar eax, CONST_BITS-PASS1_BITS + mov DWORD PTR [ecx+wrkDCTSIZE*5], eax + + {wsptr^[DCTSIZE*3] := int (DESCALE(tmp13 + tmp0, CONST_BITS-PASS1_BITS));} + {wsptr^[DCTSIZE*4] := int (DESCALE(tmp13 - tmp0, CONST_BITS-PASS1_BITS));} + mov eax, tmp13 + add eax, ROUND_CONST + mov edx, tmp0 + lea ebx, [eax+edx] + sar ebx, CONST_BITS-PASS1_BITS + mov DWORD PTR [ecx+wrkDCTSIZE*3], ebx + + sub eax, edx + sar eax, CONST_BITS-PASS1_BITS + mov DWORD PTR [ecx+wrkDCTSIZE*4], eax + + {Inc(JCOEF_PTR(inptr)); { advance pointers to next column } + {Inc(ISLOW_MULT_TYPE_PTR(quantptr)); + Inc(int_ptr(wsptr));} + dec ctr + je @loop519 + + add esi, Type JCOEF + add edi, Type ISLOW_MULT_TYPE + add ecx, Type int { int_ptr } + {end;} + jmp @loop518 +@loop519: + { Save to memory what we've registerized for the preceding loop. } + + { 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;} + lea esi, workspace + + {for ctr := 0 to pred(DCTSIZE) do + begin} + mov ctr, 0 +@loop523: + + {outptr := output_buf^[ctr];} + mov eax, ctr + mov ebx, output_buf + mov edi, DWORD PTR [ebx+eax*4] { 4 = SizeOf(pointer) } + + {Inc(JSAMPLE_PTR(outptr), output_col);} + add edi, LongWord(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]) or (wsptr^[2]) or (wsptr^[3]) or (wsptr^[4]) or + (wsptr^[5]) or (wsptr^[6]) or (wsptr^[7]) = 0) then + begin} + mov eax, DWORD PTR [esi+4*1] + or eax, DWORD PTR [esi+4*2] + or eax, DWORD PTR [esi+4*3] + jne @loop525 { Nomssi: early exit path may help } + or eax, DWORD PTR [esi+4*4] + or eax, DWORD PTR [esi+4*5] + or eax, DWORD PTR [esi+4*6] + or eax, DWORD PTR [esi+4*7] + jne @loop525 + + { AC terms all zero } + {JSAMPLE(dcval_) := range_limit^[int(DESCALE(INT32(wsptr^[0]), + PASS1_BITS+3)) and RANGE_MASK];} + mov eax, DWORD PTR [esi+4*0] + add eax, (INT32(1) shl (PASS1_BITS+3-1)) + sar eax, PASS1_BITS+3 + and eax, RANGE_MASK + mov ebx, range_limit + mov al, BYTE PTR [ebx+eax] + mov ah, al + + {outptr^[0] := dcval_; + outptr^[1] := dcval_; + outptr^[2] := dcval_; + outptr^[3] := dcval_; + outptr^[4] := dcval_; + outptr^[5] := dcval_; + outptr^[6] := dcval_; + outptr^[7] := dcval_;} + + stosw + stosw + stosw + stosw + + {Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } + {continue;} + add esi, wrkDCTSIZE + inc ctr + cmp ctr, DCTSIZE + jl @loop523 + jmp @loop524 + {end;} +@loop525: +{$endif} + + + { Even part: reverse the even part of the forward DCT. } + { The rotator is sqrt(2)*c(-6). } + + {z2 := INT32 (wsptr^[2]);} + mov edx, DWORD PTR [esi+4*2] { z2 = edx } + + {z3 := INT32 (wsptr^[6]);} + mov ecx, DWORD PTR [esi+4*6] { z3 = ecx } + + {z1 := (z2 + z3) * INT32(FIX_0_541196100);} + lea eax, [edx+ecx] + imul eax, FIX_0_541196100 + mov ebx, eax { z1 = ebx } + + {tmp2 := z1 + (z3) * INT32(- FIX_1_847759065);} + imul ecx, (-FIX_1_847759065) + add ecx, ebx { tmp2 = ecx } + + {tmp3 := z1 + (z2) * INT32(FIX_0_765366865);} + imul edx, FIX_0_765366865 + add ebx, edx { tmp3 = ebx } + + {tmp0 := (INT32(wsptr^[0]) + INT32(wsptr^[4])) shl CONST_BITS;} + {tmp1 := (INT32(wsptr^[0]) - INT32(wsptr^[4])) shl CONST_BITS;} + mov edx, DWORD PTR [esi+4*4] + mov eax, DWORD PTR [esi+4*0] + sub eax, edx + add edx, edx + add edx, eax + shl edx, CONST_BITS { tmp0 = edx } + shl eax, CONST_BITS { tmp1 = eax } + + {tmp10 := tmp0 + tmp3;} + {tmp13 := tmp0 - tmp3;} + sub edx, ebx + mov tmp13, edx + add ebx, ebx + add edx, ebx + mov tmp10, edx + + {tmp11 := tmp1 + tmp2;} + {tmp12 := tmp1 - tmp2;} + lea ebx, [ecx+eax] + mov tmp11, ebx + sub eax, ecx + mov tmp12, eax + + { Odd part per figure 8; the matrix is unitary and hence its + transpose is its inverse. i0..i3 are y7,y5,y3,y1 respectively. } + +{ The following lines no longer produce code, since wsptr has been + optimized to esi, it is more efficient to access these values + directly. + tmp0 := INT32(wsptr^[7]); + tmp1 := INT32(wsptr^[5]); + tmp2 := INT32(wsptr^[3]); + tmp3 := INT32(wsptr^[1]); } + + {z2 := tmp1 + tmp2;} + {z2 := (z2) * INT32(- FIX_2_562915447); { sqrt(2) * (-c1-c3) } + mov ebx, DWORD PTR [esi+4*3] { tmp2 } + mov ecx, DWORD PTR [esi+4*5] { tmp1 } + lea eax, [ebx+ecx] + imul eax, (-FIX_2_562915447) + mov z2, eax + + {z3 := tmp0 + tmp2;} + mov edx, DWORD PTR [esi+4*7] { tmp0 } + add ebx, edx { old z3 = ebx } + mov eax, ebx + {z3 := (z3) * INT32(- FIX_1_961570560); { sqrt(2) * (-c3-c5) } + imul eax, (-FIX_1_961570560) + mov z3, eax + + {z1 := tmp0 + tmp3;} + {z1 := (z1) * INT32(- FIX_0_899976223); { sqrt(2) * (c7-c3) } + mov eax, DWORD PTR [esi+4*1] { tmp3 } + add edx, eax + imul edx, (-FIX_0_899976223) { z1 = edx } + + {z4 := tmp1 + tmp3;} + add eax, ecx { +tmp1 } + add ebx, eax { z3 + z4 = ebx } + {z4 := (z4) * INT32(- FIX_0_390180644); { sqrt(2) * (c5-c3) } + imul eax, (-FIX_0_390180644) { z4 = eax } + + {z5 := (z3 + z4) * INT32(FIX_1_175875602); { sqrt(2) * c3 } + {Inc(z3, z5);} + imul ebx, FIX_1_175875602 + mov ecx, z3 + add ecx, ebx { ecx = z3 } + + {Inc(z4, z5);} + add ebx, eax { z4 = ebx } + + {tmp0 := (tmp0) * INT32(FIX_0_298631336); { sqrt(2) * (-c1+c3+c5-c7) } + {Inc(tmp0, z1 + z3);} + mov eax, DWORD PTR [esi+4*7] + imul eax, FIX_0_298631336 + add eax, edx + add eax, ecx + mov tmp0, eax + + {tmp1 := (tmp1) * INT32(FIX_2_053119869); { sqrt(2) * ( c1+c3-c5+c7) } + {Inc(tmp1, z2 + z4);} + mov eax, DWORD PTR [esi+4*5] + imul eax, FIX_2_053119869 + add eax, z2 + add eax, ebx + mov tmp1, eax + + {tmp2 := (tmp2) * INT32(FIX_3_072711026); { sqrt(2) * ( c1+c3+c5-c7) } + {Inc(tmp2, z2 + z3);} + mov eax, DWORD PTR [esi+4*3] + imul eax, FIX_3_072711026 + add eax, z2 + add ecx, eax { ecx = tmp2 } + + {tmp3 := (tmp3) * INT32(FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) } + {Inc(tmp3, z1 + z4);} + mov eax, DWORD PTR [esi+4*1] + imul eax, FIX_1_501321110 + add eax, edx + add ebx, eax { ebx = tmp3 } + + { 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];} + + mov edx, tmp10 + add edx, ROUND_CONST_2 + lea eax, [ebx+edx] + sub edx, ebx + + shr eax, CONST_BITS+PASS1_BITS+3 + and eax, RANGE_MASK + mov ebx, range_limit { once for all } + mov al, BYTE PTR [ebx+eax] + mov [edi+0], al + + shr edx, CONST_BITS+PASS1_BITS+3 + and edx, RANGE_MASK + mov al, BYTE PTR [ebx+edx] + mov [edi+7], al + + {outptr^[1] := range_limit^[ int(DESCALE(tmp11 + tmp2, + CONST_BITS+PASS1_BITS+3)) and RANGE_MASK];} + mov eax, tmp11 + add eax, ROUND_CONST_2 + lea edx, [eax+ecx] + shr edx, CONST_BITS+PASS1_BITS+3 + and edx, RANGE_MASK + mov dl, BYTE PTR [ebx+edx] + mov [edi+1], dl + + {outptr^[6] := range_limit^[ int(DESCALE(tmp11 - tmp2, + CONST_BITS+PASS1_BITS+3)) and RANGE_MASK];} + sub eax, ecx + shr eax, CONST_BITS+PASS1_BITS+3 + and eax, RANGE_MASK + mov al, BYTE PTR [ebx+eax] + mov [edi+6], al + + {outptr^[2] := range_limit^[ int(DESCALE(tmp12 + tmp1, + CONST_BITS+PASS1_BITS+3)) and RANGE_MASK];} + mov eax, tmp12 + add eax, ROUND_CONST_2 + mov ecx, tmp1 + lea edx, [eax+ecx] + shr edx, CONST_BITS+PASS1_BITS+3 + and edx, RANGE_MASK + mov dl, BYTE PTR [ebx+edx] + mov [edi+2], dl + + {outptr^[5] := range_limit^[ int(DESCALE(tmp12 - tmp1, + CONST_BITS+PASS1_BITS+3)) and RANGE_MASK];} + sub eax, ecx + shr eax, CONST_BITS+PASS1_BITS+3 + and eax, RANGE_MASK + mov al, BYTE PTR [ebx+eax] + mov [edi+5], al + + {outptr^[3] := range_limit^[ int(DESCALE(tmp13 + tmp0, + CONST_BITS+PASS1_BITS+3)) and RANGE_MASK];} + mov eax, tmp13 + add eax, ROUND_CONST_2 + mov ecx, tmp0 + lea edx, [eax+ecx] + shr edx, CONST_BITS+PASS1_BITS+3 + and edx, RANGE_MASK + mov dl, BYTE PTR [ebx+edx] + mov [edi+3], dl + + {outptr^[4] := range_limit^[ int(DESCALE(tmp13 - tmp0, + CONST_BITS+PASS1_BITS+3)) and RANGE_MASK];} + sub eax, ecx + shr eax, CONST_BITS+PASS1_BITS+3 + and eax, RANGE_MASK + mov al, BYTE PTR [ebx+eax] + mov [edi+4], al + + {Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } + add esi, wrkDCTSIZE + add edi, DCTSIZE + + {end;} + inc ctr + cmp ctr, DCTSIZE + jl @loop523 + +@loop524: +@loop496: + pop ebx + pop esi + pop edi +end; + +end. diff --git a/Imaging/JpegLib/imjidctflt.pas b/Imaging/JpegLib/imjidctflt.pas index 3b8dedf..68e1588 100644 --- a/Imaging/JpegLib/imjidctflt.pas +++ b/Imaging/JpegLib/imjidctflt.pas @@ -1,286 +1,286 @@ -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; + +{$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. diff --git a/Imaging/JpegLib/imjidctfst.pas b/Imaging/JpegLib/imjidctfst.pas index 0b336d5..6b1dd9b 100644 --- a/Imaging/JpegLib/imjidctfst.pas +++ b/Imaging/JpegLib/imjidctfst.pas @@ -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. diff --git a/Imaging/JpegLib/imjidctint.pas b/Imaging/JpegLib/imjidctint.pas index 7989ae6..f46cc8f 100644 --- a/Imaging/JpegLib/imjidctint.pas +++ b/Imaging/JpegLib/imjidctint.pas @@ -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. diff --git a/Imaging/JpegLib/imjidctred.pas b/Imaging/JpegLib/imjidctred.pas index ef6239a..dae7bfc 100644 --- a/Imaging/JpegLib/imjidctred.pas +++ b/Imaging/JpegLib/imjidctred.pas @@ -1,525 +1,525 @@ -unit imjidctred; - - -{ This file contains inverse-DCT routines that produce reduced-size output: - either 4x4, 2x2, or 1x1 pixels from an 8x8 DCT block. - - The implementation is based on the Loeffler, Ligtenberg and Moschytz (LL&M) - algorithm used in jidctint.c. We simply replace each 8-to-8 1-D IDCT step - with an 8-to-4 step that produces the four averages of two adjacent outputs - (or an 8-to-2 step producing two averages of four outputs, for 2x2 output). - These steps were derived by computing the corresponding values at the end - of the normal LL&M code, then simplifying as much as possible. - - 1x1 is trivial: just take the DC coefficient divided by 8. - - See jidctint.c for additional comments. } - - -{ Original : jidctred.c ; Copyright (C) 1994-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, - producing a reduced-size 1x1 output block. } - -{GLOBAL} -procedure jpeg_idct_1x1 (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - coef_block : JCOEFPTR; - output_buf : JSAMPARRAY; - output_col : JDIMENSION); - -{ Perform dequantization and inverse DCT on one block of coefficients, - producing a reduced-size 2x2 output block. } - -{GLOBAL} -procedure jpeg_idct_2x2 (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - coef_block : JCOEFPTR; - output_buf : JSAMPARRAY; - output_col : JDIMENSION); - -{ Perform dequantization and inverse DCT on one block of coefficients, - producing a reduced-size 4x4 output block. } - -{GLOBAL} -procedure jpeg_idct_4x4 (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 is the same as in jidctint.c. } - -{$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 - FIX_0_211164243 = INT32(Round((INT32(1) shl CONST_BITS) * 0.211164243)); {1730} - FIX_0_509795579 = INT32(Round((INT32(1) shl CONST_BITS) * 0.509795579)); {4176} - FIX_0_601344887 = INT32(Round((INT32(1) shl CONST_BITS) * 0.601344887)); {4926} - FIX_0_720959822 = INT32(Round((INT32(1) shl CONST_BITS) * 0.720959822)); {5906} - FIX_0_765366865 = INT32(Round((INT32(1) shl CONST_BITS) * 0.765366865)); {6270} - FIX_0_850430095 = INT32(Round((INT32(1) shl CONST_BITS) * 0.850430095)); {6967} - FIX_0_899976223 = INT32(Round((INT32(1) shl CONST_BITS) * 0.899976223)); {7373} - FIX_1_061594337 = INT32(Round((INT32(1) shl CONST_BITS) * 1.061594337)); {8697} - FIX_1_272758580 = INT32(Round((INT32(1) shl CONST_BITS) * 1.272758580)); {10426} - FIX_1_451774981 = INT32(Round((INT32(1) shl CONST_BITS) * 1.451774981)); {11893} - FIX_1_847759065 = INT32(Round((INT32(1) shl CONST_BITS) * 1.847759065)); {15137} - FIX_2_172734803 = INT32(Round((INT32(1) shl CONST_BITS) * 2.172734803)); {17799} - FIX_2_562915447 = INT32(Round((INT32(1) shl CONST_BITS) * 2.562915447)); {20995} - FIX_3_624509785 = INT32(Round((INT32(1) shl CONST_BITS) * 3.624509785)); {29692} - - -{ 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} - - {function Multiply(X, Y: Integer): integer; assembler; - asm - mov ax, X - imul Y - mov al, ah - mov ah, dl - end;} - - {MULTIPLY16C16(var,const)} - function Multiply(X, Y: Integer): INT32; - begin - Multiply := X*INT32(Y); - end; - - -{$else} - function Multiply(X, Y: INT32): INT32; - begin - Multiply := X*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, - producing a reduced-size 4x4 output block. } - -{GLOBAL} -procedure jpeg_idct_4x4 (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - coef_block : JCOEFPTR; - output_buf : JSAMPARRAY; - output_col : JDIMENSION); -type - PWorkspace = ^TWorkspace; - TWorkspace = array[0..(DCTSIZE*4)-1] of int; { buffers data between passes } -var - tmp0, tmp2, tmp10, tmp12 : INT32; - z1, z2, z3, z4 : INT32; - inptr : JCOEFPTR; - quantptr : ISLOW_MULT_TYPE_FIELD_PTR; - wsptr : PWorkspace; - outptr : JSAMPROW; - range_limit : JSAMPROW; - ctr : int; - workspace : TWorkspace; { buffers data between passes } - {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. } - - inptr := coef_block; - quantptr := ISLOW_MULT_TYPE_FIELD_PTR (compptr^.dct_table); - wsptr := @workspace; - for ctr := DCTSIZE downto 1 do - begin - { Don't bother to process column 4, because second pass won't use it } - if (ctr = DCTSIZE-4) then - begin - Inc(JCOEF_PTR(inptr)); - Inc(ISLOW_MULT_TYPE_PTR(quantptr)); - Inc(int_ptr(wsptr)); - - continue; - end; - if (inptr^[DCTSIZE*1]=0) and (inptr^[DCTSIZE*2]=0) and (inptr^[DCTSIZE*3]=0) and - (inptr^[DCTSIZE*5]=0) and (inptr^[DCTSIZE*6]=0) and (inptr^[DCTSIZE*7]=0) then - begin - { AC terms all zero; we need not examine term 4 for 4x4 output } - dcval := (ISLOW_MULT_TYPE(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; - - Inc(JCOEF_PTR(inptr)); - Inc(ISLOW_MULT_TYPE_PTR(quantptr)); - Inc(int_ptr(wsptr)); - - continue; - end; - - { Even part } - - tmp0 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*0]) * quantptr^[DCTSIZE*0]); - - tmp0 := tmp0 shl (CONST_BITS+1); - - z2 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*2]) * quantptr^[DCTSIZE*2]); - z3 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*6]) * quantptr^[DCTSIZE*6]); - - tmp2 := MULTIPLY(z2, FIX_1_847759065) + MULTIPLY(z3, - FIX_0_765366865); - - tmp10 := tmp0 + tmp2; - tmp12 := tmp0 - tmp2; - - { Odd part } - - z1 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*7]) * quantptr^[DCTSIZE*7]; - z2 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*5]) * quantptr^[DCTSIZE*5]; - z3 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*3]) * quantptr^[DCTSIZE*3]; - z4 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*1]) * quantptr^[DCTSIZE*1]; - - tmp0 := MULTIPLY(z1, - FIX_0_211164243) { sqrt(2) * (c3-c1) } - + MULTIPLY(z2, FIX_1_451774981) { sqrt(2) * (c3+c7) } - + MULTIPLY(z3, - FIX_2_172734803) { sqrt(2) * (-c1-c5) } - + MULTIPLY(z4, FIX_1_061594337); { sqrt(2) * (c5+c7) } - - tmp2 := MULTIPLY(z1, - FIX_0_509795579) { sqrt(2) * (c7-c5) } - + MULTIPLY(z2, - FIX_0_601344887) { sqrt(2) * (c5-c1) } - + MULTIPLY(z3, FIX_0_899976223) { sqrt(2) * (c3-c7) } - + MULTIPLY(z4, FIX_2_562915447); { sqrt(2) * (c1+c3) } - - { Final output stage } - - wsptr^[DCTSIZE*0] := int(DESCALE(tmp10 + tmp2, CONST_BITS-PASS1_BITS+1)); - wsptr^[DCTSIZE*3] := int(DESCALE(tmp10 - tmp2, CONST_BITS-PASS1_BITS+1)); - wsptr^[DCTSIZE*1] := int(DESCALE(tmp12 + tmp0, CONST_BITS-PASS1_BITS+1)); - wsptr^[DCTSIZE*2] := int(DESCALE(tmp12 - tmp0, CONST_BITS-PASS1_BITS+1)); - - Inc(JCOEF_PTR(inptr)); - Inc(ISLOW_MULT_TYPE_PTR(quantptr)); - Inc(int_ptr(wsptr)); - end; - - { Pass 2: process 4 rows from work array, store into output array. } - - wsptr := @workspace; - for ctr := 0 to pred(4) do - begin - outptr := JSAMPROW(@ output_buf^[ctr]^[output_col]); - { It's not clear whether a zero row test is worthwhile here ... } - -{$ifndef NO_ZERO_ROW_TEST} - if (wsptr^[1]=0) and (wsptr^[2]=0) and (wsptr^[3]=0) and - (wsptr^[5]=0) and (wsptr^[6]=0) and (wsptr^[7]=0) then - begin - { AC terms all zero } - 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_; - - Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } - continue; - end; -{$endif} - - { Even part } - - tmp0 := (INT32(wsptr^[0])) shl (CONST_BITS+1); - - tmp2 := MULTIPLY(INT32(wsptr^[2]), FIX_1_847759065) - + MULTIPLY(INT32(wsptr^[6]), - FIX_0_765366865); - - tmp10 := tmp0 + tmp2; - tmp12 := tmp0 - tmp2; - - { Odd part } - - z1 := INT32(wsptr^[7]); - z2 := INT32(wsptr^[5]); - z3 := INT32(wsptr^[3]); - z4 := INT32(wsptr^[1]); - - tmp0 := MULTIPLY(z1, - FIX_0_211164243) { sqrt(2) * (c3-c1) } - + MULTIPLY(z2, FIX_1_451774981) { sqrt(2) * (c3+c7) } - + MULTIPLY(z3, - FIX_2_172734803) { sqrt(2) * (-c1-c5) } - + MULTIPLY(z4, FIX_1_061594337); { sqrt(2) * (c5+c7) } - - tmp2 := MULTIPLY(z1, - FIX_0_509795579) { sqrt(2) * (c7-c5) } - + MULTIPLY(z2, - FIX_0_601344887) { sqrt(2) * (c5-c1) } - + MULTIPLY(z3, FIX_0_899976223) { sqrt(2) * (c3-c7) } - + MULTIPLY(z4, FIX_2_562915447); { sqrt(2) * (c1+c3) } - - { Final output stage } - - outptr^[0] := range_limit^[ int(DESCALE(tmp10 + tmp2, - CONST_BITS+PASS1_BITS+3+1)) - and RANGE_MASK]; - outptr^[3] := range_limit^[ int(DESCALE(tmp10 - tmp2, - CONST_BITS+PASS1_BITS+3+1)) - and RANGE_MASK]; - outptr^[1] := range_limit^[ int(DESCALE(tmp12 + tmp0, - CONST_BITS+PASS1_BITS+3+1)) - and RANGE_MASK]; - outptr^[2] := range_limit^[ int(DESCALE(tmp12 - tmp0, - CONST_BITS+PASS1_BITS+3+1)) - and RANGE_MASK]; - - Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } - end; -end; - - -{ Perform dequantization and inverse DCT on one block of coefficients, - producing a reduced-size 2x2 output block. } - -{GLOBAL} -procedure jpeg_idct_2x2 (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - coef_block : JCOEFPTR; - output_buf : JSAMPARRAY; - output_col : JDIMENSION); -type - PWorkspace = ^TWorkspace; - TWorkspace = array[0..(DCTSIZE*2)-1] of int; { buffers data between passes } -var - tmp0, tmp10, z1 : INT32; - inptr : JCOEFPTR; - quantptr : ISLOW_MULT_TYPE_FIELD_PTR; - wsptr : PWorkspace; - outptr : JSAMPROW; - range_limit : JSAMPROW; - ctr : int; - workspace : TWorkspace; { buffers data between passes } - {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. } - - inptr := coef_block; - quantptr := ISLOW_MULT_TYPE_FIELD_PTR (compptr^.dct_table); - wsptr := @workspace; - for ctr := DCTSIZE downto 1 do - begin - { Don't bother to process columns 2,4,6 } - if (ctr = DCTSIZE-2) or (ctr = DCTSIZE-4) or (ctr = DCTSIZE-6) then - begin - Inc(JCOEF_PTR(inptr)); - Inc(ISLOW_MULT_TYPE_PTR(quantptr)); - Inc(int_ptr(wsptr)); - - continue; - end; - if (inptr^[DCTSIZE*1]=0) and (inptr^[DCTSIZE*3]=0) and - (inptr^[DCTSIZE*5]=0) and (inptr^[DCTSIZE*7]=0) then - begin - { AC terms all zero; we need not examine terms 2,4,6 for 2x2 output } - dcval := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*0]) * - quantptr^[DCTSIZE*0]) shl PASS1_BITS; - - wsptr^[DCTSIZE*0] := dcval; - wsptr^[DCTSIZE*1] := dcval; - - Inc(JCOEF_PTR(inptr)); - Inc(ISLOW_MULT_TYPE_PTR(quantptr)); - Inc(int_ptr(wsptr)); - - continue; - end; - - { Even part } - - z1 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*0]) * quantptr^[DCTSIZE*0]); - - tmp10 := z1 shl (CONST_BITS+2); - - { Odd part } - - z1 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*7]) * quantptr^[DCTSIZE*7]); - tmp0 := MULTIPLY(z1, - FIX_0_720959822); { sqrt(2) * (c7-c5+c3-c1) } - z1 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*5]) * quantptr^[DCTSIZE*5]); - Inc(tmp0, MULTIPLY(z1, FIX_0_850430095)); { sqrt(2) * (-c1+c3+c5+c7) } - z1 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*3]) * quantptr^[DCTSIZE*3]); - Inc(tmp0, MULTIPLY(z1, - FIX_1_272758580)); { sqrt(2) * (-c1+c3-c5-c7) } - z1 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*1]) * quantptr^[DCTSIZE*1]); - Inc(tmp0, MULTIPLY(z1, FIX_3_624509785)); { sqrt(2) * (c1+c3+c5+c7) } - - { Final output stage } - - wsptr^[DCTSIZE*0] := int (DESCALE(tmp10 + tmp0, CONST_BITS-PASS1_BITS+2)); - wsptr^[DCTSIZE*1] := int (DESCALE(tmp10 - tmp0, CONST_BITS-PASS1_BITS+2)); - - Inc(JCOEF_PTR(inptr)); - Inc(ISLOW_MULT_TYPE_PTR(quantptr)); - Inc(int_ptr(wsptr)); - end; - - { Pass 2: process 2 rows from work array, store into output array. } - - wsptr := @workspace; - for ctr := 0 to pred(2) do - begin - outptr := JSAMPROW(@ output_buf^[ctr]^[output_col]); - { It's not clear whether a zero row test is worthwhile here ... } - -{$ifndef NO_ZERO_ROW_TEST} - if (wsptr^[1]=0) and (wsptr^[3]=0) and (wsptr^[5]=0) and (wsptr^[7]= 0) then - begin - { AC terms all zero } - dcval_ := range_limit^[ int(DESCALE(INT32(wsptr^[0]), PASS1_BITS+3)) - and RANGE_MASK]; - - outptr^[0] := dcval_; - outptr^[1] := dcval_; - - Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } - continue; - end; -{$endif} - - { Even part } - - tmp10 := (INT32 (wsptr^[0])) shl (CONST_BITS+2); - - { Odd part } - - tmp0 := MULTIPLY( INT32(wsptr^[7]), - FIX_0_720959822) { sqrt(2) * (c7-c5+c3-c1) } - + MULTIPLY( INT32(wsptr^[5]), FIX_0_850430095) { sqrt(2) * (-c1+c3+c5+c7) } - + MULTIPLY( INT32(wsptr^[3]), - FIX_1_272758580) { sqrt(2) * (-c1+c3-c5-c7) } - + MULTIPLY( INT32(wsptr^[1]), FIX_3_624509785); { sqrt(2) * (c1+c3+c5+c7) } - - { Final output stage } - - outptr^[0] := range_limit^[ int(DESCALE(tmp10 + tmp0, - CONST_BITS+PASS1_BITS+3+2)) - and RANGE_MASK]; - outptr^[1] := range_limit^[ int(DESCALE(tmp10 - tmp0, - CONST_BITS+PASS1_BITS+3+2)) - and RANGE_MASK]; - - Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } - end; -end; - - -{ Perform dequantization and inverse DCT on one block of coefficients, - producing a reduced-size 1x1 output block. } - -{GLOBAL} -procedure jpeg_idct_1x1 (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - coef_block : JCOEFPTR; - output_buf : JSAMPARRAY; - output_col : JDIMENSION); -var - dcval : int; - quantptr : ISLOW_MULT_TYPE_FIELD_PTR; - range_limit : JSAMPROW; - {SHIFT_TEMPS} -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. } - - { We hardly need an inverse DCT routine for this: just take the - average pixel value, which is one-eighth of the DC coefficient. } - - quantptr := ISLOW_MULT_TYPE_FIELD_PTR (compptr^.dct_table); - dcval := (ISLOW_MULT_TYPE(coef_block^[0]) * quantptr^[0]); - dcval := int (DESCALE( INT32(dcval), 3)); - - output_buf^[0]^[output_col] := range_limit^[dcval and RANGE_MASK]; -end; - -end. +unit imjidctred; + + +{ This file contains inverse-DCT routines that produce reduced-size output: + either 4x4, 2x2, or 1x1 pixels from an 8x8 DCT block. + + The implementation is based on the Loeffler, Ligtenberg and Moschytz (LL&M) + algorithm used in jidctint.c. We simply replace each 8-to-8 1-D IDCT step + with an 8-to-4 step that produces the four averages of two adjacent outputs + (or an 8-to-2 step producing two averages of four outputs, for 2x2 output). + These steps were derived by computing the corresponding values at the end + of the normal LL&M code, then simplifying as much as possible. + + 1x1 is trivial: just take the DC coefficient divided by 8. + + See jidctint.c for additional comments. } + + +{ Original : jidctred.c ; Copyright (C) 1994-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, + producing a reduced-size 1x1 output block. } + +{GLOBAL} +procedure jpeg_idct_1x1 (cinfo : j_decompress_ptr; + compptr : jpeg_component_info_ptr; + coef_block : JCOEFPTR; + output_buf : JSAMPARRAY; + output_col : JDIMENSION); + +{ Perform dequantization and inverse DCT on one block of coefficients, + producing a reduced-size 2x2 output block. } + +{GLOBAL} +procedure jpeg_idct_2x2 (cinfo : j_decompress_ptr; + compptr : jpeg_component_info_ptr; + coef_block : JCOEFPTR; + output_buf : JSAMPARRAY; + output_col : JDIMENSION); + +{ Perform dequantization and inverse DCT on one block of coefficients, + producing a reduced-size 4x4 output block. } + +{GLOBAL} +procedure jpeg_idct_4x4 (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 is the same as in jidctint.c. } + +{$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 + FIX_0_211164243 = INT32(Round((INT32(1) shl CONST_BITS) * 0.211164243)); {1730} + FIX_0_509795579 = INT32(Round((INT32(1) shl CONST_BITS) * 0.509795579)); {4176} + FIX_0_601344887 = INT32(Round((INT32(1) shl CONST_BITS) * 0.601344887)); {4926} + FIX_0_720959822 = INT32(Round((INT32(1) shl CONST_BITS) * 0.720959822)); {5906} + FIX_0_765366865 = INT32(Round((INT32(1) shl CONST_BITS) * 0.765366865)); {6270} + FIX_0_850430095 = INT32(Round((INT32(1) shl CONST_BITS) * 0.850430095)); {6967} + FIX_0_899976223 = INT32(Round((INT32(1) shl CONST_BITS) * 0.899976223)); {7373} + FIX_1_061594337 = INT32(Round((INT32(1) shl CONST_BITS) * 1.061594337)); {8697} + FIX_1_272758580 = INT32(Round((INT32(1) shl CONST_BITS) * 1.272758580)); {10426} + FIX_1_451774981 = INT32(Round((INT32(1) shl CONST_BITS) * 1.451774981)); {11893} + FIX_1_847759065 = INT32(Round((INT32(1) shl CONST_BITS) * 1.847759065)); {15137} + FIX_2_172734803 = INT32(Round((INT32(1) shl CONST_BITS) * 2.172734803)); {17799} + FIX_2_562915447 = INT32(Round((INT32(1) shl CONST_BITS) * 2.562915447)); {20995} + FIX_3_624509785 = INT32(Round((INT32(1) shl CONST_BITS) * 3.624509785)); {29692} + + +{ 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} + + {function Multiply(X, Y: Integer): integer; assembler; + asm + mov ax, X + imul Y + mov al, ah + mov ah, dl + end;} + + {MULTIPLY16C16(var,const)} + function Multiply(X, Y: Integer): INT32; + begin + Multiply := X*INT32(Y); + end; + + +{$else} + function Multiply(X, Y: INT32): INT32; + begin + Multiply := X*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, + producing a reduced-size 4x4 output block. } + +{GLOBAL} +procedure jpeg_idct_4x4 (cinfo : j_decompress_ptr; + compptr : jpeg_component_info_ptr; + coef_block : JCOEFPTR; + output_buf : JSAMPARRAY; + output_col : JDIMENSION); +type + PWorkspace = ^TWorkspace; + TWorkspace = array[0..(DCTSIZE*4)-1] of int; { buffers data between passes } +var + tmp0, tmp2, tmp10, tmp12 : INT32; + z1, z2, z3, z4 : INT32; + inptr : JCOEFPTR; + quantptr : ISLOW_MULT_TYPE_FIELD_PTR; + wsptr : PWorkspace; + outptr : JSAMPROW; + range_limit : JSAMPROW; + ctr : int; + workspace : TWorkspace; { buffers data between passes } + {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. } + + inptr := coef_block; + quantptr := ISLOW_MULT_TYPE_FIELD_PTR (compptr^.dct_table); + wsptr := @workspace; + for ctr := DCTSIZE downto 1 do + begin + { Don't bother to process column 4, because second pass won't use it } + if (ctr = DCTSIZE-4) then + begin + Inc(JCOEF_PTR(inptr)); + Inc(ISLOW_MULT_TYPE_PTR(quantptr)); + Inc(int_ptr(wsptr)); + + continue; + end; + if (inptr^[DCTSIZE*1]=0) and (inptr^[DCTSIZE*2]=0) and (inptr^[DCTSIZE*3]=0) and + (inptr^[DCTSIZE*5]=0) and (inptr^[DCTSIZE*6]=0) and (inptr^[DCTSIZE*7]=0) then + begin + { AC terms all zero; we need not examine term 4 for 4x4 output } + dcval := (ISLOW_MULT_TYPE(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; + + Inc(JCOEF_PTR(inptr)); + Inc(ISLOW_MULT_TYPE_PTR(quantptr)); + Inc(int_ptr(wsptr)); + + continue; + end; + + { Even part } + + tmp0 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*0]) * quantptr^[DCTSIZE*0]); + + tmp0 := tmp0 shl (CONST_BITS+1); + + z2 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*2]) * quantptr^[DCTSIZE*2]); + z3 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*6]) * quantptr^[DCTSIZE*6]); + + tmp2 := MULTIPLY(z2, FIX_1_847759065) + MULTIPLY(z3, - FIX_0_765366865); + + tmp10 := tmp0 + tmp2; + tmp12 := tmp0 - tmp2; + + { Odd part } + + z1 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*7]) * quantptr^[DCTSIZE*7]; + z2 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*5]) * quantptr^[DCTSIZE*5]; + z3 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*3]) * quantptr^[DCTSIZE*3]; + z4 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*1]) * quantptr^[DCTSIZE*1]; + + tmp0 := MULTIPLY(z1, - FIX_0_211164243) { sqrt(2) * (c3-c1) } + + MULTIPLY(z2, FIX_1_451774981) { sqrt(2) * (c3+c7) } + + MULTIPLY(z3, - FIX_2_172734803) { sqrt(2) * (-c1-c5) } + + MULTIPLY(z4, FIX_1_061594337); { sqrt(2) * (c5+c7) } + + tmp2 := MULTIPLY(z1, - FIX_0_509795579) { sqrt(2) * (c7-c5) } + + MULTIPLY(z2, - FIX_0_601344887) { sqrt(2) * (c5-c1) } + + MULTIPLY(z3, FIX_0_899976223) { sqrt(2) * (c3-c7) } + + MULTIPLY(z4, FIX_2_562915447); { sqrt(2) * (c1+c3) } + + { Final output stage } + + wsptr^[DCTSIZE*0] := int(DESCALE(tmp10 + tmp2, CONST_BITS-PASS1_BITS+1)); + wsptr^[DCTSIZE*3] := int(DESCALE(tmp10 - tmp2, CONST_BITS-PASS1_BITS+1)); + wsptr^[DCTSIZE*1] := int(DESCALE(tmp12 + tmp0, CONST_BITS-PASS1_BITS+1)); + wsptr^[DCTSIZE*2] := int(DESCALE(tmp12 - tmp0, CONST_BITS-PASS1_BITS+1)); + + Inc(JCOEF_PTR(inptr)); + Inc(ISLOW_MULT_TYPE_PTR(quantptr)); + Inc(int_ptr(wsptr)); + end; + + { Pass 2: process 4 rows from work array, store into output array. } + + wsptr := @workspace; + for ctr := 0 to pred(4) do + begin + outptr := JSAMPROW(@ output_buf^[ctr]^[output_col]); + { It's not clear whether a zero row test is worthwhile here ... } + +{$ifndef NO_ZERO_ROW_TEST} + if (wsptr^[1]=0) and (wsptr^[2]=0) and (wsptr^[3]=0) and + (wsptr^[5]=0) and (wsptr^[6]=0) and (wsptr^[7]=0) then + begin + { AC terms all zero } + 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_; + + Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } + continue; + end; +{$endif} + + { Even part } + + tmp0 := (INT32(wsptr^[0])) shl (CONST_BITS+1); + + tmp2 := MULTIPLY(INT32(wsptr^[2]), FIX_1_847759065) + + MULTIPLY(INT32(wsptr^[6]), - FIX_0_765366865); + + tmp10 := tmp0 + tmp2; + tmp12 := tmp0 - tmp2; + + { Odd part } + + z1 := INT32(wsptr^[7]); + z2 := INT32(wsptr^[5]); + z3 := INT32(wsptr^[3]); + z4 := INT32(wsptr^[1]); + + tmp0 := MULTIPLY(z1, - FIX_0_211164243) { sqrt(2) * (c3-c1) } + + MULTIPLY(z2, FIX_1_451774981) { sqrt(2) * (c3+c7) } + + MULTIPLY(z3, - FIX_2_172734803) { sqrt(2) * (-c1-c5) } + + MULTIPLY(z4, FIX_1_061594337); { sqrt(2) * (c5+c7) } + + tmp2 := MULTIPLY(z1, - FIX_0_509795579) { sqrt(2) * (c7-c5) } + + MULTIPLY(z2, - FIX_0_601344887) { sqrt(2) * (c5-c1) } + + MULTIPLY(z3, FIX_0_899976223) { sqrt(2) * (c3-c7) } + + MULTIPLY(z4, FIX_2_562915447); { sqrt(2) * (c1+c3) } + + { Final output stage } + + outptr^[0] := range_limit^[ int(DESCALE(tmp10 + tmp2, + CONST_BITS+PASS1_BITS+3+1)) + and RANGE_MASK]; + outptr^[3] := range_limit^[ int(DESCALE(tmp10 - tmp2, + CONST_BITS+PASS1_BITS+3+1)) + and RANGE_MASK]; + outptr^[1] := range_limit^[ int(DESCALE(tmp12 + tmp0, + CONST_BITS+PASS1_BITS+3+1)) + and RANGE_MASK]; + outptr^[2] := range_limit^[ int(DESCALE(tmp12 - tmp0, + CONST_BITS+PASS1_BITS+3+1)) + and RANGE_MASK]; + + Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } + end; +end; + + +{ Perform dequantization and inverse DCT on one block of coefficients, + producing a reduced-size 2x2 output block. } + +{GLOBAL} +procedure jpeg_idct_2x2 (cinfo : j_decompress_ptr; + compptr : jpeg_component_info_ptr; + coef_block : JCOEFPTR; + output_buf : JSAMPARRAY; + output_col : JDIMENSION); +type + PWorkspace = ^TWorkspace; + TWorkspace = array[0..(DCTSIZE*2)-1] of int; { buffers data between passes } +var + tmp0, tmp10, z1 : INT32; + inptr : JCOEFPTR; + quantptr : ISLOW_MULT_TYPE_FIELD_PTR; + wsptr : PWorkspace; + outptr : JSAMPROW; + range_limit : JSAMPROW; + ctr : int; + workspace : TWorkspace; { buffers data between passes } + {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. } + + inptr := coef_block; + quantptr := ISLOW_MULT_TYPE_FIELD_PTR (compptr^.dct_table); + wsptr := @workspace; + for ctr := DCTSIZE downto 1 do + begin + { Don't bother to process columns 2,4,6 } + if (ctr = DCTSIZE-2) or (ctr = DCTSIZE-4) or (ctr = DCTSIZE-6) then + begin + Inc(JCOEF_PTR(inptr)); + Inc(ISLOW_MULT_TYPE_PTR(quantptr)); + Inc(int_ptr(wsptr)); + + continue; + end; + if (inptr^[DCTSIZE*1]=0) and (inptr^[DCTSIZE*3]=0) and + (inptr^[DCTSIZE*5]=0) and (inptr^[DCTSIZE*7]=0) then + begin + { AC terms all zero; we need not examine terms 2,4,6 for 2x2 output } + dcval := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*0]) * + quantptr^[DCTSIZE*0]) shl PASS1_BITS; + + wsptr^[DCTSIZE*0] := dcval; + wsptr^[DCTSIZE*1] := dcval; + + Inc(JCOEF_PTR(inptr)); + Inc(ISLOW_MULT_TYPE_PTR(quantptr)); + Inc(int_ptr(wsptr)); + + continue; + end; + + { Even part } + + z1 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*0]) * quantptr^[DCTSIZE*0]); + + tmp10 := z1 shl (CONST_BITS+2); + + { Odd part } + + z1 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*7]) * quantptr^[DCTSIZE*7]); + tmp0 := MULTIPLY(z1, - FIX_0_720959822); { sqrt(2) * (c7-c5+c3-c1) } + z1 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*5]) * quantptr^[DCTSIZE*5]); + Inc(tmp0, MULTIPLY(z1, FIX_0_850430095)); { sqrt(2) * (-c1+c3+c5+c7) } + z1 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*3]) * quantptr^[DCTSIZE*3]); + Inc(tmp0, MULTIPLY(z1, - FIX_1_272758580)); { sqrt(2) * (-c1+c3-c5-c7) } + z1 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*1]) * quantptr^[DCTSIZE*1]); + Inc(tmp0, MULTIPLY(z1, FIX_3_624509785)); { sqrt(2) * (c1+c3+c5+c7) } + + { Final output stage } + + wsptr^[DCTSIZE*0] := int (DESCALE(tmp10 + tmp0, CONST_BITS-PASS1_BITS+2)); + wsptr^[DCTSIZE*1] := int (DESCALE(tmp10 - tmp0, CONST_BITS-PASS1_BITS+2)); + + Inc(JCOEF_PTR(inptr)); + Inc(ISLOW_MULT_TYPE_PTR(quantptr)); + Inc(int_ptr(wsptr)); + end; + + { Pass 2: process 2 rows from work array, store into output array. } + + wsptr := @workspace; + for ctr := 0 to pred(2) do + begin + outptr := JSAMPROW(@ output_buf^[ctr]^[output_col]); + { It's not clear whether a zero row test is worthwhile here ... } + +{$ifndef NO_ZERO_ROW_TEST} + if (wsptr^[1]=0) and (wsptr^[3]=0) and (wsptr^[5]=0) and (wsptr^[7]= 0) then + begin + { AC terms all zero } + dcval_ := range_limit^[ int(DESCALE(INT32(wsptr^[0]), PASS1_BITS+3)) + and RANGE_MASK]; + + outptr^[0] := dcval_; + outptr^[1] := dcval_; + + Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } + continue; + end; +{$endif} + + { Even part } + + tmp10 := (INT32 (wsptr^[0])) shl (CONST_BITS+2); + + { Odd part } + + tmp0 := MULTIPLY( INT32(wsptr^[7]), - FIX_0_720959822) { sqrt(2) * (c7-c5+c3-c1) } + + MULTIPLY( INT32(wsptr^[5]), FIX_0_850430095) { sqrt(2) * (-c1+c3+c5+c7) } + + MULTIPLY( INT32(wsptr^[3]), - FIX_1_272758580) { sqrt(2) * (-c1+c3-c5-c7) } + + MULTIPLY( INT32(wsptr^[1]), FIX_3_624509785); { sqrt(2) * (c1+c3+c5+c7) } + + { Final output stage } + + outptr^[0] := range_limit^[ int(DESCALE(tmp10 + tmp0, + CONST_BITS+PASS1_BITS+3+2)) + and RANGE_MASK]; + outptr^[1] := range_limit^[ int(DESCALE(tmp10 - tmp0, + CONST_BITS+PASS1_BITS+3+2)) + and RANGE_MASK]; + + Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } + end; +end; + + +{ Perform dequantization and inverse DCT on one block of coefficients, + producing a reduced-size 1x1 output block. } + +{GLOBAL} +procedure jpeg_idct_1x1 (cinfo : j_decompress_ptr; + compptr : jpeg_component_info_ptr; + coef_block : JCOEFPTR; + output_buf : JSAMPARRAY; + output_col : JDIMENSION); +var + dcval : int; + quantptr : ISLOW_MULT_TYPE_FIELD_PTR; + range_limit : JSAMPROW; + {SHIFT_TEMPS} +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. } + + { We hardly need an inverse DCT routine for this: just take the + average pixel value, which is one-eighth of the DC coefficient. } + + quantptr := ISLOW_MULT_TYPE_FIELD_PTR (compptr^.dct_table); + dcval := (ISLOW_MULT_TYPE(coef_block^[0]) * quantptr^[0]); + dcval := int (DESCALE( INT32(dcval), 3)); + + output_buf^[0]^[output_col] := range_limit^[dcval and RANGE_MASK]; +end; + +end. diff --git a/Imaging/JpegLib/imjinclude.pas b/Imaging/JpegLib/imjinclude.pas index e9934cd..dcaa684 100644 --- a/Imaging/JpegLib/imjinclude.pas +++ b/Imaging/JpegLib/imjinclude.pas @@ -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 . - Otherwise, we get them from or ; we may have to - pull in as well. - Note that the core JPEG library does not require ; - 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 .} - - - -{ We need memory copying and zeroing functions, plus strncpy(). - ANSI and System V implementations declare these in . - BSD doesn't have the mem() functions, but it does have bcopy()/bzero(). - Some systems may declare memset and memcpy in . - - 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 . + Otherwise, we get them from or ; we may have to + pull in as well. + Note that the core JPEG library does not require ; + 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 .} + + + +{ We need memory copying and zeroing functions, plus strncpy(). + ANSI and System V implementations declare these in . + BSD doesn't have the mem() functions, but it does have bcopy()/bzero(). + Some systems may declare memset and memcpy in . + + 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. diff --git a/Imaging/JpegLib/imjmorecfg.pas b/Imaging/JpegLib/imjmorecfg.pas index c16d919..316a9a7 100644 --- a/Imaging/JpegLib/imjmorecfg.pas +++ b/Imaging/JpegLib/imjmorecfg.pas @@ -1,247 +1,247 @@ -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} + +{$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. diff --git a/Imaging/JpegLib/imjpeglib.pas b/Imaging/JpegLib/imjpeglib.pas index 40b74af..e859702 100644 --- a/Imaging/JpegLib/imjpeglib.pas +++ b/Imaging/JpegLib/imjpeglib.pas @@ -1,1300 +1,1300 @@ -unit imjpeglib; - -{ This file defines the application interface for the JPEG library. - Most applications using the library need only include this file, - and perhaps jerror.h if they want to know the exact error codes. } - -{ Source:jpeglib.h+jpegint.h; Copyright (C) 1991-1998, Thomas G. Lane. } - - -interface - -{$I imjconfig.inc} - -{ First we include the configuration files that record how this - installation of the JPEG library is set up. jconfig.h can be - generated automatically for many systems. jmorecfg.h contains - manual configuration options that most people need not worry about. } - -uses - imjdeferr, - imjmorecfg; { seldom changed options } - -{ Version ID for the JPEG library. - Might be useful for tests like "#if JPEG_LIB_VERSION >= 60". } - - -Const - JPEG_LIB_VERSION = 62; { Version 6b } - - -{ These marker codes are exported since applications and data source modules - are likely to want to use them. } - -const - JPEG_RST0 = $D0; { RST0 marker code } - JPEG_EOI = $D9; { EOI marker code } - JPEG_APP0 = $E0; { APP0 marker code } - JPEG_COM = $FE; { COM marker code } - - -{ Various constants determining the sizes of things. - All of these are specified by the JPEG standard, so don't change them - if you want to be compatible. } - -const - DCTSIZE = 8; { The basic DCT block is 8x8 samples } - DCTSIZE2 = 64; { DCTSIZE squared; # of elements in a block } - NUM_QUANT_TBLS = 4; { Quantization tables are numbered 0..3 } - NUM_HUFF_TBLS = 4; { Huffman tables are numbered 0..3 } - NUM_ARITH_TBLS = 16; { Arith-coding tables are numbered 0..15 } - MAX_COMPS_IN_SCAN = 4; { JPEG limit on # of components in one scan } - MAX_SAMP_FACTOR = 4; { JPEG limit on sampling factors } -{ Unfortunately, some bozo at Adobe saw no reason to be bound by the standard; - the PostScript DCT filter can emit files with many more than 10 blocks/MCU. - If you happen to run across such a file, you can up D_MAX_BLOCKS_IN_MCU - to handle it. We even let you do this from the jconfig.h file. However, - we strongly discourage changing C_MAX_BLOCKS_IN_MCU; just because Adobe - sometimes emits noncompliant files doesn't mean you should too. } - C_MAX_BLOCKS_IN_MCU = 10; { compressor's limit on blocks per MCU } - D_MAX_BLOCKS_IN_MCU = 10; { decompressor's limit on blocks per MCU } - - -{ Data structures for images (arrays of samples and of DCT coefficients). - On 80x86 machines, the image arrays are too big for near pointers, - but the pointer arrays can fit in near memory. } - -type -{ for typecasting } - JSAMPLE_PTR = ^JSAMPLE; - JSAMPROW_PTR = ^JSAMPROW; - JBLOCKROW_PTR = ^JBLOCKROW; - - 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. } - - jTRow = 0..(MaxInt div SIZEOF(JSAMPROW))-1; - JSAMPROW_ARRAY = Array[jTRow] of JSAMPROW; - JSAMPARRAY = ^JSAMPROW_ARRAY; { ptr to some rows (a 2-D sample array) } - - jTArray = 0..(MaxInt div SIZEOF(JSAMPARRAY))-1; - JSAMP_ARRAY = Array[jTArray] of JSAMPARRAY; - JSAMPIMAGE = ^JSAMP_ARRAY; { a 3-D sample array: top index is color } - - JBLOCK = Array[0..DCTSIZE2-1] of JCOEF; { one block of coefficients } - JBLOCK_PTR = ^JBLOCK; - - jTBlockRow = 0..(MaxInt div SIZEOF(JBLOCK))-1; - JBLOCK_ROWS = Array[jTBlockRow] of JBLOCK; - JBLOCKROW = ^JBLOCK_ROWS; {far} { pointer to one row of coefficient blocks } - - - jTBlockArray = 0..(MaxInt div SIZEOF(JBLOCKROW))-1; - JBLOCK_ARRAY = Array[jTBlockArray] of JBLOCKROW; - JBLOCKARRAY = ^JBLOCK_ARRAY; { a 2-D array of coefficient blocks } - - jTBlockImage = 0..(MaxInt div SIZEOF(JBLOCKARRAY))-1; - JBLOCK_IMAGE = Array[jTBlockImage] of JBLOCKARRAY; - JBLOCKIMAGE = ^JBLOCK_IMAGE; { a 3-D array of coefficient blocks } - - jTCoef = 0..(MaxInt div SIZEOF(JCOEF))-1; - JCOEF_ROW = Array[jTCoef] of JCOEF; - JCOEFPTR = ^JCOEF_ROW; {far} { useful in a couple of places } - - -type - jTByte = 0..(MaxInt div SIZEOF(byte))-1; - JByteArray = Array[jTByte] of byte; - JBytePtr = ^JByteArray; -type - byteptr = ^byte; - -{ Types for JPEG compression parameters and working tables. } - - -{ DCT coefficient quantization tables. } - -type - JQUANT_TBL_PTR = ^JQUANT_TBL; - JQUANT_TBL = record - { This array gives the coefficient quantizers in natural array order - (not the zigzag order in which they are stored in a JPEG DQT marker). - CAUTION: IJG versions prior to v6a kept this array in zigzag order. } - quantval : Array[0..DCTSIZE2-1] of UINT16; - { quantization step for each coefficient } - { This field is used only during compression. It's initialized FALSE when - the table is created, and set TRUE when it's been output to the file. - You could suppress output of a table by setting this to TRUE. - (See jpeg_suppress_tables for an example.) } - sent_table : boolean; { TRUE when table has been output } - end; - JQUANT_TBL_FIELD = Array[0..(MaxInt div SizeOf(JQUANT_TBL))-1] of JQUANT_TBL; - -{ Huffman coding tables. } - -type - JHUFF_TBL_PTR = ^JHUFF_TBL; - JHUFF_TBL = record - { These two fields directly represent the contents of a JPEG DHT marker } - bits : Array[0..17-1] of UINT8; { bits[k] = # of symbols with codes of } - { length k bits; bits[0] is unused } - huffval : Array[0..256-1] of UINT8; - { The symbols, in order of incr code length } - { This field is used only during compression. It's initialized FALSE when - the table is created, and set TRUE when it's been output to the file. - You could suppress output of a table by setting this to TRUE. - (See jpeg_suppress_tables for an example.) } - sent_table : boolean; { TRUE when table has been output } - end; - JHUFF_TBL_FIELD = Array[0..(MaxInt div SizeOf(JHUFF_TBL))-1] of JHUFF_TBL; - -{ Declarations for both compression & decompression } - -type - J_BUF_MODE = ( { Operating modes for buffer controllers } - JBUF_PASS_THRU, { Plain stripwise operation } - { Remaining modes require a full-image buffer to have been created } - JBUF_SAVE_SOURCE, { Run source subobject only, save output } - JBUF_CRANK_DEST, { Run dest subobject only, using saved data } - JBUF_SAVE_AND_PASS { Run both subobjects, save output } - ); - -{ Values of global_state field (jdapi.c has some dependencies on ordering!) } -const - CSTATE_START = 100; { after create_compress } - CSTATE_SCANNING = 101; { start_compress done, write_scanlines OK } - CSTATE_RAW_OK = 102; { start_compress done, write_raw_data OK } - CSTATE_WRCOEFS = 103; { jpeg_write_coefficients done } - DSTATE_START = 200; { after create_decompress } - DSTATE_INHEADER = 201; { reading header markers, no SOS yet } - DSTATE_READY = 202; { found SOS, ready for start_decompress } - DSTATE_PRELOAD = 203; { reading multiscan file in start_decompress} - DSTATE_PRESCAN = 204; { performing dummy pass for 2-pass quant } - DSTATE_SCANNING = 205; { start_decompress done, read_scanlines OK } - DSTATE_RAW_OK = 206; { start_decompress done, read_raw_data OK } - DSTATE_BUFIMAGE = 207; { expecting jpeg_start_output } - DSTATE_BUFPOST = 208; { looking for SOS/EOI in jpeg_finish_output } - DSTATE_RDCOEFS = 209; { reading file in jpeg_read_coefficients } - DSTATE_STOPPING = 210; { looking for EOI in jpeg_finish_decompress } - - - -{ Basic info about one component (color channel). } - -type - jpeg_component_info_ptr = ^jpeg_component_info; - jpeg_component_info = record - { These values are fixed over the whole image. } - { For compression, they must be supplied by parameter setup; } - { for decompression, they are read from the SOF marker. } - component_id : int; { identifier for this component (0..255) } - component_index : int; { its index in SOF or cinfo^.comp_info[] } - h_samp_factor : int; { horizontal sampling factor (1..4) } - v_samp_factor : int; { vertical sampling factor (1..4) } - quant_tbl_no : int; { quantization table selector (0..3) } - { These values may vary between scans. } - { For compression, they must be supplied by parameter setup; } - { for decompression, they are read from the SOS marker. } - { The decompressor output side may not use these variables. } - dc_tbl_no : int; { DC entropy table selector (0..3) } - ac_tbl_no : int; { AC entropy table selector (0..3) } - - { Remaining fields should be treated as private by applications. } - - { These values are computed during compression or decompression startup: } - { Component's size in DCT blocks. - Any dummy blocks added to complete an MCU are not counted; therefore - these values do not depend on whether a scan is interleaved or not. } - width_in_blocks : JDIMENSION; - height_in_blocks : JDIMENSION; - { Size of a DCT block in samples. Always DCTSIZE for compression. - For decompression this is the size of the output from one DCT block, - reflecting any scaling we choose to apply during the IDCT step. - Values of 1,2,4,8 are likely to be supported. Note that different - components may receive different IDCT scalings. } - - DCT_scaled_size : int; - { The downsampled dimensions are the component's actual, unpadded number - of samples at the main buffer (preprocessing/compression interface), thus - downsampled_width = ceil(image_width * Hi/Hmax) - and similarly for height. For decompression, IDCT scaling is included, so - downsampled_width = ceil(image_width * Hi/Hmax * DCT_scaled_size/DCTSIZE)} - - downsampled_width : JDIMENSION; { actual width in samples } - downsampled_height : JDIMENSION; { actual height in samples } - { This flag is used only for decompression. In cases where some of the - components will be ignored (eg grayscale output from YCbCr image), - we can skip most computations for the unused components. } - - component_needed : boolean; { do we need the value of this component? } - - { These values are computed before starting a scan of the component. } - { The decompressor output side may not use these variables. } - MCU_width : int; { number of blocks per MCU, horizontally } - MCU_height : int; { number of blocks per MCU, vertically } - MCU_blocks : int; { MCU_width * MCU_height } - MCU_sample_width : int; { MCU width in samples, MCU_width*DCT_scaled_size } - last_col_width : int; { # of non-dummy blocks across in last MCU } - last_row_height : int; { # of non-dummy blocks down in last MCU } - - { Saved quantization table for component; NIL if none yet saved. - See jdinput.c comments about the need for this information. - This field is currently used only for decompression. } - - quant_table : JQUANT_TBL_PTR; - - { Private per-component storage for DCT or IDCT subsystem. } - dct_table : pointer; - end; { record jpeg_component_info } - - jTCinfo = 0..(MaxInt div SizeOf(jpeg_component_info))-1; - jpeg_component_info_array = array[jTCinfo] of jpeg_component_info; - jpeg_component_info_list_ptr = ^jpeg_component_info_array; - - -{ The script for encoding a multiple-scan file is an array of these: } - -type - jpeg_scan_info_ptr = ^jpeg_scan_info; - jpeg_scan_info = record - comps_in_scan : int; { number of components encoded in this scan } - component_index : Array[0..MAX_COMPS_IN_SCAN-1] of int; - { their SOF/comp_info[] indexes } - Ss, Se : int; { progressive JPEG spectral selection parms } - Ah, Al : int; { progressive JPEG successive approx. parms } - end; - -{ The decompressor can save APPn and COM markers in a list of these: } - -type - jpeg_saved_marker_ptr = ^jpeg_marker_struct; - jpeg_marker_struct = record - next : jpeg_saved_marker_ptr; { next in list, or NULL } - marker : UINT8; { marker code: JPEG_COM, or JPEG_APP0+n } - original_length : uint; { # bytes of data in the file } - data_length : uint; { # bytes of data saved at data[] } - data : JOCTET_FIELD_PTR; { the data contained in the marker } - { the marker length word is not counted in data_length or original_length } - end; - -{ Known color spaces. } - -type - J_COLOR_SPACE = ( - JCS_UNKNOWN, { error/unspecified } - JCS_GRAYSCALE, { monochrome } - JCS_RGB, { red/green/blue } - JCS_YCbCr, { Y/Cb/Cr (also known as YUV) } - JCS_CMYK, { C/M/Y/K } - JCS_YCCK { Y/Cb/Cr/K } - ); - -{ DCT/IDCT algorithm options. } - -type - J_DCT_METHOD = ( - JDCT_ISLOW, { slow but accurate integer algorithm } - JDCT_IFAST, { faster, less accurate integer method } - JDCT_FLOAT { floating-point: accurate, fast on fast HW } - ); - -const - JDCT_DEFAULT = JDCT_ISLOW; - JDCT_FASTEST = JDCT_IFAST; - -{ Dithering options for decompression. } - -type - J_DITHER_MODE = ( - JDITHER_NONE, { no dithering } - JDITHER_ORDERED, { simple ordered dither } - JDITHER_FS { Floyd-Steinberg error diffusion dither } - ); - - -const - JPOOL_PERMANENT = 0; { lasts until master record is destroyed } - JPOOL_IMAGE = 1; { lasts until done with image/datastream } - JPOOL_NUMPOOLS = 2; - - -{ "Object" declarations for JPEG modules that may be supplied or called - directly by the surrounding application. - As with all objects in the JPEG library, these structs only define the - publicly visible methods and state variables of a module. Additional - private fields may exist after the public ones. } - - -{ Error handler object } - -const - JMSG_LENGTH_MAX = 200; { recommended size of format_message buffer } - JMSG_STR_PARM_MAX = 80; - -const - TEMP_NAME_LENGTH = 64; { max length of a temporary file's name } -type - TEMP_STRING = string[TEMP_NAME_LENGTH]; - -{$ifdef USE_MSDOS_MEMMGR} { DOS-specific junk } -type - XMSH = ushort; { type of extended-memory handles } - EMSH = ushort; { type of expanded-memory handles } - - handle_union = record - case byte of - 0:(file_handle : short); { DOS file handle if it's a temp file } - 1:(xms_handle : XMSH); { handle if it's a chunk of XMS } - 2:(ems_handle : EMSH); { handle if it's a chunk of EMS } - end; -{$endif} { USE_MSDOS_MEMMGR } - -type - jpeg_error_mgr_ptr = ^jpeg_error_mgr; - jpeg_memory_mgr_ptr = ^jpeg_memory_mgr; - jpeg_progress_mgr_ptr = ^jpeg_progress_mgr; - - -{$ifdef common} -{ Common fields between JPEG compression and decompression master structs. } - err : jpeg_error_mgr_ptr; { Error handler module } - mem : jpeg_memory_mgr_ptr; { Memory manager module } - progress : jpeg_progress_mgr_ptr; { Progress monitor, or NIL if none } - client_data : voidp; { Available for use by application } - is_decompressor : boolean; { so common code can tell which is which } - global_state : int; { for checking call sequence validity } -{$endif} - - j_common_ptr = ^jpeg_common_struct; - j_compress_ptr = ^jpeg_compress_struct; - j_decompress_ptr = ^jpeg_decompress_struct; - - {$ifdef AM_MEMORY_MANAGER} { only jmemmgr.c defines these } - -{ 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. } - - - backing_store_ptr = ^backing_store_info; - backing_store_info = record - { Methods for reading/writing/closing this backing-store object } - read_backing_store : procedure (cinfo : j_common_ptr; - info : backing_store_ptr; - buffer_address : pointer; {far} - file_offset : long; - byte_count : long); - write_backing_store : procedure (cinfo : j_common_ptr; - info : backing_store_ptr; - buffer_address : pointer; {far} - file_offset : long; - byte_count : long); - - close_backing_store : procedure (cinfo : j_common_ptr; - info : backing_store_ptr); - - { Private fields for system-dependent backing-store management } - {$ifdef USE_MSDOS_MEMMGR} - { For the MS-DOS manager (jmemdos.c), we need: } - handle : handle_union; { reference to backing-store storage object } - temp_name : TEMP_STRING; { name if it's a file } - {$else} - { For a typical implementation with temp files, we need: } - temp_file : file; { stdio reference to temp file } - temp_name : TEMP_STRING; { name of temp file } - {$endif} - end; - - -{ The control blocks for virtual arrays. - Note that these blocks are allocated in the "small" pool area. - System-dependent info for the associated backing store (if any) is hidden - inside the backing_store_info struct. } - - jvirt_sarray_ptr = ^jvirt_sarray_control; - jvirt_sarray_control = record - mem_buffer : JSAMPARRAY; { => the in-memory buffer } - rows_in_array : JDIMENSION; { total virtual array height } - samplesperrow : JDIMENSION; { width of array (and of memory buffer) } - maxaccess : JDIMENSION; { max rows accessed by access_virt_sarray } - rows_in_mem : JDIMENSION; { height of memory buffer } - rowsperchunk : JDIMENSION; { allocation chunk size in mem_buffer } - cur_start_row : JDIMENSION; { first logical row # in the buffer } - first_undef_row : JDIMENSION; { row # of first uninitialized row } - pre_zero : boolean; { pre-zero mode requested? } - dirty : boolean; { do current buffer contents need written? } - b_s_open : boolean; { is backing-store data valid? } - next : jvirt_sarray_ptr; { link to next virtual sarray control block } - b_s_info : backing_store_info; { System-dependent control info } - end; - - jvirt_barray_ptr = ^jvirt_barray_control; - jvirt_barray_control = record - mem_buffer : JBLOCKARRAY; { => the in-memory buffer } - rows_in_array : JDIMENSION; { total virtual array height } - blocksperrow : JDIMENSION; { width of array (and of memory buffer) } - maxaccess : JDIMENSION; { max rows accessed by access_virt_barray } - rows_in_mem : JDIMENSION; { height of memory buffer } - rowsperchunk : JDIMENSION; { allocation chunk size in mem_buffer } - cur_start_row : JDIMENSION; { first logical row # in the buffer } - first_undef_row : JDIMENSION; { row # of first uninitialized row } - pre_zero : boolean; { pre-zero mode requested? } - dirty : boolean; { do current buffer contents need written? } - b_s_open : boolean; { is backing-store data valid? } - next : jvirt_barray_ptr; { link to next virtual barray control block } - b_s_info : backing_store_info; { System-dependent control info } - end; - - {$endif} { AM_MEMORY_MANAGER } - -{ Declarations for compression modules } - -{ Master control module } - jpeg_comp_master_ptr = ^jpeg_comp_master; - jpeg_comp_master = record - prepare_for_pass : procedure(cinfo : j_compress_ptr); - pass_startup : procedure(cinfo : j_compress_ptr); - finish_pass : procedure(cinfo : j_compress_ptr); - - { State variables made visible to other modules } - call_pass_startup : Boolean; { True if pass_startup must be called } - is_last_pass : Boolean; { True during last pass } - end; - -{ Main buffer control (downsampled-data buffer) } - jpeg_c_main_controller_ptr = ^jpeg_c_main_controller; - jpeg_c_main_controller = record - start_pass : procedure(cinfo : j_compress_ptr; pass_mode : J_BUF_MODE); - process_data : procedure(cinfo : j_compress_ptr; - input_buf : JSAMPARRAY; - var in_row_ctr : JDIMENSION; - in_rows_avail : JDIMENSION); - end; - -{ Compression preprocessing (downsampling input buffer control) } - jpeg_c_prep_controller_ptr = ^jpeg_c_prep_controller; - jpeg_c_prep_controller = record - start_pass : procedure(cinfo : j_compress_ptr; pass_mode : J_BUF_MODE); - pre_process_data : procedure(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); - end; - -{ Coefficient buffer control } - jpeg_c_coef_controller_ptr = ^jpeg_c_coef_controller; - jpeg_c_coef_controller = record - start_pass : procedure(cinfo : j_compress_ptr; pass_mode : J_BUF_MODE); - compress_data : function(cinfo : j_compress_ptr; - input_buf : JSAMPIMAGE) : boolean; - end; - -{ Colorspace conversion } - jpeg_color_converter_ptr = ^jpeg_color_converter; - jpeg_color_converter = record - start_pass : procedure(cinfo : j_compress_ptr); - color_convert : procedure(cinfo : j_compress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPIMAGE; - output_row : JDIMENSION; - num_rows : int); - end; - -{ Downsampling } - jpeg_downsampler_ptr = ^jpeg_downsampler; - jpeg_downsampler = record - start_pass : procedure(cinfo : j_compress_ptr); - downsample : procedure(cinfo : j_compress_ptr; - input_buf : JSAMPIMAGE; - in_row_index : JDIMENSION; - output_buf : JSAMPIMAGE; - out_row_group_index: JDIMENSION); - need_context_rows : Boolean; { TRUE if need rows above & below } - end; - -{ Forward DCT (also controls coefficient quantization) } - jpeg_forward_dct_ptr = ^jpeg_forward_dct; - jpeg_forward_dct = record - start_pass : procedure(cinfo : j_compress_ptr); - { perhaps this should be an array??? } - forward_DCT : procedure(cinfo : j_compress_ptr; - compptr : jpeg_component_info_ptr; - sample_data : JSAMPARRAY; - coef_blocks : JBLOCKROW; - start_row : JDIMENSION; - start_col : JDIMENSION; - num_blocks : JDIMENSION); - end; - -{ Entropy encoding } - - jpeg_entropy_encoder_ptr = ^jpeg_entropy_encoder; - jpeg_entropy_encoder = record - start_pass : procedure(cinfo : j_compress_ptr; gather_statistics : boolean); - encode_mcu : function(cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; - finish_pass : procedure(cinfo : j_compress_ptr); - end; - -{ Marker writing } - jpeg_marker_writer_ptr = ^jpeg_marker_writer; - jpeg_marker_writer = record - write_file_header : procedure(cinfo : j_compress_ptr); - write_frame_header : procedure(cinfo : j_compress_ptr); - write_scan_header : procedure(cinfo : j_compress_ptr); - write_file_trailer : procedure(cinfo : j_compress_ptr); - write_tables_only : procedure(cinfo : j_compress_ptr); - { These routines are exported to allow insertion of extra markers } - { Probably only COM and APPn markers should be written this way } - write_marker_header : procedure (cinfo : j_compress_ptr; - marker : int; - datalen : uint); - write_marker_byte : procedure (cinfo : j_compress_ptr; val : int); - end; - -{ Declarations for decompression modules } - -{ Master control module } - jpeg_decomp_master_ptr = ^jpeg_decomp_master; - jpeg_decomp_master = record - prepare_for_output_pass : procedure( cinfo : j_decompress_ptr); - finish_output_pass : procedure(cinfo : j_decompress_ptr); - - { State variables made visible to other modules } - is_dummy_pass : Boolean; { True during 1st pass for 2-pass quant } - end; - -{ Input control module } - jpeg_input_controller_ptr = ^jpeg_input_controller; - jpeg_input_controller = record - consume_input : function (cinfo : j_decompress_ptr) : int; - reset_input_controller : procedure(cinfo : j_decompress_ptr); - start_input_pass : procedure(cinfo : j_decompress_ptr); - finish_input_pass : procedure(cinfo : j_decompress_ptr); - - { State variables made visible to other modules } - has_multiple_scans : Boolean; { True if file has multiple scans } - eoi_reached : Boolean; { True when EOI has been consumed } - end; - -{ Main buffer control (downsampled-data buffer) } - - jpeg_d_main_controller_ptr = ^jpeg_d_main_controller; - jpeg_d_main_controller = record - start_pass : procedure(cinfo : j_decompress_ptr; pass_mode : J_BUF_MODE); - process_data : procedure(cinfo : j_decompress_ptr; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); - end; - -{ Coefficient buffer control } - jvirt_barray_tbl = array[0..MAX_COMPONENTS-1] of jvirt_barray_ptr; - jvirt_barray_tbl_ptr = ^jvirt_barray_tbl; - jpeg_d_coef_controller_ptr = ^jpeg_d_coef_controller; - jpeg_d_coef_controller = record - start_input_pass : procedure(cinfo : j_decompress_ptr); - consume_data : function (cinfo : j_decompress_ptr) : int; - start_output_pass : procedure(cinfo : j_decompress_ptr); - decompress_data : function (cinfo : j_decompress_ptr; - output_buf : JSAMPIMAGE) : int; - { Pointer to array of coefficient virtual arrays, or NIL if none } - coef_arrays : jvirt_barray_tbl_ptr; - end; - -{ Decompression postprocessing (color quantization buffer control) } - jpeg_d_post_controller_ptr = ^jpeg_d_post_controller; - jpeg_d_post_controller = record - start_pass : procedure(cinfo : j_decompress_ptr; - pass_mode : J_BUF_MODE); - post_process_data : procedure(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); - end; - - -{ Routine signature for application-supplied marker processing methods. - Need not pass marker code since it is stored in cinfo^.unread_marker. } - - jpeg_marker_parser_method = function(cinfo : j_decompress_ptr) : boolean; - -{ Marker reading & parsing } - jpeg_marker_reader_ptr = ^jpeg_marker_reader; - jpeg_marker_reader = record - reset_marker_reader : procedure(cinfo : j_decompress_ptr); - { Read markers until SOS or EOI. - Returns same codes as are defined for jpeg_consume_input: - JPEG_SUSPENDED, JPEG_REACHED_SOS, or JPEG_REACHED_EOI. } - - read_markers : function (cinfo : j_decompress_ptr) : int; - { Read a restart marker --- exported for use by entropy decoder only } - read_restart_marker : jpeg_marker_parser_method; - - { State of marker reader --- nominally internal, but applications - supplying COM or APPn handlers might like to know the state. } - - saw_SOI : boolean; { found SOI? } - saw_SOF : boolean; { found SOF? } - next_restart_num : int; { next restart number expected (0-7) } - discarded_bytes : uint; { # of bytes skipped looking for a marker } - end; - -{ Entropy decoding } - jpeg_entropy_decoder_ptr = ^jpeg_entropy_decoder; - jpeg_entropy_decoder = record - start_pass : procedure(cinfo : j_decompress_ptr); - decode_mcu : function(cinfo : j_decompress_ptr; - var MCU_data : array of JBLOCKROW) : boolean; - { This is here to share code between baseline and progressive decoders; } - { other modules probably should not use it } - insufficient_data : BOOLEAN; { set TRUE after emitting warning } - end; - -{ Inverse DCT (also performs dequantization) } - inverse_DCT_method_ptr = procedure(cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - coef_block : JCOEFPTR; - output_buf : JSAMPARRAY; output_col : JDIMENSION); - - jpeg_inverse_dct_ptr = ^jpeg_inverse_dct; - jpeg_inverse_dct = record - start_pass : procedure(cinfo : j_decompress_ptr); - { It is useful to allow each component to have a separate IDCT method. } - inverse_DCT : Array[0..MAX_COMPONENTS-1] of inverse_DCT_method_ptr; - end; - -{ Upsampling (note that upsampler must also call color converter) } - jpeg_upsampler_ptr = ^jpeg_upsampler; - jpeg_upsampler = record - start_pass : procedure(cinfo : j_decompress_ptr); - upsample : procedure(cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - var in_row_group_ctr : JDIMENSION; { array of } - in_row_groups_avail : JDIMENSION; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); - - need_context_rows : boolean; { TRUE if need rows above & below } - end; - -{ Colorspace conversion } - jpeg_color_deconverter_ptr = ^jpeg_color_deconverter; - jpeg_color_deconverter = record - start_pass : procedure(cinfo: j_decompress_ptr); - color_convert : procedure(cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - input_row : JDIMENSION; - output_buf : JSAMPARRAY; - num_rows : int); - end; - -{ Color quantization or color precision reduction } - jpeg_color_quantizer_ptr = ^jpeg_color_quantizer; - jpeg_color_quantizer = record - start_pass : procedure(cinfo : j_decompress_ptr; is_pre_scan : boolean); - color_quantize : procedure(cinfo : j_decompress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPARRAY; - num_rows : int); - - finish_pass : procedure(cinfo : j_decompress_ptr); - new_color_map : procedure(cinfo : j_decompress_ptr); - end; - - {int8array = Array[0..8-1] of int;} - int8array = Array[0..8-1] of longint; { for TP FormatStr } - - jpeg_error_mgr = record - { Error exit handler: does not return to caller } - error_exit : procedure (cinfo : j_common_ptr); - { Conditionally emit a trace or warning message } - emit_message : procedure (cinfo : j_common_ptr; msg_level : int); - { Routine that actually outputs a trace or error message } - output_message : procedure (cinfo : j_common_ptr); - { Format a message string for the most recent JPEG error or message } - format_message : procedure (cinfo : j_common_ptr; var buffer : string); - - { Reset error state variables at start of a new image } - reset_error_mgr : procedure (cinfo : j_common_ptr); - - { The message ID code and any parameters are saved here. - A message can have one string parameter or up to 8 int parameters. } - - msg_code : int; - - msg_parm : record - case byte of - 0:(i : int8array); - 1:(s : string[JMSG_STR_PARM_MAX]); - end; - - { Standard state variables for error facility } - - trace_level : int; { max msg_level that will be displayed } - - { For recoverable corrupt-data errors, we emit a warning message, - but keep going unless emit_message chooses to abort. emit_message - should count warnings in num_warnings. The surrounding application - can check for bad data by seeing if num_warnings is nonzero at the - end of processing. } - - num_warnings : long; { number of corrupt-data warnings } - - { These fields point to the table(s) of error message strings. - An application can change the table pointer to switch to a different - message list (typically, to change the language in which errors are - reported). Some applications may wish to add additional error codes - that will be handled by the JPEG library error mechanism; the second - table pointer is used for this purpose. - - First table includes all errors generated by JPEG library itself. - Error code 0 is reserved for a "no such error string" message. } - - {const char * const * jpeg_message_table; } - jpeg_message_table : ^msg_table; { Library errors } - - last_jpeg_message : J_MESSAGE_CODE; - { Table contains strings 0..last_jpeg_message } - { Second table can be added by application (see cjpeg/djpeg for example). - It contains strings numbered first_addon_message..last_addon_message. } - - {const char * const * addon_message_table; } - addon_message_table : ^msg_table; { Non-library errors } - - first_addon_message : J_MESSAGE_CODE; { code for first string in addon table } - last_addon_message : J_MESSAGE_CODE; { code for last string in addon table } - end; - - -{ Progress monitor object } - - jpeg_progress_mgr = record - progress_monitor : procedure(cinfo : j_common_ptr); - - pass_counter : long; { work units completed in this pass } - pass_limit : long; { total number of work units in this pass } - completed_passes : int; { passes completed so far } - total_passes : int; { total number of passes expected } - end; - - -{ Data destination object for compression } - jpeg_destination_mgr_ptr = ^jpeg_destination_mgr; - jpeg_destination_mgr = record - next_output_byte : JOCTETptr; { => next byte to write in buffer } - free_in_buffer : size_t; { # of byte spaces remaining in buffer } - - init_destination : procedure (cinfo : j_compress_ptr); - empty_output_buffer : function (cinfo : j_compress_ptr) : boolean; - term_destination : procedure (cinfo : j_compress_ptr); - end; - - -{ Data source object for decompression } - - jpeg_source_mgr_ptr = ^jpeg_source_mgr; - jpeg_source_mgr = record - {const JOCTET * next_input_byte;} - next_input_byte : JOCTETptr; { => next byte to read from buffer } - bytes_in_buffer : size_t; { # of bytes remaining in buffer } - - init_source : procedure (cinfo : j_decompress_ptr); - fill_input_buffer : function (cinfo : j_decompress_ptr) : boolean; - skip_input_data : procedure (cinfo : j_decompress_ptr; num_bytes : long); - resync_to_restart : function (cinfo : j_decompress_ptr; - desired : int) : boolean; - term_source : procedure (cinfo : j_decompress_ptr); - end; - - -{ Memory manager object. - Allocates "small" objects (a few K total), "large" objects (tens of K), - and "really big" objects (virtual arrays with backing store if needed). - The memory manager does not allow individual objects to be freed; rather, - each created object is assigned to a pool, and whole pools can be freed - at once. This is faster and more convenient than remembering exactly what - to free, especially where malloc()/free() are not too speedy. - NB: alloc routines never return NIL. They exit to error_exit if not - successful. } - - - jpeg_memory_mgr = record - { Method pointers } - alloc_small : function (cinfo : j_common_ptr; pool_id : int; - sizeofobject : size_t) : pointer; - alloc_large : function (cinfo : j_common_ptr; pool_id : int; - sizeofobject : size_t) : pointer; {far} - alloc_sarray : function (cinfo : j_common_ptr; pool_id : int; - samplesperrow : JDIMENSION; - numrows : JDIMENSION) : JSAMPARRAY; - - alloc_barray : function (cinfo : j_common_ptr; pool_id : int; - blocksperrow : JDIMENSION; - numrows : JDIMENSION) : JBLOCKARRAY; - - request_virt_sarray : function(cinfo : j_common_ptr; - pool_id : int; - pre_zero : boolean; - samplesperrow : JDIMENSION; - numrows : JDIMENSION; - maxaccess : JDIMENSION) : jvirt_sarray_ptr; - - request_virt_barray : function(cinfo : j_common_ptr; - pool_id : int; - pre_zero : boolean; - blocksperrow : JDIMENSION; - numrows : JDIMENSION; - maxaccess : JDIMENSION) : jvirt_barray_ptr; - - realize_virt_arrays : procedure (cinfo : j_common_ptr); - - access_virt_sarray : function (cinfo : j_common_ptr; - ptr : jvirt_sarray_ptr; - start_row : JDIMENSION; - num_rows : JDIMENSION; - writable : boolean) : JSAMPARRAY; - - access_virt_barray : function (cinfo : j_common_ptr; - ptr : jvirt_barray_ptr; - start_row : JDIMENSION; - num_rows : JDIMENSION; - writable : boolean) : JBLOCKARRAY; - - free_pool : procedure (cinfo : j_common_ptr; pool_id : int); - self_destruct : procedure (cinfo : j_common_ptr); - - { Limit on memory allocation for this JPEG object. (Note that this is - merely advisory, not a guaranteed maximum; it only affects the space - used for virtual-array buffers.) May be changed by outer application - after creating the JPEG object. } - max_memory_to_use : long; - - { Maximum allocation request accepted by alloc_large. } - max_alloc_chunk : long; - end; - -{ Routines that are to be used by both halves of the library are declared - to receive a pointer to this structure. There are no actual instances of - jpeg_common_struct, only of jpeg_compress_struct and jpeg_decompress_struct.} - jpeg_common_struct = record - { Fields common to both master struct types } - err : jpeg_error_mgr_ptr; { Error handler module } - mem : jpeg_memory_mgr_ptr; { Memory manager module } - progress : jpeg_progress_mgr_ptr; { Progress monitor, or NIL if none } - client_data : voidp; { Available for use by application } - is_decompressor : boolean; { so common code can tell which is which } - global_state : int; { for checking call sequence validity } - - { Additional fields follow in an actual jpeg_compress_struct or - jpeg_decompress_struct. All three structs must agree on these - initial fields! (This would be a lot cleaner in C++.) } - end; - - -{ Master record for a compression instance } - - jpeg_compress_struct = record - { Fields shared with jpeg_decompress_struct } - err : jpeg_error_mgr_ptr; { Error handler module } - mem : jpeg_memory_mgr_ptr; { Memory manager module } - progress : jpeg_progress_mgr_ptr; { Progress monitor, or NIL if none } - client_data : voidp; { Available for use by application } - is_decompressor : boolean; { so common code can tell which is which } - global_state : int; { for checking call sequence validity } - - { Destination for compressed data } - dest : jpeg_destination_mgr_ptr; - - { Description of source image --- these fields must be filled in by - outer application before starting compression. in_color_space must - be correct before you can even call jpeg_set_defaults(). } - - - image_width : JDIMENSION; { input image width } - image_height : JDIMENSION; { input image height } - input_components : int; { # of color components in input image } - in_color_space : J_COLOR_SPACE; { colorspace of input image } - - input_gamma : double; { image gamma of input image } - - { Compression parameters --- these fields must be set before calling - jpeg_start_compress(). We recommend calling jpeg_set_defaults() to - initialize everything to reasonable defaults, then changing anything - the application specifically wants to change. That way you won't get - burnt when new parameters are added. Also note that there are several - helper routines to simplify changing parameters. } - - data_precision : int; { bits of precision in image data } - - num_components : int; { # of color components in JPEG image } - jpeg_color_space : J_COLOR_SPACE; { colorspace of JPEG image } - - comp_info : jpeg_component_info_list_ptr; - { comp_info^[i] describes component that appears i'th in SOF } - - quant_tbl_ptrs: Array[0..NUM_QUANT_TBLS-1] of JQUANT_TBL_PTR; - { ptrs to coefficient quantization tables, or NIL if not defined } - - dc_huff_tbl_ptrs : Array[0..NUM_HUFF_TBLS-1] of JHUFF_TBL_PTR; - ac_huff_tbl_ptrs : Array[0..NUM_HUFF_TBLS-1] of JHUFF_TBL_PTR; - { ptrs to Huffman coding tables, or NIL if not defined } - - arith_dc_L : Array[0..NUM_ARITH_TBLS-1] of UINT8; { L values for DC arith-coding tables } - arith_dc_U : Array[0..NUM_ARITH_TBLS-1] of UINT8; { U values for DC arith-coding tables } - arith_ac_K : Array[0..NUM_ARITH_TBLS-1] of UINT8; { Kx values for AC arith-coding tables } - - num_scans : int; { # of entries in scan_info array } - scan_info : jpeg_scan_info_ptr; { script for multi-scan file, or NIL } - { The default value of scan_info is NIL, which causes a single-scan - sequential JPEG file to be emitted. To create a multi-scan file, - set num_scans and scan_info to point to an array of scan definitions. } - - raw_data_in : boolean; { TRUE=caller supplies downsampled data } - arith_code : boolean; { TRUE=arithmetic coding, FALSE=Huffman } - optimize_coding : boolean; { TRUE=optimize entropy encoding parms } - CCIR601_sampling : boolean; { TRUE=first samples are cosited } - smoothing_factor : int; { 1..100, or 0 for no input smoothing } - dct_method : J_DCT_METHOD; { DCT algorithm selector } - - { The restart interval can be specified in absolute MCUs by setting - restart_interval, or in MCU rows by setting restart_in_rows - (in which case the correct restart_interval will be figured - for each scan). } - - restart_interval : uint; { MCUs per restart, or 0 for no restart } - restart_in_rows : int; { if > 0, MCU rows per restart interval } - - { Parameters controlling emission of special markers. } - - write_JFIF_header : boolean; { should a JFIF marker be written? } - JFIF_major_version : UINT8; { What to write for the JFIF version number } - JFIF_minor_version : UINT8; - { These three values are not used by the JPEG code, merely copied } - { into the JFIF APP0 marker. density_unit can be 0 for unknown, } - { 1 for dots/inch, or 2 for dots/cm. Note that the pixel aspect } - { ratio is defined by X_density/Y_density even when density_unit=0. } - density_unit : UINT8; { JFIF code for pixel size units } - X_density : UINT16; { Horizontal pixel density } - Y_density : UINT16; { Vertical pixel density } - write_Adobe_marker : boolean; { should an Adobe marker be written? } - - { State variable: index of next scanline to be written to - jpeg_write_scanlines(). Application may use this to control its - processing loop, e.g., "while (next_scanline < image_height)". } - - next_scanline : JDIMENSION; { 0 .. image_height-1 } - - { Remaining fields are known throughout compressor, but generally - should not be touched by a surrounding application. } - - { These fields are computed during compression startup } - progressive_mode : boolean; { TRUE if scan script uses progressive mode } - max_h_samp_factor : int; { largest h_samp_factor } - max_v_samp_factor : int; { largest v_samp_factor } - - total_iMCU_rows : JDIMENSION; { # of iMCU rows to be input to coef ctlr } - { The coefficient controller receives data in units of MCU rows as defined - for fully interleaved scans (whether the JPEG file is interleaved or not). - There are v_samp_factor * DCTSIZE sample rows of each component in an - "iMCU" (interleaved MCU) row. } - - { These fields are valid during any one scan. - They describe the components and MCUs actually appearing in the scan. } - - comps_in_scan : int; { # of JPEG components in this scan } - cur_comp_info : Array[0..MAX_COMPS_IN_SCAN-1] of jpeg_component_info_ptr; - { cur_comp_info[i]^ describes component that appears i'th in SOS } - - MCUs_per_row : JDIMENSION; { # of MCUs across the image } - MCU_rows_in_scan : JDIMENSION;{ # of MCU rows in the image } - - blocks_in_MCU : int; { # of DCT blocks per MCU } - MCU_membership : Array[0..C_MAX_BLOCKS_IN_MCU-1] of int; - { MCU_membership[i] is index in cur_comp_info of component owning } - { i'th block in an MCU } - - Ss, Se, Ah, Al : int; { progressive JPEG parameters for scan } - - { Links to compression subobjects (methods and private variables of modules) } - master : jpeg_comp_master_ptr; - main : jpeg_c_main_controller_ptr; - prep : jpeg_c_prep_controller_ptr; - coef : jpeg_c_coef_controller_ptr; - marker : jpeg_marker_writer_ptr; - cconvert : jpeg_color_converter_ptr; - downsample : jpeg_downsampler_ptr; - fdct : jpeg_forward_dct_ptr; - entropy : jpeg_entropy_encoder_ptr; - script_space : jpeg_scan_info_ptr; { workspace for jpeg_simple_progression } - script_space_size : int; - end; - - -{ Master record for a decompression instance } - - coef_bits_field = Array[0..DCTSIZE2-1] of int; - coef_bits_ptr = ^coef_bits_field; - coef_bits_ptrfield = Array[0..MAX_COMPS_IN_SCAN-1] of coef_bits_field; - coef_bits_ptrrow = ^coef_bits_ptrfield; - - range_limit_table = array[-(MAXJSAMPLE+1)..4*(MAXJSAMPLE+1) - + CENTERJSAMPLE -1] of JSAMPLE; - range_limit_table_ptr = ^range_limit_table; - - jpeg_decompress_struct = record - { Fields shared with jpeg_compress_struct } - err : jpeg_error_mgr_ptr; { Error handler module } - mem : jpeg_memory_mgr_ptr; { Memory manager module } - progress : jpeg_progress_mgr_ptr; { Progress monitor, or NIL if none } - client_data : voidp; { Available for use by application } - is_decompressor : boolean; { so common code can tell which is which } - global_state : int; { for checking call sequence validity } - - { Source of compressed data } - src : jpeg_source_mgr_ptr; - - { Basic description of image --- filled in by jpeg_read_header(). } - { Application may inspect these values to decide how to process image. } - - image_width : JDIMENSION; { nominal image width (from SOF marker) } - image_height : JDIMENSION; { nominal image height } - num_components : int; { # of color components in JPEG image } - jpeg_color_space : J_COLOR_SPACE; { colorspace of JPEG image } - - { Decompression processing parameters --- these fields must be set before - calling jpeg_start_decompress(). Note that jpeg_read_header() - initializes them to default values. } - - out_color_space : J_COLOR_SPACE; { colorspace for output } - - scale_num, scale_denom : uint ; { fraction by which to scale image } - - output_gamma : double; { image gamma wanted in output } - - buffered_image : boolean; { TRUE=multiple output passes } - raw_data_out : boolean; { TRUE=downsampled data wanted } - - dct_method : J_DCT_METHOD; { IDCT algorithm selector } - do_fancy_upsampling : boolean; { TRUE=apply fancy upsampling } - do_block_smoothing : boolean; { TRUE=apply interblock smoothing } - - quantize_colors : boolean; { TRUE=colormapped output wanted } - { the following are ignored if not quantize_colors: } - dither_mode : J_DITHER_MODE; { type of color dithering to use } - two_pass_quantize : boolean; { TRUE=use two-pass color quantization } - desired_number_of_colors : int; { max # colors to use in created colormap } - { these are significant only in buffered-image mode: } - enable_1pass_quant : boolean; { enable future use of 1-pass quantizer } - enable_external_quant : boolean; { enable future use of external colormap } - enable_2pass_quant : boolean; { enable future use of 2-pass quantizer } - - { Description of actual output image that will be returned to application. - These fields are computed by jpeg_start_decompress(). - You can also use jpeg_calc_output_dimensions() to determine these values - in advance of calling jpeg_start_decompress(). } - - output_width : JDIMENSION; { scaled image width } - output_height: JDIMENSION; { scaled image height } - out_color_components : int; { # of color components in out_color_space } - output_components : int; { # of color components returned } - { output_components is 1 (a colormap index) when quantizing colors; - otherwise it equals out_color_components. } - - rec_outbuf_height : int; { min recommended height of scanline buffer } - { If the buffer passed to jpeg_read_scanlines() is less than this many - rows high, space and time will be wasted due to unnecessary data - copying. Usually rec_outbuf_height will be 1 or 2, at most 4. } - - { When quantizing colors, the output colormap is described by these - fields. The application can supply a colormap by setting colormap - non-NIL before calling jpeg_start_decompress; otherwise a colormap - is created during jpeg_start_decompress or jpeg_start_output. The map - has out_color_components rows and actual_number_of_colors columns. } - - actual_number_of_colors : int; { number of entries in use } - colormap : JSAMPARRAY; { The color map as a 2-D pixel array } - - { State variables: these variables indicate the progress of decompression. - The application may examine these but must not modify them. } - - { Row index of next scanline to be read from jpeg_read_scanlines(). - Application may use this to control its processing loop, e.g., - "while (output_scanline < output_height)". } - - output_scanline : JDIMENSION; { 0 .. output_height-1 } - - { Current input scan number and number of iMCU rows completed in scan. - These indicate the progress of the decompressor input side. } - - input_scan_number : int; { Number of SOS markers seen so far } - input_iMCU_row : JDIMENSION; { Number of iMCU rows completed } - - { The "output scan number" is the notional scan being displayed by the - output side. The decompressor will not allow output scan/row number - to get ahead of input scan/row, but it can fall arbitrarily far behind.} - - output_scan_number : int; { Nominal scan number being displayed } - output_iMCU_row : int; { Number of iMCU rows read } - - { Current progression status. coef_bits[c][i] indicates the precision - with which component c's DCT coefficient i (in zigzag order) is known. - It is -1 when no data has yet been received, otherwise it is the point - transform (shift) value for the most recent scan of the coefficient - (thus, 0 at completion of the progression). - This pointer is NIL when reading a non-progressive file. } - - coef_bits : coef_bits_ptrrow; - { -1 or current Al value for each coef } - - { Internal JPEG parameters --- the application usually need not look at - these fields. Note that the decompressor output side may not use - any parameters that can change between scans. } - - { Quantization and Huffman tables are carried forward across input - datastreams when processing abbreviated JPEG datastreams. } - - quant_tbl_ptrs : Array[0..NUM_QUANT_TBLS-1] of JQUANT_TBL_PTR; - { ptrs to coefficient quantization tables, or NIL if not defined } - - dc_huff_tbl_ptrs : Array[0..NUM_HUFF_TBLS-1] of JHUFF_TBL_PTR; - ac_huff_tbl_ptrs : Array[0..NUM_HUFF_TBLS-1] of JHUFF_TBL_PTR; - { ptrs to Huffman coding tables, or NIL if not defined } - - { These parameters are never carried across datastreams, since they - are given in SOF/SOS markers or defined to be reset by SOI. } - - data_precision : int; { bits of precision in image data } - - comp_info : jpeg_component_info_list_ptr; - { comp_info^[i] describes component that appears i'th in SOF } - - progressive_mode : boolean; { TRUE if SOFn specifies progressive mode } - arith_code : boolean; { TRUE=arithmetic coding, FALSE=Huffman } - - arith_dc_L : Array[0..NUM_ARITH_TBLS-1] of UINT8; { L values for DC arith-coding tables } - arith_dc_U : Array[0..NUM_ARITH_TBLS-1] of UINT8; { U values for DC arith-coding tables } - arith_ac_K : Array[0..NUM_ARITH_TBLS-1] of UINT8; { Kx values for AC arith-coding tables } - - restart_interval : uint; { MCUs per restart interval, or 0 for no restart } - - { These fields record data obtained from optional markers recognized by - the JPEG library. } - - saw_JFIF_marker : boolean; { TRUE iff a JFIF APP0 marker was found } - { Data copied from JFIF marker; only valid if saw_JFIF_marker is TRUE: } - JFIF_major_version : UINT8; { JFIF version number } - JFIF_minor_version : UINT8; - density_unit : UINT8; { JFIF code for pixel size units } - X_density : UINT16; { Horizontal pixel density } - Y_density : UINT16; { Vertical pixel density } - saw_Adobe_marker : boolean; { TRUE iff an Adobe APP14 marker was found } - Adobe_transform : UINT8; { Color transform code from Adobe marker } - - CCIR601_sampling : boolean; { TRUE=first samples are cosited } - - { Aside from the specific data retained from APPn markers known to the - library, the uninterpreted contents of any or all APPn and COM markers - can be saved in a list for examination by the application. } - - marker_list : jpeg_saved_marker_ptr; { Head of list of saved markers } - - { Remaining fields are known throughout decompressor, but generally - should not be touched by a surrounding application. } - - - { These fields are computed during decompression startup } - - max_h_samp_factor : int; { largest h_samp_factor } - max_v_samp_factor : int; { largest v_samp_factor } - - min_DCT_scaled_size : int; { smallest DCT_scaled_size of any component } - - total_iMCU_rows : JDIMENSION; { # of iMCU rows in image } - { The coefficient controller's input and output progress is measured in - units of "iMCU" (interleaved MCU) rows. These are the same as MCU rows - in fully interleaved JPEG scans, but are used whether the scan is - interleaved or not. We define an iMCU row as v_samp_factor DCT block - rows of each component. Therefore, the IDCT output contains - v_samp_factor*DCT_scaled_size sample rows of a component per iMCU row.} - - sample_range_limit : range_limit_table_ptr; { table for fast range-limiting } - - - { These fields are valid during any one scan. - They describe the components and MCUs actually appearing in the scan. - Note that the decompressor output side must not use these fields. } - - comps_in_scan : int; { # of JPEG components in this scan } - cur_comp_info : Array[0..MAX_COMPS_IN_SCAN-1] of jpeg_component_info_ptr; - { cur_comp_info[i]^ describes component that appears i'th in SOS } - - MCUs_per_row : JDIMENSION; { # of MCUs across the image } - MCU_rows_in_scan : JDIMENSION; { # of MCU rows in the image } - - blocks_in_MCU : JDIMENSION; { # of DCT blocks per MCU } - MCU_membership : Array[0..D_MAX_BLOCKS_IN_MCU-1] of int; - { MCU_membership[i] is index in cur_comp_info of component owning } - { i'th block in an MCU } - - Ss, Se, Ah, Al : int; { progressive JPEG parameters for scan } - - { This field is shared between entropy decoder and marker parser. - It is either zero or the code of a JPEG marker that has been - read from the data source, but has not yet been processed. } - - unread_marker : int; - - { Links to decompression subobjects - (methods, private variables of modules) } - - master : jpeg_decomp_master_ptr; - main : jpeg_d_main_controller_ptr; - coef : jpeg_d_coef_controller_ptr; - post : jpeg_d_post_controller_ptr; - inputctl : jpeg_input_controller_ptr; - marker : jpeg_marker_reader_ptr; - entropy : jpeg_entropy_decoder_ptr; - idct : jpeg_inverse_dct_ptr; - upsample : jpeg_upsampler_ptr; - cconvert : jpeg_color_deconverter_ptr; - cquantize : jpeg_color_quantizer_ptr; - end; - -{ Decompression startup: read start of JPEG datastream to see what's there - function jpeg_read_header (cinfo : j_decompress_ptr; - require_image : boolean) : int; - Return value is one of: } -const - JPEG_SUSPENDED = 0; { Suspended due to lack of input data } - JPEG_HEADER_OK = 1; { Found valid image datastream } - JPEG_HEADER_TABLES_ONLY = 2; { Found valid table-specs-only datastream } -{ If you pass require_image = TRUE (normal case), you need not check for - a TABLES_ONLY return code; an abbreviated file will cause an error exit. - JPEG_SUSPENDED is only possible if you use a data source module that can - give a suspension return (the stdio source module doesn't). } - - -{ function jpeg_consume_input (cinfo : j_decompress_ptr) : int; - Return value is one of: } - - JPEG_REACHED_SOS = 1; { Reached start of new scan } - JPEG_REACHED_EOI = 2; { Reached end of image } - JPEG_ROW_COMPLETED = 3; { Completed one iMCU row } - JPEG_SCAN_COMPLETED = 4; { Completed last iMCU row of a scan } - - - - -implementation - -end. +unit imjpeglib; + +{ This file defines the application interface for the JPEG library. + Most applications using the library need only include this file, + and perhaps jerror.h if they want to know the exact error codes. } + +{ Source:jpeglib.h+jpegint.h; Copyright (C) 1991-1998, Thomas G. Lane. } + + +interface + +{$I imjconfig.inc} + +{ First we include the configuration files that record how this + installation of the JPEG library is set up. jconfig.h can be + generated automatically for many systems. jmorecfg.h contains + manual configuration options that most people need not worry about. } + +uses + imjdeferr, + imjmorecfg; { seldom changed options } + +{ Version ID for the JPEG library. + Might be useful for tests like "#if JPEG_LIB_VERSION >= 60". } + + +Const + JPEG_LIB_VERSION = 62; { Version 6b } + + +{ These marker codes are exported since applications and data source modules + are likely to want to use them. } + +const + JPEG_RST0 = $D0; { RST0 marker code } + JPEG_EOI = $D9; { EOI marker code } + JPEG_APP0 = $E0; { APP0 marker code } + JPEG_COM = $FE; { COM marker code } + + +{ Various constants determining the sizes of things. + All of these are specified by the JPEG standard, so don't change them + if you want to be compatible. } + +const + DCTSIZE = 8; { The basic DCT block is 8x8 samples } + DCTSIZE2 = 64; { DCTSIZE squared; # of elements in a block } + NUM_QUANT_TBLS = 4; { Quantization tables are numbered 0..3 } + NUM_HUFF_TBLS = 4; { Huffman tables are numbered 0..3 } + NUM_ARITH_TBLS = 16; { Arith-coding tables are numbered 0..15 } + MAX_COMPS_IN_SCAN = 4; { JPEG limit on # of components in one scan } + MAX_SAMP_FACTOR = 4; { JPEG limit on sampling factors } +{ Unfortunately, some bozo at Adobe saw no reason to be bound by the standard; + the PostScript DCT filter can emit files with many more than 10 blocks/MCU. + If you happen to run across such a file, you can up D_MAX_BLOCKS_IN_MCU + to handle it. We even let you do this from the jconfig.h file. However, + we strongly discourage changing C_MAX_BLOCKS_IN_MCU; just because Adobe + sometimes emits noncompliant files doesn't mean you should too. } + C_MAX_BLOCKS_IN_MCU = 10; { compressor's limit on blocks per MCU } + D_MAX_BLOCKS_IN_MCU = 10; { decompressor's limit on blocks per MCU } + + +{ Data structures for images (arrays of samples and of DCT coefficients). + On 80x86 machines, the image arrays are too big for near pointers, + but the pointer arrays can fit in near memory. } + +type +{ for typecasting } + JSAMPLE_PTR = ^JSAMPLE; + JSAMPROW_PTR = ^JSAMPROW; + JBLOCKROW_PTR = ^JBLOCKROW; + + 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. } + + jTRow = 0..(MaxInt div SIZEOF(JSAMPROW))-1; + JSAMPROW_ARRAY = Array[jTRow] of JSAMPROW; + JSAMPARRAY = ^JSAMPROW_ARRAY; { ptr to some rows (a 2-D sample array) } + + jTArray = 0..(MaxInt div SIZEOF(JSAMPARRAY))-1; + JSAMP_ARRAY = Array[jTArray] of JSAMPARRAY; + JSAMPIMAGE = ^JSAMP_ARRAY; { a 3-D sample array: top index is color } + + JBLOCK = Array[0..DCTSIZE2-1] of JCOEF; { one block of coefficients } + JBLOCK_PTR = ^JBLOCK; + + jTBlockRow = 0..(MaxInt div SIZEOF(JBLOCK))-1; + JBLOCK_ROWS = Array[jTBlockRow] of JBLOCK; + JBLOCKROW = ^JBLOCK_ROWS; {far} { pointer to one row of coefficient blocks } + + + jTBlockArray = 0..(MaxInt div SIZEOF(JBLOCKROW))-1; + JBLOCK_ARRAY = Array[jTBlockArray] of JBLOCKROW; + JBLOCKARRAY = ^JBLOCK_ARRAY; { a 2-D array of coefficient blocks } + + jTBlockImage = 0..(MaxInt div SIZEOF(JBLOCKARRAY))-1; + JBLOCK_IMAGE = Array[jTBlockImage] of JBLOCKARRAY; + JBLOCKIMAGE = ^JBLOCK_IMAGE; { a 3-D array of coefficient blocks } + + jTCoef = 0..(MaxInt div SIZEOF(JCOEF))-1; + JCOEF_ROW = Array[jTCoef] of JCOEF; + JCOEFPTR = ^JCOEF_ROW; {far} { useful in a couple of places } + + +type + jTByte = 0..(MaxInt div SIZEOF(byte))-1; + JByteArray = Array[jTByte] of byte; + JBytePtr = ^JByteArray; +type + byteptr = ^byte; + +{ Types for JPEG compression parameters and working tables. } + + +{ DCT coefficient quantization tables. } + +type + JQUANT_TBL_PTR = ^JQUANT_TBL; + JQUANT_TBL = record + { This array gives the coefficient quantizers in natural array order + (not the zigzag order in which they are stored in a JPEG DQT marker). + CAUTION: IJG versions prior to v6a kept this array in zigzag order. } + quantval : Array[0..DCTSIZE2-1] of UINT16; + { quantization step for each coefficient } + { This field is used only during compression. It's initialized FALSE when + the table is created, and set TRUE when it's been output to the file. + You could suppress output of a table by setting this to TRUE. + (See jpeg_suppress_tables for an example.) } + sent_table : boolean; { TRUE when table has been output } + end; + JQUANT_TBL_FIELD = Array[0..(MaxInt div SizeOf(JQUANT_TBL))-1] of JQUANT_TBL; + +{ Huffman coding tables. } + +type + JHUFF_TBL_PTR = ^JHUFF_TBL; + JHUFF_TBL = record + { These two fields directly represent the contents of a JPEG DHT marker } + bits : Array[0..17-1] of UINT8; { bits[k] = # of symbols with codes of } + { length k bits; bits[0] is unused } + huffval : Array[0..256-1] of UINT8; + { The symbols, in order of incr code length } + { This field is used only during compression. It's initialized FALSE when + the table is created, and set TRUE when it's been output to the file. + You could suppress output of a table by setting this to TRUE. + (See jpeg_suppress_tables for an example.) } + sent_table : boolean; { TRUE when table has been output } + end; + JHUFF_TBL_FIELD = Array[0..(MaxInt div SizeOf(JHUFF_TBL))-1] of JHUFF_TBL; + +{ Declarations for both compression & decompression } + +type + J_BUF_MODE = ( { Operating modes for buffer controllers } + JBUF_PASS_THRU, { Plain stripwise operation } + { Remaining modes require a full-image buffer to have been created } + JBUF_SAVE_SOURCE, { Run source subobject only, save output } + JBUF_CRANK_DEST, { Run dest subobject only, using saved data } + JBUF_SAVE_AND_PASS { Run both subobjects, save output } + ); + +{ Values of global_state field (jdapi.c has some dependencies on ordering!) } +const + CSTATE_START = 100; { after create_compress } + CSTATE_SCANNING = 101; { start_compress done, write_scanlines OK } + CSTATE_RAW_OK = 102; { start_compress done, write_raw_data OK } + CSTATE_WRCOEFS = 103; { jpeg_write_coefficients done } + DSTATE_START = 200; { after create_decompress } + DSTATE_INHEADER = 201; { reading header markers, no SOS yet } + DSTATE_READY = 202; { found SOS, ready for start_decompress } + DSTATE_PRELOAD = 203; { reading multiscan file in start_decompress} + DSTATE_PRESCAN = 204; { performing dummy pass for 2-pass quant } + DSTATE_SCANNING = 205; { start_decompress done, read_scanlines OK } + DSTATE_RAW_OK = 206; { start_decompress done, read_raw_data OK } + DSTATE_BUFIMAGE = 207; { expecting jpeg_start_output } + DSTATE_BUFPOST = 208; { looking for SOS/EOI in jpeg_finish_output } + DSTATE_RDCOEFS = 209; { reading file in jpeg_read_coefficients } + DSTATE_STOPPING = 210; { looking for EOI in jpeg_finish_decompress } + + + +{ Basic info about one component (color channel). } + +type + jpeg_component_info_ptr = ^jpeg_component_info; + jpeg_component_info = record + { These values are fixed over the whole image. } + { For compression, they must be supplied by parameter setup; } + { for decompression, they are read from the SOF marker. } + component_id : int; { identifier for this component (0..255) } + component_index : int; { its index in SOF or cinfo^.comp_info[] } + h_samp_factor : int; { horizontal sampling factor (1..4) } + v_samp_factor : int; { vertical sampling factor (1..4) } + quant_tbl_no : int; { quantization table selector (0..3) } + { These values may vary between scans. } + { For compression, they must be supplied by parameter setup; } + { for decompression, they are read from the SOS marker. } + { The decompressor output side may not use these variables. } + dc_tbl_no : int; { DC entropy table selector (0..3) } + ac_tbl_no : int; { AC entropy table selector (0..3) } + + { Remaining fields should be treated as private by applications. } + + { These values are computed during compression or decompression startup: } + { Component's size in DCT blocks. + Any dummy blocks added to complete an MCU are not counted; therefore + these values do not depend on whether a scan is interleaved or not. } + width_in_blocks : JDIMENSION; + height_in_blocks : JDIMENSION; + { Size of a DCT block in samples. Always DCTSIZE for compression. + For decompression this is the size of the output from one DCT block, + reflecting any scaling we choose to apply during the IDCT step. + Values of 1,2,4,8 are likely to be supported. Note that different + components may receive different IDCT scalings. } + + DCT_scaled_size : int; + { The downsampled dimensions are the component's actual, unpadded number + of samples at the main buffer (preprocessing/compression interface), thus + downsampled_width = ceil(image_width * Hi/Hmax) + and similarly for height. For decompression, IDCT scaling is included, so + downsampled_width = ceil(image_width * Hi/Hmax * DCT_scaled_size/DCTSIZE)} + + downsampled_width : JDIMENSION; { actual width in samples } + downsampled_height : JDIMENSION; { actual height in samples } + { This flag is used only for decompression. In cases where some of the + components will be ignored (eg grayscale output from YCbCr image), + we can skip most computations for the unused components. } + + component_needed : boolean; { do we need the value of this component? } + + { These values are computed before starting a scan of the component. } + { The decompressor output side may not use these variables. } + MCU_width : int; { number of blocks per MCU, horizontally } + MCU_height : int; { number of blocks per MCU, vertically } + MCU_blocks : int; { MCU_width * MCU_height } + MCU_sample_width : int; { MCU width in samples, MCU_width*DCT_scaled_size } + last_col_width : int; { # of non-dummy blocks across in last MCU } + last_row_height : int; { # of non-dummy blocks down in last MCU } + + { Saved quantization table for component; NIL if none yet saved. + See jdinput.c comments about the need for this information. + This field is currently used only for decompression. } + + quant_table : JQUANT_TBL_PTR; + + { Private per-component storage for DCT or IDCT subsystem. } + dct_table : pointer; + end; { record jpeg_component_info } + + jTCinfo = 0..(MaxInt div SizeOf(jpeg_component_info))-1; + jpeg_component_info_array = array[jTCinfo] of jpeg_component_info; + jpeg_component_info_list_ptr = ^jpeg_component_info_array; + + +{ The script for encoding a multiple-scan file is an array of these: } + +type + jpeg_scan_info_ptr = ^jpeg_scan_info; + jpeg_scan_info = record + comps_in_scan : int; { number of components encoded in this scan } + component_index : Array[0..MAX_COMPS_IN_SCAN-1] of int; + { their SOF/comp_info[] indexes } + Ss, Se : int; { progressive JPEG spectral selection parms } + Ah, Al : int; { progressive JPEG successive approx. parms } + end; + +{ The decompressor can save APPn and COM markers in a list of these: } + +type + jpeg_saved_marker_ptr = ^jpeg_marker_struct; + jpeg_marker_struct = record + next : jpeg_saved_marker_ptr; { next in list, or NULL } + marker : UINT8; { marker code: JPEG_COM, or JPEG_APP0+n } + original_length : uint; { # bytes of data in the file } + data_length : uint; { # bytes of data saved at data[] } + data : JOCTET_FIELD_PTR; { the data contained in the marker } + { the marker length word is not counted in data_length or original_length } + end; + +{ Known color spaces. } + +type + J_COLOR_SPACE = ( + JCS_UNKNOWN, { error/unspecified } + JCS_GRAYSCALE, { monochrome } + JCS_RGB, { red/green/blue } + JCS_YCbCr, { Y/Cb/Cr (also known as YUV) } + JCS_CMYK, { C/M/Y/K } + JCS_YCCK { Y/Cb/Cr/K } + ); + +{ DCT/IDCT algorithm options. } + +type + J_DCT_METHOD = ( + JDCT_ISLOW, { slow but accurate integer algorithm } + JDCT_IFAST, { faster, less accurate integer method } + JDCT_FLOAT { floating-point: accurate, fast on fast HW } + ); + +const + JDCT_DEFAULT = JDCT_ISLOW; + JDCT_FASTEST = JDCT_IFAST; + +{ Dithering options for decompression. } + +type + J_DITHER_MODE = ( + JDITHER_NONE, { no dithering } + JDITHER_ORDERED, { simple ordered dither } + JDITHER_FS { Floyd-Steinberg error diffusion dither } + ); + + +const + JPOOL_PERMANENT = 0; { lasts until master record is destroyed } + JPOOL_IMAGE = 1; { lasts until done with image/datastream } + JPOOL_NUMPOOLS = 2; + + +{ "Object" declarations for JPEG modules that may be supplied or called + directly by the surrounding application. + As with all objects in the JPEG library, these structs only define the + publicly visible methods and state variables of a module. Additional + private fields may exist after the public ones. } + + +{ Error handler object } + +const + JMSG_LENGTH_MAX = 200; { recommended size of format_message buffer } + JMSG_STR_PARM_MAX = 80; + +const + TEMP_NAME_LENGTH = 64; { max length of a temporary file's name } +type + TEMP_STRING = string[TEMP_NAME_LENGTH]; + +{$ifdef USE_MSDOS_MEMMGR} { DOS-specific junk } +type + XMSH = ushort; { type of extended-memory handles } + EMSH = ushort; { type of expanded-memory handles } + + handle_union = record + case byte of + 0:(file_handle : short); { DOS file handle if it's a temp file } + 1:(xms_handle : XMSH); { handle if it's a chunk of XMS } + 2:(ems_handle : EMSH); { handle if it's a chunk of EMS } + end; +{$endif} { USE_MSDOS_MEMMGR } + +type + jpeg_error_mgr_ptr = ^jpeg_error_mgr; + jpeg_memory_mgr_ptr = ^jpeg_memory_mgr; + jpeg_progress_mgr_ptr = ^jpeg_progress_mgr; + + +{$ifdef common} +{ Common fields between JPEG compression and decompression master structs. } + err : jpeg_error_mgr_ptr; { Error handler module } + mem : jpeg_memory_mgr_ptr; { Memory manager module } + progress : jpeg_progress_mgr_ptr; { Progress monitor, or NIL if none } + client_data : voidp; { Available for use by application } + is_decompressor : boolean; { so common code can tell which is which } + global_state : int; { for checking call sequence validity } +{$endif} + + j_common_ptr = ^jpeg_common_struct; + j_compress_ptr = ^jpeg_compress_struct; + j_decompress_ptr = ^jpeg_decompress_struct; + + {$ifdef AM_MEMORY_MANAGER} { only jmemmgr.c defines these } + +{ 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. } + + + backing_store_ptr = ^backing_store_info; + backing_store_info = record + { Methods for reading/writing/closing this backing-store object } + read_backing_store : procedure (cinfo : j_common_ptr; + info : backing_store_ptr; + buffer_address : pointer; {far} + file_offset : long; + byte_count : long); + write_backing_store : procedure (cinfo : j_common_ptr; + info : backing_store_ptr; + buffer_address : pointer; {far} + file_offset : long; + byte_count : long); + + close_backing_store : procedure (cinfo : j_common_ptr; + info : backing_store_ptr); + + { Private fields for system-dependent backing-store management } + {$ifdef USE_MSDOS_MEMMGR} + { For the MS-DOS manager (jmemdos.c), we need: } + handle : handle_union; { reference to backing-store storage object } + temp_name : TEMP_STRING; { name if it's a file } + {$else} + { For a typical implementation with temp files, we need: } + temp_file : file; { stdio reference to temp file } + temp_name : TEMP_STRING; { name of temp file } + {$endif} + end; + + +{ The control blocks for virtual arrays. + Note that these blocks are allocated in the "small" pool area. + System-dependent info for the associated backing store (if any) is hidden + inside the backing_store_info struct. } + + jvirt_sarray_ptr = ^jvirt_sarray_control; + jvirt_sarray_control = record + mem_buffer : JSAMPARRAY; { => the in-memory buffer } + rows_in_array : JDIMENSION; { total virtual array height } + samplesperrow : JDIMENSION; { width of array (and of memory buffer) } + maxaccess : JDIMENSION; { max rows accessed by access_virt_sarray } + rows_in_mem : JDIMENSION; { height of memory buffer } + rowsperchunk : JDIMENSION; { allocation chunk size in mem_buffer } + cur_start_row : JDIMENSION; { first logical row # in the buffer } + first_undef_row : JDIMENSION; { row # of first uninitialized row } + pre_zero : boolean; { pre-zero mode requested? } + dirty : boolean; { do current buffer contents need written? } + b_s_open : boolean; { is backing-store data valid? } + next : jvirt_sarray_ptr; { link to next virtual sarray control block } + b_s_info : backing_store_info; { System-dependent control info } + end; + + jvirt_barray_ptr = ^jvirt_barray_control; + jvirt_barray_control = record + mem_buffer : JBLOCKARRAY; { => the in-memory buffer } + rows_in_array : JDIMENSION; { total virtual array height } + blocksperrow : JDIMENSION; { width of array (and of memory buffer) } + maxaccess : JDIMENSION; { max rows accessed by access_virt_barray } + rows_in_mem : JDIMENSION; { height of memory buffer } + rowsperchunk : JDIMENSION; { allocation chunk size in mem_buffer } + cur_start_row : JDIMENSION; { first logical row # in the buffer } + first_undef_row : JDIMENSION; { row # of first uninitialized row } + pre_zero : boolean; { pre-zero mode requested? } + dirty : boolean; { do current buffer contents need written? } + b_s_open : boolean; { is backing-store data valid? } + next : jvirt_barray_ptr; { link to next virtual barray control block } + b_s_info : backing_store_info; { System-dependent control info } + end; + + {$endif} { AM_MEMORY_MANAGER } + +{ Declarations for compression modules } + +{ Master control module } + jpeg_comp_master_ptr = ^jpeg_comp_master; + jpeg_comp_master = record + prepare_for_pass : procedure(cinfo : j_compress_ptr); + pass_startup : procedure(cinfo : j_compress_ptr); + finish_pass : procedure(cinfo : j_compress_ptr); + + { State variables made visible to other modules } + call_pass_startup : Boolean; { True if pass_startup must be called } + is_last_pass : Boolean; { True during last pass } + end; + +{ Main buffer control (downsampled-data buffer) } + jpeg_c_main_controller_ptr = ^jpeg_c_main_controller; + jpeg_c_main_controller = record + start_pass : procedure(cinfo : j_compress_ptr; pass_mode : J_BUF_MODE); + process_data : procedure(cinfo : j_compress_ptr; + input_buf : JSAMPARRAY; + var in_row_ctr : JDIMENSION; + in_rows_avail : JDIMENSION); + end; + +{ Compression preprocessing (downsampling input buffer control) } + jpeg_c_prep_controller_ptr = ^jpeg_c_prep_controller; + jpeg_c_prep_controller = record + start_pass : procedure(cinfo : j_compress_ptr; pass_mode : J_BUF_MODE); + pre_process_data : procedure(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); + end; + +{ Coefficient buffer control } + jpeg_c_coef_controller_ptr = ^jpeg_c_coef_controller; + jpeg_c_coef_controller = record + start_pass : procedure(cinfo : j_compress_ptr; pass_mode : J_BUF_MODE); + compress_data : function(cinfo : j_compress_ptr; + input_buf : JSAMPIMAGE) : boolean; + end; + +{ Colorspace conversion } + jpeg_color_converter_ptr = ^jpeg_color_converter; + jpeg_color_converter = record + start_pass : procedure(cinfo : j_compress_ptr); + color_convert : procedure(cinfo : j_compress_ptr; + input_buf : JSAMPARRAY; + output_buf : JSAMPIMAGE; + output_row : JDIMENSION; + num_rows : int); + end; + +{ Downsampling } + jpeg_downsampler_ptr = ^jpeg_downsampler; + jpeg_downsampler = record + start_pass : procedure(cinfo : j_compress_ptr); + downsample : procedure(cinfo : j_compress_ptr; + input_buf : JSAMPIMAGE; + in_row_index : JDIMENSION; + output_buf : JSAMPIMAGE; + out_row_group_index: JDIMENSION); + need_context_rows : Boolean; { TRUE if need rows above & below } + end; + +{ Forward DCT (also controls coefficient quantization) } + jpeg_forward_dct_ptr = ^jpeg_forward_dct; + jpeg_forward_dct = record + start_pass : procedure(cinfo : j_compress_ptr); + { perhaps this should be an array??? } + forward_DCT : procedure(cinfo : j_compress_ptr; + compptr : jpeg_component_info_ptr; + sample_data : JSAMPARRAY; + coef_blocks : JBLOCKROW; + start_row : JDIMENSION; + start_col : JDIMENSION; + num_blocks : JDIMENSION); + end; + +{ Entropy encoding } + + jpeg_entropy_encoder_ptr = ^jpeg_entropy_encoder; + jpeg_entropy_encoder = record + start_pass : procedure(cinfo : j_compress_ptr; gather_statistics : boolean); + encode_mcu : function(cinfo : j_compress_ptr; + const MCU_data: array of JBLOCKROW) : boolean; + finish_pass : procedure(cinfo : j_compress_ptr); + end; + +{ Marker writing } + jpeg_marker_writer_ptr = ^jpeg_marker_writer; + jpeg_marker_writer = record + write_file_header : procedure(cinfo : j_compress_ptr); + write_frame_header : procedure(cinfo : j_compress_ptr); + write_scan_header : procedure(cinfo : j_compress_ptr); + write_file_trailer : procedure(cinfo : j_compress_ptr); + write_tables_only : procedure(cinfo : j_compress_ptr); + { These routines are exported to allow insertion of extra markers } + { Probably only COM and APPn markers should be written this way } + write_marker_header : procedure (cinfo : j_compress_ptr; + marker : int; + datalen : uint); + write_marker_byte : procedure (cinfo : j_compress_ptr; val : int); + end; + +{ Declarations for decompression modules } + +{ Master control module } + jpeg_decomp_master_ptr = ^jpeg_decomp_master; + jpeg_decomp_master = record + prepare_for_output_pass : procedure( cinfo : j_decompress_ptr); + finish_output_pass : procedure(cinfo : j_decompress_ptr); + + { State variables made visible to other modules } + is_dummy_pass : Boolean; { True during 1st pass for 2-pass quant } + end; + +{ Input control module } + jpeg_input_controller_ptr = ^jpeg_input_controller; + jpeg_input_controller = record + consume_input : function (cinfo : j_decompress_ptr) : int; + reset_input_controller : procedure(cinfo : j_decompress_ptr); + start_input_pass : procedure(cinfo : j_decompress_ptr); + finish_input_pass : procedure(cinfo : j_decompress_ptr); + + { State variables made visible to other modules } + has_multiple_scans : Boolean; { True if file has multiple scans } + eoi_reached : Boolean; { True when EOI has been consumed } + end; + +{ Main buffer control (downsampled-data buffer) } + + jpeg_d_main_controller_ptr = ^jpeg_d_main_controller; + jpeg_d_main_controller = record + start_pass : procedure(cinfo : j_decompress_ptr; pass_mode : J_BUF_MODE); + process_data : procedure(cinfo : j_decompress_ptr; + output_buf : JSAMPARRAY; + var out_row_ctr : JDIMENSION; + out_rows_avail : JDIMENSION); + end; + +{ Coefficient buffer control } + jvirt_barray_tbl = array[0..MAX_COMPONENTS-1] of jvirt_barray_ptr; + jvirt_barray_tbl_ptr = ^jvirt_barray_tbl; + jpeg_d_coef_controller_ptr = ^jpeg_d_coef_controller; + jpeg_d_coef_controller = record + start_input_pass : procedure(cinfo : j_decompress_ptr); + consume_data : function (cinfo : j_decompress_ptr) : int; + start_output_pass : procedure(cinfo : j_decompress_ptr); + decompress_data : function (cinfo : j_decompress_ptr; + output_buf : JSAMPIMAGE) : int; + { Pointer to array of coefficient virtual arrays, or NIL if none } + coef_arrays : jvirt_barray_tbl_ptr; + end; + +{ Decompression postprocessing (color quantization buffer control) } + jpeg_d_post_controller_ptr = ^jpeg_d_post_controller; + jpeg_d_post_controller = record + start_pass : procedure(cinfo : j_decompress_ptr; + pass_mode : J_BUF_MODE); + post_process_data : procedure(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); + end; + + +{ Routine signature for application-supplied marker processing methods. + Need not pass marker code since it is stored in cinfo^.unread_marker. } + + jpeg_marker_parser_method = function(cinfo : j_decompress_ptr) : boolean; + +{ Marker reading & parsing } + jpeg_marker_reader_ptr = ^jpeg_marker_reader; + jpeg_marker_reader = record + reset_marker_reader : procedure(cinfo : j_decompress_ptr); + { Read markers until SOS or EOI. + Returns same codes as are defined for jpeg_consume_input: + JPEG_SUSPENDED, JPEG_REACHED_SOS, or JPEG_REACHED_EOI. } + + read_markers : function (cinfo : j_decompress_ptr) : int; + { Read a restart marker --- exported for use by entropy decoder only } + read_restart_marker : jpeg_marker_parser_method; + + { State of marker reader --- nominally internal, but applications + supplying COM or APPn handlers might like to know the state. } + + saw_SOI : boolean; { found SOI? } + saw_SOF : boolean; { found SOF? } + next_restart_num : int; { next restart number expected (0-7) } + discarded_bytes : uint; { # of bytes skipped looking for a marker } + end; + +{ Entropy decoding } + jpeg_entropy_decoder_ptr = ^jpeg_entropy_decoder; + jpeg_entropy_decoder = record + start_pass : procedure(cinfo : j_decompress_ptr); + decode_mcu : function(cinfo : j_decompress_ptr; + var MCU_data : array of JBLOCKROW) : boolean; + { This is here to share code between baseline and progressive decoders; } + { other modules probably should not use it } + insufficient_data : BOOLEAN; { set TRUE after emitting warning } + end; + +{ Inverse DCT (also performs dequantization) } + inverse_DCT_method_ptr = procedure(cinfo : j_decompress_ptr; + compptr : jpeg_component_info_ptr; + coef_block : JCOEFPTR; + output_buf : JSAMPARRAY; output_col : JDIMENSION); + + jpeg_inverse_dct_ptr = ^jpeg_inverse_dct; + jpeg_inverse_dct = record + start_pass : procedure(cinfo : j_decompress_ptr); + { It is useful to allow each component to have a separate IDCT method. } + inverse_DCT : Array[0..MAX_COMPONENTS-1] of inverse_DCT_method_ptr; + end; + +{ Upsampling (note that upsampler must also call color converter) } + jpeg_upsampler_ptr = ^jpeg_upsampler; + jpeg_upsampler = record + start_pass : procedure(cinfo : j_decompress_ptr); + upsample : procedure(cinfo : j_decompress_ptr; + input_buf : JSAMPIMAGE; + var in_row_group_ctr : JDIMENSION; { array of } + in_row_groups_avail : JDIMENSION; + output_buf : JSAMPARRAY; + var out_row_ctr : JDIMENSION; + out_rows_avail : JDIMENSION); + + need_context_rows : boolean; { TRUE if need rows above & below } + end; + +{ Colorspace conversion } + jpeg_color_deconverter_ptr = ^jpeg_color_deconverter; + jpeg_color_deconverter = record + start_pass : procedure(cinfo: j_decompress_ptr); + color_convert : procedure(cinfo : j_decompress_ptr; + input_buf : JSAMPIMAGE; + input_row : JDIMENSION; + output_buf : JSAMPARRAY; + num_rows : int); + end; + +{ Color quantization or color precision reduction } + jpeg_color_quantizer_ptr = ^jpeg_color_quantizer; + jpeg_color_quantizer = record + start_pass : procedure(cinfo : j_decompress_ptr; is_pre_scan : boolean); + color_quantize : procedure(cinfo : j_decompress_ptr; + input_buf : JSAMPARRAY; + output_buf : JSAMPARRAY; + num_rows : int); + + finish_pass : procedure(cinfo : j_decompress_ptr); + new_color_map : procedure(cinfo : j_decompress_ptr); + end; + + {int8array = Array[0..8-1] of int;} + int8array = Array[0..8-1] of longint; { for TP FormatStr } + + jpeg_error_mgr = record + { Error exit handler: does not return to caller } + error_exit : procedure (cinfo : j_common_ptr); + { Conditionally emit a trace or warning message } + emit_message : procedure (cinfo : j_common_ptr; msg_level : int); + { Routine that actually outputs a trace or error message } + output_message : procedure (cinfo : j_common_ptr); + { Format a message string for the most recent JPEG error or message } + format_message : procedure (cinfo : j_common_ptr; var buffer : string); + + { Reset error state variables at start of a new image } + reset_error_mgr : procedure (cinfo : j_common_ptr); + + { The message ID code and any parameters are saved here. + A message can have one string parameter or up to 8 int parameters. } + + msg_code : int; + + msg_parm : record + case byte of + 0:(i : int8array); + 1:(s : string[JMSG_STR_PARM_MAX]); + end; + + { Standard state variables for error facility } + + trace_level : int; { max msg_level that will be displayed } + + { For recoverable corrupt-data errors, we emit a warning message, + but keep going unless emit_message chooses to abort. emit_message + should count warnings in num_warnings. The surrounding application + can check for bad data by seeing if num_warnings is nonzero at the + end of processing. } + + num_warnings : long; { number of corrupt-data warnings } + + { These fields point to the table(s) of error message strings. + An application can change the table pointer to switch to a different + message list (typically, to change the language in which errors are + reported). Some applications may wish to add additional error codes + that will be handled by the JPEG library error mechanism; the second + table pointer is used for this purpose. + + First table includes all errors generated by JPEG library itself. + Error code 0 is reserved for a "no such error string" message. } + + {const char * const * jpeg_message_table; } + jpeg_message_table : ^msg_table; { Library errors } + + last_jpeg_message : J_MESSAGE_CODE; + { Table contains strings 0..last_jpeg_message } + { Second table can be added by application (see cjpeg/djpeg for example). + It contains strings numbered first_addon_message..last_addon_message. } + + {const char * const * addon_message_table; } + addon_message_table : ^msg_table; { Non-library errors } + + first_addon_message : J_MESSAGE_CODE; { code for first string in addon table } + last_addon_message : J_MESSAGE_CODE; { code for last string in addon table } + end; + + +{ Progress monitor object } + + jpeg_progress_mgr = record + progress_monitor : procedure(cinfo : j_common_ptr); + + pass_counter : long; { work units completed in this pass } + pass_limit : long; { total number of work units in this pass } + completed_passes : int; { passes completed so far } + total_passes : int; { total number of passes expected } + end; + + +{ Data destination object for compression } + jpeg_destination_mgr_ptr = ^jpeg_destination_mgr; + jpeg_destination_mgr = record + next_output_byte : JOCTETptr; { => next byte to write in buffer } + free_in_buffer : size_t; { # of byte spaces remaining in buffer } + + init_destination : procedure (cinfo : j_compress_ptr); + empty_output_buffer : function (cinfo : j_compress_ptr) : boolean; + term_destination : procedure (cinfo : j_compress_ptr); + end; + + +{ Data source object for decompression } + + jpeg_source_mgr_ptr = ^jpeg_source_mgr; + jpeg_source_mgr = record + {const JOCTET * next_input_byte;} + next_input_byte : JOCTETptr; { => next byte to read from buffer } + bytes_in_buffer : size_t; { # of bytes remaining in buffer } + + init_source : procedure (cinfo : j_decompress_ptr); + fill_input_buffer : function (cinfo : j_decompress_ptr) : boolean; + skip_input_data : procedure (cinfo : j_decompress_ptr; num_bytes : long); + resync_to_restart : function (cinfo : j_decompress_ptr; + desired : int) : boolean; + term_source : procedure (cinfo : j_decompress_ptr); + end; + + +{ Memory manager object. + Allocates "small" objects (a few K total), "large" objects (tens of K), + and "really big" objects (virtual arrays with backing store if needed). + The memory manager does not allow individual objects to be freed; rather, + each created object is assigned to a pool, and whole pools can be freed + at once. This is faster and more convenient than remembering exactly what + to free, especially where malloc()/free() are not too speedy. + NB: alloc routines never return NIL. They exit to error_exit if not + successful. } + + + jpeg_memory_mgr = record + { Method pointers } + alloc_small : function (cinfo : j_common_ptr; pool_id : int; + sizeofobject : size_t) : pointer; + alloc_large : function (cinfo : j_common_ptr; pool_id : int; + sizeofobject : size_t) : pointer; {far} + alloc_sarray : function (cinfo : j_common_ptr; pool_id : int; + samplesperrow : JDIMENSION; + numrows : JDIMENSION) : JSAMPARRAY; + + alloc_barray : function (cinfo : j_common_ptr; pool_id : int; + blocksperrow : JDIMENSION; + numrows : JDIMENSION) : JBLOCKARRAY; + + request_virt_sarray : function(cinfo : j_common_ptr; + pool_id : int; + pre_zero : boolean; + samplesperrow : JDIMENSION; + numrows : JDIMENSION; + maxaccess : JDIMENSION) : jvirt_sarray_ptr; + + request_virt_barray : function(cinfo : j_common_ptr; + pool_id : int; + pre_zero : boolean; + blocksperrow : JDIMENSION; + numrows : JDIMENSION; + maxaccess : JDIMENSION) : jvirt_barray_ptr; + + realize_virt_arrays : procedure (cinfo : j_common_ptr); + + access_virt_sarray : function (cinfo : j_common_ptr; + ptr : jvirt_sarray_ptr; + start_row : JDIMENSION; + num_rows : JDIMENSION; + writable : boolean) : JSAMPARRAY; + + access_virt_barray : function (cinfo : j_common_ptr; + ptr : jvirt_barray_ptr; + start_row : JDIMENSION; + num_rows : JDIMENSION; + writable : boolean) : JBLOCKARRAY; + + free_pool : procedure (cinfo : j_common_ptr; pool_id : int); + self_destruct : procedure (cinfo : j_common_ptr); + + { Limit on memory allocation for this JPEG object. (Note that this is + merely advisory, not a guaranteed maximum; it only affects the space + used for virtual-array buffers.) May be changed by outer application + after creating the JPEG object. } + max_memory_to_use : long; + + { Maximum allocation request accepted by alloc_large. } + max_alloc_chunk : long; + end; + +{ Routines that are to be used by both halves of the library are declared + to receive a pointer to this structure. There are no actual instances of + jpeg_common_struct, only of jpeg_compress_struct and jpeg_decompress_struct.} + jpeg_common_struct = record + { Fields common to both master struct types } + err : jpeg_error_mgr_ptr; { Error handler module } + mem : jpeg_memory_mgr_ptr; { Memory manager module } + progress : jpeg_progress_mgr_ptr; { Progress monitor, or NIL if none } + client_data : voidp; { Available for use by application } + is_decompressor : boolean; { so common code can tell which is which } + global_state : int; { for checking call sequence validity } + + { Additional fields follow in an actual jpeg_compress_struct or + jpeg_decompress_struct. All three structs must agree on these + initial fields! (This would be a lot cleaner in C++.) } + end; + + +{ Master record for a compression instance } + + jpeg_compress_struct = record + { Fields shared with jpeg_decompress_struct } + err : jpeg_error_mgr_ptr; { Error handler module } + mem : jpeg_memory_mgr_ptr; { Memory manager module } + progress : jpeg_progress_mgr_ptr; { Progress monitor, or NIL if none } + client_data : voidp; { Available for use by application } + is_decompressor : boolean; { so common code can tell which is which } + global_state : int; { for checking call sequence validity } + + { Destination for compressed data } + dest : jpeg_destination_mgr_ptr; + + { Description of source image --- these fields must be filled in by + outer application before starting compression. in_color_space must + be correct before you can even call jpeg_set_defaults(). } + + + image_width : JDIMENSION; { input image width } + image_height : JDIMENSION; { input image height } + input_components : int; { # of color components in input image } + in_color_space : J_COLOR_SPACE; { colorspace of input image } + + input_gamma : double; { image gamma of input image } + + { Compression parameters --- these fields must be set before calling + jpeg_start_compress(). We recommend calling jpeg_set_defaults() to + initialize everything to reasonable defaults, then changing anything + the application specifically wants to change. That way you won't get + burnt when new parameters are added. Also note that there are several + helper routines to simplify changing parameters. } + + data_precision : int; { bits of precision in image data } + + num_components : int; { # of color components in JPEG image } + jpeg_color_space : J_COLOR_SPACE; { colorspace of JPEG image } + + comp_info : jpeg_component_info_list_ptr; + { comp_info^[i] describes component that appears i'th in SOF } + + quant_tbl_ptrs: Array[0..NUM_QUANT_TBLS-1] of JQUANT_TBL_PTR; + { ptrs to coefficient quantization tables, or NIL if not defined } + + dc_huff_tbl_ptrs : Array[0..NUM_HUFF_TBLS-1] of JHUFF_TBL_PTR; + ac_huff_tbl_ptrs : Array[0..NUM_HUFF_TBLS-1] of JHUFF_TBL_PTR; + { ptrs to Huffman coding tables, or NIL if not defined } + + arith_dc_L : Array[0..NUM_ARITH_TBLS-1] of UINT8; { L values for DC arith-coding tables } + arith_dc_U : Array[0..NUM_ARITH_TBLS-1] of UINT8; { U values for DC arith-coding tables } + arith_ac_K : Array[0..NUM_ARITH_TBLS-1] of UINT8; { Kx values for AC arith-coding tables } + + num_scans : int; { # of entries in scan_info array } + scan_info : jpeg_scan_info_ptr; { script for multi-scan file, or NIL } + { The default value of scan_info is NIL, which causes a single-scan + sequential JPEG file to be emitted. To create a multi-scan file, + set num_scans and scan_info to point to an array of scan definitions. } + + raw_data_in : boolean; { TRUE=caller supplies downsampled data } + arith_code : boolean; { TRUE=arithmetic coding, FALSE=Huffman } + optimize_coding : boolean; { TRUE=optimize entropy encoding parms } + CCIR601_sampling : boolean; { TRUE=first samples are cosited } + smoothing_factor : int; { 1..100, or 0 for no input smoothing } + dct_method : J_DCT_METHOD; { DCT algorithm selector } + + { The restart interval can be specified in absolute MCUs by setting + restart_interval, or in MCU rows by setting restart_in_rows + (in which case the correct restart_interval will be figured + for each scan). } + + restart_interval : uint; { MCUs per restart, or 0 for no restart } + restart_in_rows : int; { if > 0, MCU rows per restart interval } + + { Parameters controlling emission of special markers. } + + write_JFIF_header : boolean; { should a JFIF marker be written? } + JFIF_major_version : UINT8; { What to write for the JFIF version number } + JFIF_minor_version : UINT8; + { These three values are not used by the JPEG code, merely copied } + { into the JFIF APP0 marker. density_unit can be 0 for unknown, } + { 1 for dots/inch, or 2 for dots/cm. Note that the pixel aspect } + { ratio is defined by X_density/Y_density even when density_unit=0. } + density_unit : UINT8; { JFIF code for pixel size units } + X_density : UINT16; { Horizontal pixel density } + Y_density : UINT16; { Vertical pixel density } + write_Adobe_marker : boolean; { should an Adobe marker be written? } + + { State variable: index of next scanline to be written to + jpeg_write_scanlines(). Application may use this to control its + processing loop, e.g., "while (next_scanline < image_height)". } + + next_scanline : JDIMENSION; { 0 .. image_height-1 } + + { Remaining fields are known throughout compressor, but generally + should not be touched by a surrounding application. } + + { These fields are computed during compression startup } + progressive_mode : boolean; { TRUE if scan script uses progressive mode } + max_h_samp_factor : int; { largest h_samp_factor } + max_v_samp_factor : int; { largest v_samp_factor } + + total_iMCU_rows : JDIMENSION; { # of iMCU rows to be input to coef ctlr } + { The coefficient controller receives data in units of MCU rows as defined + for fully interleaved scans (whether the JPEG file is interleaved or not). + There are v_samp_factor * DCTSIZE sample rows of each component in an + "iMCU" (interleaved MCU) row. } + + { These fields are valid during any one scan. + They describe the components and MCUs actually appearing in the scan. } + + comps_in_scan : int; { # of JPEG components in this scan } + cur_comp_info : Array[0..MAX_COMPS_IN_SCAN-1] of jpeg_component_info_ptr; + { cur_comp_info[i]^ describes component that appears i'th in SOS } + + MCUs_per_row : JDIMENSION; { # of MCUs across the image } + MCU_rows_in_scan : JDIMENSION;{ # of MCU rows in the image } + + blocks_in_MCU : int; { # of DCT blocks per MCU } + MCU_membership : Array[0..C_MAX_BLOCKS_IN_MCU-1] of int; + { MCU_membership[i] is index in cur_comp_info of component owning } + { i'th block in an MCU } + + Ss, Se, Ah, Al : int; { progressive JPEG parameters for scan } + + { Links to compression subobjects (methods and private variables of modules) } + master : jpeg_comp_master_ptr; + main : jpeg_c_main_controller_ptr; + prep : jpeg_c_prep_controller_ptr; + coef : jpeg_c_coef_controller_ptr; + marker : jpeg_marker_writer_ptr; + cconvert : jpeg_color_converter_ptr; + downsample : jpeg_downsampler_ptr; + fdct : jpeg_forward_dct_ptr; + entropy : jpeg_entropy_encoder_ptr; + script_space : jpeg_scan_info_ptr; { workspace for jpeg_simple_progression } + script_space_size : int; + end; + + +{ Master record for a decompression instance } + + coef_bits_field = Array[0..DCTSIZE2-1] of int; + coef_bits_ptr = ^coef_bits_field; + coef_bits_ptrfield = Array[0..MAX_COMPS_IN_SCAN-1] of coef_bits_field; + coef_bits_ptrrow = ^coef_bits_ptrfield; + + range_limit_table = array[-(MAXJSAMPLE+1)..4*(MAXJSAMPLE+1) + + CENTERJSAMPLE -1] of JSAMPLE; + range_limit_table_ptr = ^range_limit_table; + + jpeg_decompress_struct = record + { Fields shared with jpeg_compress_struct } + err : jpeg_error_mgr_ptr; { Error handler module } + mem : jpeg_memory_mgr_ptr; { Memory manager module } + progress : jpeg_progress_mgr_ptr; { Progress monitor, or NIL if none } + client_data : voidp; { Available for use by application } + is_decompressor : boolean; { so common code can tell which is which } + global_state : int; { for checking call sequence validity } + + { Source of compressed data } + src : jpeg_source_mgr_ptr; + + { Basic description of image --- filled in by jpeg_read_header(). } + { Application may inspect these values to decide how to process image. } + + image_width : JDIMENSION; { nominal image width (from SOF marker) } + image_height : JDIMENSION; { nominal image height } + num_components : int; { # of color components in JPEG image } + jpeg_color_space : J_COLOR_SPACE; { colorspace of JPEG image } + + { Decompression processing parameters --- these fields must be set before + calling jpeg_start_decompress(). Note that jpeg_read_header() + initializes them to default values. } + + out_color_space : J_COLOR_SPACE; { colorspace for output } + + scale_num, scale_denom : uint ; { fraction by which to scale image } + + output_gamma : double; { image gamma wanted in output } + + buffered_image : boolean; { TRUE=multiple output passes } + raw_data_out : boolean; { TRUE=downsampled data wanted } + + dct_method : J_DCT_METHOD; { IDCT algorithm selector } + do_fancy_upsampling : boolean; { TRUE=apply fancy upsampling } + do_block_smoothing : boolean; { TRUE=apply interblock smoothing } + + quantize_colors : boolean; { TRUE=colormapped output wanted } + { the following are ignored if not quantize_colors: } + dither_mode : J_DITHER_MODE; { type of color dithering to use } + two_pass_quantize : boolean; { TRUE=use two-pass color quantization } + desired_number_of_colors : int; { max # colors to use in created colormap } + { these are significant only in buffered-image mode: } + enable_1pass_quant : boolean; { enable future use of 1-pass quantizer } + enable_external_quant : boolean; { enable future use of external colormap } + enable_2pass_quant : boolean; { enable future use of 2-pass quantizer } + + { Description of actual output image that will be returned to application. + These fields are computed by jpeg_start_decompress(). + You can also use jpeg_calc_output_dimensions() to determine these values + in advance of calling jpeg_start_decompress(). } + + output_width : JDIMENSION; { scaled image width } + output_height: JDIMENSION; { scaled image height } + out_color_components : int; { # of color components in out_color_space } + output_components : int; { # of color components returned } + { output_components is 1 (a colormap index) when quantizing colors; + otherwise it equals out_color_components. } + + rec_outbuf_height : int; { min recommended height of scanline buffer } + { If the buffer passed to jpeg_read_scanlines() is less than this many + rows high, space and time will be wasted due to unnecessary data + copying. Usually rec_outbuf_height will be 1 or 2, at most 4. } + + { When quantizing colors, the output colormap is described by these + fields. The application can supply a colormap by setting colormap + non-NIL before calling jpeg_start_decompress; otherwise a colormap + is created during jpeg_start_decompress or jpeg_start_output. The map + has out_color_components rows and actual_number_of_colors columns. } + + actual_number_of_colors : int; { number of entries in use } + colormap : JSAMPARRAY; { The color map as a 2-D pixel array } + + { State variables: these variables indicate the progress of decompression. + The application may examine these but must not modify them. } + + { Row index of next scanline to be read from jpeg_read_scanlines(). + Application may use this to control its processing loop, e.g., + "while (output_scanline < output_height)". } + + output_scanline : JDIMENSION; { 0 .. output_height-1 } + + { Current input scan number and number of iMCU rows completed in scan. + These indicate the progress of the decompressor input side. } + + input_scan_number : int; { Number of SOS markers seen so far } + input_iMCU_row : JDIMENSION; { Number of iMCU rows completed } + + { The "output scan number" is the notional scan being displayed by the + output side. The decompressor will not allow output scan/row number + to get ahead of input scan/row, but it can fall arbitrarily far behind.} + + output_scan_number : int; { Nominal scan number being displayed } + output_iMCU_row : int; { Number of iMCU rows read } + + { Current progression status. coef_bits[c][i] indicates the precision + with which component c's DCT coefficient i (in zigzag order) is known. + It is -1 when no data has yet been received, otherwise it is the point + transform (shift) value for the most recent scan of the coefficient + (thus, 0 at completion of the progression). + This pointer is NIL when reading a non-progressive file. } + + coef_bits : coef_bits_ptrrow; + { -1 or current Al value for each coef } + + { Internal JPEG parameters --- the application usually need not look at + these fields. Note that the decompressor output side may not use + any parameters that can change between scans. } + + { Quantization and Huffman tables are carried forward across input + datastreams when processing abbreviated JPEG datastreams. } + + quant_tbl_ptrs : Array[0..NUM_QUANT_TBLS-1] of JQUANT_TBL_PTR; + { ptrs to coefficient quantization tables, or NIL if not defined } + + dc_huff_tbl_ptrs : Array[0..NUM_HUFF_TBLS-1] of JHUFF_TBL_PTR; + ac_huff_tbl_ptrs : Array[0..NUM_HUFF_TBLS-1] of JHUFF_TBL_PTR; + { ptrs to Huffman coding tables, or NIL if not defined } + + { These parameters are never carried across datastreams, since they + are given in SOF/SOS markers or defined to be reset by SOI. } + + data_precision : int; { bits of precision in image data } + + comp_info : jpeg_component_info_list_ptr; + { comp_info^[i] describes component that appears i'th in SOF } + + progressive_mode : boolean; { TRUE if SOFn specifies progressive mode } + arith_code : boolean; { TRUE=arithmetic coding, FALSE=Huffman } + + arith_dc_L : Array[0..NUM_ARITH_TBLS-1] of UINT8; { L values for DC arith-coding tables } + arith_dc_U : Array[0..NUM_ARITH_TBLS-1] of UINT8; { U values for DC arith-coding tables } + arith_ac_K : Array[0..NUM_ARITH_TBLS-1] of UINT8; { Kx values for AC arith-coding tables } + + restart_interval : uint; { MCUs per restart interval, or 0 for no restart } + + { These fields record data obtained from optional markers recognized by + the JPEG library. } + + saw_JFIF_marker : boolean; { TRUE iff a JFIF APP0 marker was found } + { Data copied from JFIF marker; only valid if saw_JFIF_marker is TRUE: } + JFIF_major_version : UINT8; { JFIF version number } + JFIF_minor_version : UINT8; + density_unit : UINT8; { JFIF code for pixel size units } + X_density : UINT16; { Horizontal pixel density } + Y_density : UINT16; { Vertical pixel density } + saw_Adobe_marker : boolean; { TRUE iff an Adobe APP14 marker was found } + Adobe_transform : UINT8; { Color transform code from Adobe marker } + + CCIR601_sampling : boolean; { TRUE=first samples are cosited } + + { Aside from the specific data retained from APPn markers known to the + library, the uninterpreted contents of any or all APPn and COM markers + can be saved in a list for examination by the application. } + + marker_list : jpeg_saved_marker_ptr; { Head of list of saved markers } + + { Remaining fields are known throughout decompressor, but generally + should not be touched by a surrounding application. } + + + { These fields are computed during decompression startup } + + max_h_samp_factor : int; { largest h_samp_factor } + max_v_samp_factor : int; { largest v_samp_factor } + + min_DCT_scaled_size : int; { smallest DCT_scaled_size of any component } + + total_iMCU_rows : JDIMENSION; { # of iMCU rows in image } + { The coefficient controller's input and output progress is measured in + units of "iMCU" (interleaved MCU) rows. These are the same as MCU rows + in fully interleaved JPEG scans, but are used whether the scan is + interleaved or not. We define an iMCU row as v_samp_factor DCT block + rows of each component. Therefore, the IDCT output contains + v_samp_factor*DCT_scaled_size sample rows of a component per iMCU row.} + + sample_range_limit : range_limit_table_ptr; { table for fast range-limiting } + + + { These fields are valid during any one scan. + They describe the components and MCUs actually appearing in the scan. + Note that the decompressor output side must not use these fields. } + + comps_in_scan : int; { # of JPEG components in this scan } + cur_comp_info : Array[0..MAX_COMPS_IN_SCAN-1] of jpeg_component_info_ptr; + { cur_comp_info[i]^ describes component that appears i'th in SOS } + + MCUs_per_row : JDIMENSION; { # of MCUs across the image } + MCU_rows_in_scan : JDIMENSION; { # of MCU rows in the image } + + blocks_in_MCU : JDIMENSION; { # of DCT blocks per MCU } + MCU_membership : Array[0..D_MAX_BLOCKS_IN_MCU-1] of int; + { MCU_membership[i] is index in cur_comp_info of component owning } + { i'th block in an MCU } + + Ss, Se, Ah, Al : int; { progressive JPEG parameters for scan } + + { This field is shared between entropy decoder and marker parser. + It is either zero or the code of a JPEG marker that has been + read from the data source, but has not yet been processed. } + + unread_marker : int; + + { Links to decompression subobjects + (methods, private variables of modules) } + + master : jpeg_decomp_master_ptr; + main : jpeg_d_main_controller_ptr; + coef : jpeg_d_coef_controller_ptr; + post : jpeg_d_post_controller_ptr; + inputctl : jpeg_input_controller_ptr; + marker : jpeg_marker_reader_ptr; + entropy : jpeg_entropy_decoder_ptr; + idct : jpeg_inverse_dct_ptr; + upsample : jpeg_upsampler_ptr; + cconvert : jpeg_color_deconverter_ptr; + cquantize : jpeg_color_quantizer_ptr; + end; + +{ Decompression startup: read start of JPEG datastream to see what's there + function jpeg_read_header (cinfo : j_decompress_ptr; + require_image : boolean) : int; + Return value is one of: } +const + JPEG_SUSPENDED = 0; { Suspended due to lack of input data } + JPEG_HEADER_OK = 1; { Found valid image datastream } + JPEG_HEADER_TABLES_ONLY = 2; { Found valid table-specs-only datastream } +{ If you pass require_image = TRUE (normal case), you need not check for + a TABLES_ONLY return code; an abbreviated file will cause an error exit. + JPEG_SUSPENDED is only possible if you use a data source module that can + give a suspension return (the stdio source module doesn't). } + + +{ function jpeg_consume_input (cinfo : j_decompress_ptr) : int; + Return value is one of: } + + JPEG_REACHED_SOS = 1; { Reached start of new scan } + JPEG_REACHED_EOI = 2; { Reached end of image } + JPEG_ROW_COMPLETED = 3; { Completed one iMCU row } + JPEG_SCAN_COMPLETED = 4; { Completed last iMCU row of a scan } + + + + +implementation + +end. diff --git a/Imaging/JpegLib/imjquant1.pas b/Imaging/JpegLib/imjquant1.pas index c935166..f15afa0 100644 --- a/Imaging/JpegLib/imjquant1.pas +++ b/Imaging/JpegLib/imjquant1.pas @@ -1,1009 +1,1009 @@ -unit imjquant1; - -{ This file contains 1-pass color quantization (color mapping) routines. - These routines provide mapping to a fixed color map using equally spaced - color values. Optional Floyd-Steinberg or ordered dithering is available. } - -{ Original: jquant1.c; Copyright (C) 1991-1996, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjpeglib; - -{GLOBAL} -procedure jinit_1pass_quantizer (cinfo : j_decompress_ptr); - -implementation - -uses - imjmorecfg, - imjdeferr, - imjerror, - imjutils; - -{ The main purpose of 1-pass quantization is to provide a fast, if not very - high quality, colormapped output capability. A 2-pass quantizer usually - gives better visual quality; however, for quantized grayscale output this - quantizer is perfectly adequate. Dithering is highly recommended with this - quantizer, though you can turn it off if you really want to. - - In 1-pass quantization the colormap must be chosen in advance of seeing the - image. We use a map consisting of all combinations of Ncolors[i] color - values for the i'th component. The Ncolors[] values are chosen so that - their product, the total number of colors, is no more than that requested. - (In most cases, the product will be somewhat less.) - - Since the colormap is orthogonal, the representative value for each color - component can be determined without considering the other components; - then these indexes can be combined into a colormap index by a standard - N-dimensional-array-subscript calculation. Most of the arithmetic involved - can be precalculated and stored in the lookup table colorindex[]. - colorindex[i][j] maps pixel value j in component i to the nearest - representative value (grid plane) for that component; this index is - multiplied by the array stride for component i, so that the - index of the colormap entry closest to a given pixel value is just - sum( colorindex[component-number][pixel-component-value] ) - Aside from being fast, this scheme allows for variable spacing between - representative values with no additional lookup cost. - - If gamma correction has been applied in color conversion, it might be wise - to adjust the color grid spacing so that the representative colors are - equidistant in linear space. At this writing, gamma correction is not - implemented by jdcolor, so nothing is done here. } - - -{ Declarations for ordered dithering. - - We use a standard 16x16 ordered dither array. The basic concept of ordered - dithering is described in many references, for instance Dale Schumacher's - chapter II.2 of Graphics Gems II (James Arvo, ed. Academic Press, 1991). - In place of Schumacher's comparisons against a "threshold" value, we add a - "dither" value to the input pixel and then round the result to the nearest - output value. The dither value is equivalent to (0.5 - threshold) times - the distance between output values. For ordered dithering, we assume that - the output colors are equally spaced; if not, results will probably be - worse, since the dither may be too much or too little at a given point. - - The normal calculation would be to form pixel value + dither, range-limit - this to 0..MAXJSAMPLE, and then index into the colorindex table as usual. - We can skip the separate range-limiting step by extending the colorindex - table in both directions. } - - -const - ODITHER_SIZE = 16; { dimension of dither matrix } -{ NB: if ODITHER_SIZE is not a power of 2, ODITHER_MASK uses will break } - ODITHER_CELLS = (ODITHER_SIZE*ODITHER_SIZE); { # cells in matrix } - ODITHER_MASK = (ODITHER_SIZE-1); { mask for wrapping around counters } - -type - ODITHER_vector = Array[0..ODITHER_SIZE-1] of int; - ODITHER_MATRIX = Array[0..ODITHER_SIZE-1] of ODITHER_vector; - {ODITHER_MATRIX_PTR = ^array[0..ODITHER_SIZE-1] of int;} - ODITHER_MATRIX_PTR = ^ODITHER_MATRIX; - -const - base_dither_matrix : Array[0..ODITHER_SIZE-1,0..ODITHER_SIZE-1] of UINT8 - = ( - { Bayer's order-4 dither array. Generated by the code given in - Stephen Hawley's article "Ordered Dithering" in Graphics Gems I. - The values in this array must range from 0 to ODITHER_CELLS-1. } - - ( 0,192, 48,240, 12,204, 60,252, 3,195, 51,243, 15,207, 63,255 ), - ( 128, 64,176,112,140, 76,188,124,131, 67,179,115,143, 79,191,127 ), - ( 32,224, 16,208, 44,236, 28,220, 35,227, 19,211, 47,239, 31,223 ), - ( 160, 96,144, 80,172,108,156, 92,163, 99,147, 83,175,111,159, 95 ), - ( 8,200, 56,248, 4,196, 52,244, 11,203, 59,251, 7,199, 55,247 ), - ( 136, 72,184,120,132, 68,180,116,139, 75,187,123,135, 71,183,119 ), - ( 40,232, 24,216, 36,228, 20,212, 43,235, 27,219, 39,231, 23,215 ), - ( 168,104,152, 88,164,100,148, 84,171,107,155, 91,167,103,151, 87 ), - ( 2,194, 50,242, 14,206, 62,254, 1,193, 49,241, 13,205, 61,253 ), - ( 130, 66,178,114,142, 78,190,126,129, 65,177,113,141, 77,189,125 ), - ( 34,226, 18,210, 46,238, 30,222, 33,225, 17,209, 45,237, 29,221 ), - ( 162, 98,146, 82,174,110,158, 94,161, 97,145, 81,173,109,157, 93 ), - ( 10,202, 58,250, 6,198, 54,246, 9,201, 57,249, 5,197, 53,245 ), - ( 138, 74,186,122,134, 70,182,118,137, 73,185,121,133, 69,181,117 ), - ( 42,234, 26,218, 38,230, 22,214, 41,233, 25,217, 37,229, 21,213 ), - ( 170,106,154, 90,166,102,150, 86,169,105,153, 89,165,101,149, 85 ) - ); - - -{ Declarations for Floyd-Steinberg dithering. - - Errors are accumulated into the array fserrors[], at a resolution of - 1/16th of a pixel count. The error at a given pixel is propagated - to its not-yet-processed neighbors using the standard F-S fractions, - ... (here) 7/16 - 3/16 5/16 1/16 - We work left-to-right on even rows, right-to-left on odd rows. - - We can get away with a single array (holding one row's worth of errors) - by using it to store the current row's errors at pixel columns not yet - processed, but the next row's errors at columns already processed. We - need only a few extra variables to hold the errors immediately around the - current column. (If we are lucky, those variables are in registers, but - even if not, they're probably cheaper to access than array elements are.) - - The fserrors[] array is indexed [component#][position]. - We provide (#columns + 2) entries per component; the extra entry at each - end saves us from special-casing the first and last pixels. - - Note: on a wide image, we might not have enough room in a PC's near data - segment to hold the error array; so it is allocated with alloc_large. } - -{$ifdef BITS_IN_JSAMPLE_IS_8} -type - FSERROR = INT16; { 16 bits should be enough } - LOCFSERROR = int; { use 'int' for calculation temps } -{$else} -type - FSERROR = INT32; { may need more than 16 bits } - LOCFSERROR = INT32; { be sure calculation temps are big enough } -{$endif} - -type - jFSError = 0..(MaxInt div SIZEOF(FSERROR))-1; - FS_ERROR_FIELD = array[jFSError] of FSERROR; - FS_ERROR_FIELD_PTR = ^FS_ERROR_FIELD;{far} - { pointer to error array (in FAR storage!) } - FSERRORPTR = ^FSERROR; - - -{ Private subobject } - -const - MAX_Q_COMPS = 4; { max components I can handle } - -type - my_cquantize_ptr = ^my_cquantizer; - my_cquantizer = record - pub : jpeg_color_quantizer; { public fields } - - { Initially allocated colormap is saved here } - sv_colormap : JSAMPARRAY; { The color map as a 2-D pixel array } - sv_actual : int; { number of entries in use } - - colorindex : JSAMPARRAY; { Precomputed mapping for speed } - { colorindex[i][j] = index of color closest to pixel value j in component i, - premultiplied as described above. Since colormap indexes must fit into - JSAMPLEs, the entries of this array will too. } - - is_padded : boolean; { is the colorindex padded for odither? } - - Ncolors : array[0..MAX_Q_COMPS-1] of int; - { # of values alloced to each component } - - { Variables for ordered dithering } - row_index : int; { cur row's vertical index in dither matrix } - odither : array[0..MAX_Q_COMPS-1] of ODITHER_MATRIX_PTR; - { one dither array per component } - { Variables for Floyd-Steinberg dithering } - fserrors : array[0..MAX_Q_COMPS-1] of FS_ERROR_FIELD_PTR; - { accumulated errors } - on_odd_row : boolean; { flag to remember which row we are on } - end; - - -{ Policy-making subroutines for create_colormap and create_colorindex. - These routines determine the colormap to be used. The rest of the module - only assumes that the colormap is orthogonal. - - * select_ncolors decides how to divvy up the available colors - among the components. - * output_value defines the set of representative values for a component. - * largest_input_value defines the mapping from input values to - representative values for a component. - Note that the latter two routines may impose different policies for - different components, though this is not currently done. } - - - -{LOCAL} -function select_ncolors (cinfo : j_decompress_ptr; - var Ncolors : array of int) : int; -{ Determine allocation of desired colors to components, } -{ and fill in Ncolors[] array to indicate choice. } -{ Return value is total number of colors (product of Ncolors[] values). } -var - nc : int; - max_colors : int; - total_colors, iroot, i, j : int; - changed : boolean; - temp : long; -const - RGB_order:array[0..2] of int = (RGB_GREEN, RGB_RED, RGB_BLUE); -begin - nc := cinfo^.out_color_components; { number of color components } - max_colors := cinfo^.desired_number_of_colors; - - { We can allocate at least the nc'th root of max_colors per component. } - { Compute floor(nc'th root of max_colors). } - iroot := 1; - repeat - Inc(iroot); - temp := iroot; { set temp = iroot ** nc } - for i := 1 to pred(nc) do - temp := temp * iroot; - until (temp > long(max_colors)); { repeat till iroot exceeds root } - Dec(iroot); { now iroot = floor(root) } - - { Must have at least 2 color values per component } - if (iroot < 2) then - ERREXIT1(j_common_ptr(cinfo), JERR_QUANT_FEW_COLORS, int(temp)); - - { Initialize to iroot color values for each component } - total_colors := 1; - for i := 0 to pred(nc) do - begin - Ncolors[i] := iroot; - total_colors := total_colors * iroot; - end; - - { We may be able to increment the count for one or more components without - exceeding max_colors, though we know not all can be incremented. - Sometimes, the first component can be incremented more than once! - (Example: for 16 colors, we start at 2*2*2, go to 3*2*2, then 4*2*2.) - In RGB colorspace, try to increment G first, then R, then B. } - - repeat - changed := FALSE; - for i := 0 to pred(nc) do - begin - if cinfo^.out_color_space = JCS_RGB then - j := RGB_order[i] - else - j := i; - { calculate new total_colors if Ncolors[j] is incremented } - temp := total_colors div Ncolors[j]; - temp := temp * (Ncolors[j]+1); { done in long arith to avoid oflo } - if (temp > long(max_colors)) then - break; { won't fit, done with this pass } - Inc(Ncolors[j]); { OK, apply the increment } - total_colors := int(temp); - changed := TRUE; - end; - until not changed; - - select_ncolors := total_colors; -end; - - -{LOCAL} -function output_value (cinfo : j_decompress_ptr; - ci : int; j : int; maxj : int) : int; -{ Return j'th output value, where j will range from 0 to maxj } -{ The output values must fall in 0..MAXJSAMPLE in increasing order } -begin - { We always provide values 0 and MAXJSAMPLE for each component; - any additional values are equally spaced between these limits. - (Forcing the upper and lower values to the limits ensures that - dithering can't produce a color outside the selected gamut.) } - - output_value := int (( INT32(j) * MAXJSAMPLE + maxj div 2) div maxj); -end; - - -{LOCAL} -function largest_input_value (cinfo : j_decompress_ptr; - ci : int; j : int; maxj : int) : int; -{ Return largest input value that should map to j'th output value } -{ Must have largest(j=0) >= 0, and largest(j=maxj) >= MAXJSAMPLE } -begin - { Breakpoints are halfway between values returned by output_value } - largest_input_value := int (( INT32(2*j + 1) * MAXJSAMPLE + - maxj) div (2*maxj)); -end; - - -{ Create the colormap. } - -{LOCAL} -procedure create_colormap (cinfo : j_decompress_ptr); -var - cquantize : my_cquantize_ptr; - colormap : JSAMPARRAY; { Created colormap } - - total_colors : int; { Number of distinct output colors } - i,j,k, nci, blksize, blkdist, ptr, val : int; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - - { Select number of colors for each component } - total_colors := select_ncolors(cinfo, cquantize^.Ncolors); - - { Report selected color counts } - {$IFDEF DEBUG} - if (cinfo^.out_color_components = 3) then - TRACEMS4(j_common_ptr(cinfo), 1, JTRC_QUANT_3_NCOLORS, - total_colors, cquantize^.Ncolors[0], - cquantize^.Ncolors[1], cquantize^.Ncolors[2]) - else - TRACEMS1(j_common_ptr(cinfo), 1, JTRC_QUANT_NCOLORS, total_colors); - {$ENDIF} - - { Allocate and fill in the colormap. } - { The colors are ordered in the map in standard row-major order, } - { i.e. rightmost (highest-indexed) color changes most rapidly. } - - colormap := cinfo^.mem^.alloc_sarray( - j_common_ptr(cinfo), JPOOL_IMAGE, - JDIMENSION(total_colors), JDIMENSION(cinfo^.out_color_components)); - - { blksize is number of adjacent repeated entries for a component } - { blkdist is distance between groups of identical entries for a component } - blkdist := total_colors; - - for i := 0 to pred(cinfo^.out_color_components) do - begin - { fill in colormap entries for i'th color component } - nci := cquantize^.Ncolors[i]; { # of distinct values for this color } - blksize := blkdist div nci; - for j := 0 to pred(nci) do - begin - { Compute j'th output value (out of nci) for component } - val := output_value(cinfo, i, j, nci-1); - { Fill in all colormap entries that have this value of this component } - ptr := j * blksize; - while (ptr < total_colors) do - begin - { fill in blksize entries beginning at ptr } - for k := 0 to pred(blksize) do - colormap^[i]^[ptr+k] := JSAMPLE(val); - - Inc(ptr, blkdist); - end; - end; - blkdist := blksize; { blksize of this color is blkdist of next } - end; - - { Save the colormap in private storage, - where it will survive color quantization mode changes. } - - cquantize^.sv_colormap := colormap; - cquantize^.sv_actual := total_colors; -end; - -{ Create the color index table. } - -{LOCAL} -procedure create_colorindex (cinfo : j_decompress_ptr); -var - cquantize : my_cquantize_ptr; - indexptr, - help_indexptr : JSAMPROW; { for negative offsets } - i,j,k, nci, blksize, val, pad : int; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - { For ordered dither, we pad the color index tables by MAXJSAMPLE in - each direction (input index values can be -MAXJSAMPLE .. 2*MAXJSAMPLE). - This is not necessary in the other dithering modes. However, we - flag whether it was done in case user changes dithering mode. } - - if (cinfo^.dither_mode = JDITHER_ORDERED) then - begin - pad := MAXJSAMPLE*2; - cquantize^.is_padded := TRUE; - end - else - begin - pad := 0; - cquantize^.is_padded := FALSE; - end; - - cquantize^.colorindex := cinfo^.mem^.alloc_sarray - (j_common_ptr(cinfo), JPOOL_IMAGE, - JDIMENSION(MAXJSAMPLE+1 + pad), - JDIMENSION(cinfo^.out_color_components)); - - { blksize is number of adjacent repeated entries for a component } - blksize := cquantize^.sv_actual; - - for i := 0 to pred(cinfo^.out_color_components) do - begin - { fill in colorindex entries for i'th color component } - nci := cquantize^.Ncolors[i]; { # of distinct values for this color } - blksize := blksize div nci; - - { adjust colorindex pointers to provide padding at negative indexes. } - if (pad <> 0) then - Inc(JSAMPLE_PTR(cquantize^.colorindex^[i]), MAXJSAMPLE); - - { in loop, val = index of current output value, } - { and k = largest j that maps to current val } - indexptr := cquantize^.colorindex^[i]; - val := 0; - k := largest_input_value(cinfo, i, 0, nci-1); - for j := 0 to MAXJSAMPLE do - begin - while (j > k) do { advance val if past boundary } - begin - Inc(val); - k := largest_input_value(cinfo, i, val, nci-1); - end; - { premultiply so that no multiplication needed in main processing } - indexptr^[j] := JSAMPLE (val * blksize); - end; - { Pad at both ends if necessary } - if (pad <> 0) then - begin - help_indexptr := indexptr; - { adjust the help pointer to avoid negative offsets } - Dec(JSAMPLE_PTR(help_indexptr), MAXJSAMPLE); - - for j := 1 to MAXJSAMPLE do - begin - {indexptr^[-j] := indexptr^[0];} - help_indexptr^[MAXJSAMPLE-j] := indexptr^[0]; - indexptr^[MAXJSAMPLE+j] := indexptr^[MAXJSAMPLE]; - end; - end; - end; -end; - - -{ Create an ordered-dither array for a component having ncolors - distinct output values. } - -{LOCAL} -function make_odither_array (cinfo : j_decompress_ptr; - ncolors : int) : ODITHER_MATRIX_PTR; -var - odither : ODITHER_MATRIX_PTR; - j, k : int; - num, den : INT32; -begin - odither := ODITHER_MATRIX_PTR ( - cinfo^.mem^.alloc_small(j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(ODITHER_MATRIX))); - { The inter-value distance for this color is MAXJSAMPLE/(ncolors-1). - Hence the dither value for the matrix cell with fill order f - (f=0..N-1) should be (N-1-2*f)/(2*N) * MAXJSAMPLE/(ncolors-1). - On 16-bit-int machine, be careful to avoid overflow. } - - den := 2 * ODITHER_CELLS * ( INT32(ncolors - 1)); - for j := 0 to pred(ODITHER_SIZE) do - begin - for k := 0 to pred(ODITHER_SIZE) do - begin - num := ( INT32(ODITHER_CELLS-1 - 2*( int(base_dither_matrix[j][k])))) - * MAXJSAMPLE; - { Ensure round towards zero despite C's lack of consistency - about rounding negative values in integer division... } - - if num<0 then - odither^[j][k] := int (-((-num) div den)) - else - odither^[j][k] := int (num div den); - end; - end; - make_odither_array := odither; -end; - - -{ Create the ordered-dither tables. - Components having the same number of representative colors may - share a dither table. } - -{LOCAL} -procedure create_odither_tables (cinfo : j_decompress_ptr); -var - cquantize : my_cquantize_ptr; - odither : ODITHER_MATRIX_PTR; - i, j, nci : int; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - - for i := 0 to pred(cinfo^.out_color_components) do - begin - nci := cquantize^.Ncolors[i]; { # of distinct values for this color } - odither := NIL; { search for matching prior component } - for j := 0 to pred(i) do - begin - if (nci = cquantize^.Ncolors[j]) then - begin - odither := cquantize^.odither[j]; - break; - end; - end; - if (odither = NIL) then { need a new table? } - odither := make_odither_array(cinfo, nci); - cquantize^.odither[i] := odither; - end; -end; - - -{ Map some rows of pixels to the output colormapped representation. } - -{METHODDEF} -procedure color_quantize (cinfo : j_decompress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPARRAY; - num_rows : int); -{ General case, no dithering } -var - cquantize : my_cquantize_ptr; - colorindex : JSAMPARRAY; - pixcode, ci : int; {register} - ptrin, ptrout : JSAMPLE_PTR; {register} - row : int; - col : JDIMENSION; - width : JDIMENSION; - nc : int; {register} -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - colorindex := cquantize^.colorindex; - width := cinfo^.output_width; - nc := cinfo^.out_color_components; - - for row := 0 to pred(num_rows) do - begin - ptrin := JSAMPLE_PTR(input_buf^[row]); - ptrout := JSAMPLE_PTR(output_buf^[row]); - for col := pred(width) downto 0 do - begin - pixcode := 0; - for ci := 0 to pred(nc) do - begin - Inc(pixcode, GETJSAMPLE(colorindex^[ci]^[GETJSAMPLE(ptrin^)]) ); - Inc(ptrin); - end; - ptrout^ := JSAMPLE (pixcode); - Inc(ptrout); - end; - end; -end; - - -{METHODDEF} -procedure color_quantize3 (cinfo : j_decompress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPARRAY; - num_rows : int); -{ Fast path for out_color_components=3, no dithering } -var - cquantize : my_cquantize_ptr; - pixcode : int; {register} - ptrin, ptrout : JSAMPLE_PTR; {register} - colorindex0 : JSAMPROW; - colorindex1 : JSAMPROW; - colorindex2 : JSAMPROW; - row : int; - col : JDIMENSION; - width : JDIMENSION; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - colorindex0 := (cquantize^.colorindex)^[0]; - colorindex1 := (cquantize^.colorindex)^[1]; - colorindex2 := (cquantize^.colorindex)^[2]; - width := cinfo^.output_width; - - for row := 0 to pred(num_rows) do - begin - ptrin := JSAMPLE_PTR(input_buf^[row]); - ptrout := JSAMPLE_PTR(output_buf^[row]); - for col := pred(width) downto 0 do - begin - pixcode := GETJSAMPLE((colorindex0)^[GETJSAMPLE(ptrin^)]); - Inc(ptrin); - Inc( pixcode, GETJSAMPLE((colorindex1)^[GETJSAMPLE(ptrin^)]) ); - Inc(ptrin); - Inc( pixcode, GETJSAMPLE((colorindex2)^[GETJSAMPLE(ptrin^)]) ); - Inc(ptrin); - ptrout^ := JSAMPLE (pixcode); - Inc(ptrout); - end; - end; -end; - - -{METHODDEF} -procedure quantize_ord_dither (cinfo : j_decompress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPARRAY; - num_rows : int); -{ General case, with ordered dithering } -var - cquantize : my_cquantize_ptr; - input_ptr, {register} - output_ptr : JSAMPLE_PTR; {register} - colorindex_ci : JSAMPROW; - dither : ^ODITHER_vector; { points to active row of dither matrix } - row_index, col_index : int; { current indexes into dither matrix } - nc : int; - ci : int; - row : int; - col : JDIMENSION; - width : JDIMENSION; -var - pad_offset : int; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - nc := cinfo^.out_color_components; - width := cinfo^.output_width; - - { Nomssi: work around negative offset } - if my_cquantize_ptr (cinfo^.cquantize)^.is_padded then - pad_offset := MAXJSAMPLE - else - pad_offset := 0; - - for row := 0 to pred(num_rows) do - begin - { Initialize output values to 0 so can process components separately } - jzero_far( {far} pointer(output_buf^[row]), - size_t(width * SIZEOF(JSAMPLE))); - row_index := cquantize^.row_index; - for ci := 0 to pred(nc) do - begin - input_ptr := JSAMPLE_PTR(@ input_buf^[row]^[ci]); - output_ptr := JSAMPLE_PTR(output_buf^[row]); - colorindex_ci := cquantize^.colorindex^[ci]; - { Nomssi } - Dec(JSAMPLE_PTR(colorindex_ci), pad_offset); - - dither := @(cquantize^.odither[ci]^[row_index]); - col_index := 0; - - for col := pred(width) downto 0 do - begin - { Form pixel value + dither, range-limit to 0..MAXJSAMPLE, - select output value, accumulate into output code for this pixel. - Range-limiting need not be done explicitly, as we have extended - the colorindex table to produce the right answers for out-of-range - inputs. The maximum dither is +- MAXJSAMPLE; this sets the - required amount of padding. } - - Inc(output_ptr^, - colorindex_ci^[GETJSAMPLE(input_ptr^)+ pad_offset + - dither^[col_index]]); - Inc(output_ptr); - Inc(input_ptr, nc); - col_index := (col_index + 1) and ODITHER_MASK; - end; - end; - { Advance row index for next row } - row_index := (row_index + 1) and ODITHER_MASK; - cquantize^.row_index := row_index; - end; -end; - -{METHODDEF} -procedure quantize3_ord_dither (cinfo : j_decompress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPARRAY; - num_rows : int); -{ Fast path for out_color_components=3, with ordered dithering } -var - cquantize : my_cquantize_ptr; - pixcode : int; {register} - input_ptr : JSAMPLE_PTR; {register} - output_ptr : JSAMPLE_PTR; {register} - colorindex0 : JSAMPROW; - colorindex1 : JSAMPROW; - colorindex2 : JSAMPROW; - dither0 : ^ODITHER_vector; { points to active row of dither matrix } - dither1 : ^ODITHER_vector; - dither2 : ^ODITHER_vector; - row_index, col_index : int; { current indexes into dither matrix } - row : int; - col : JDIMENSION; - width : JDIMENSION; -var - pad_offset : int; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - colorindex0 := (cquantize^.colorindex)^[0]; - colorindex1 := (cquantize^.colorindex)^[1]; - colorindex2 := (cquantize^.colorindex)^[2]; - width := cinfo^.output_width; - - { Nomssi: work around negative offset } - if my_cquantize_ptr (cinfo^.cquantize)^.is_padded then - pad_offset := MAXJSAMPLE - else - pad_offset := 0; - - Dec(JSAMPLE_PTR(colorindex0), pad_offset); - Dec(JSAMPLE_PTR(colorindex1), pad_offset); - Dec(JSAMPLE_PTR(colorindex2), pad_offset); - - for row := 0 to pred(num_rows) do - begin - row_index := cquantize^.row_index; - input_ptr := JSAMPLE_PTR(input_buf^[row]); - output_ptr := JSAMPLE_PTR(output_buf^[row]); - dither0 := @(cquantize^.odither[0]^[row_index]); - dither1 := @(cquantize^.odither[1]^[row_index]); - dither2 := @(cquantize^.odither[2]^[row_index]); - col_index := 0; - - - for col := pred(width) downto 0 do - begin - pixcode := GETJSAMPLE(colorindex0^[GETJSAMPLE(input_ptr^) + pad_offset - + dither0^[col_index]]); - Inc(input_ptr); - Inc(pixcode, GETJSAMPLE(colorindex1^[GETJSAMPLE(input_ptr^) + pad_offset - + dither1^[col_index]])); - Inc(input_ptr); - Inc(pixcode, GETJSAMPLE(colorindex2^[GETJSAMPLE(input_ptr^) + pad_offset - + dither2^[col_index]])); - Inc(input_ptr); - output_ptr^ := JSAMPLE (pixcode); - Inc(output_ptr); - col_index := (col_index + 1) and ODITHER_MASK; - end; - row_index := (row_index + 1) and ODITHER_MASK; - cquantize^.row_index := row_index; - end; -end; - - -{METHODDEF} -procedure quantize_fs_dither (cinfo : j_decompress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPARRAY; - num_rows : int); -{ General case, with Floyd-Steinberg dithering } -var - cquantize : my_cquantize_ptr; - cur : LOCFSERROR; {register} { current error or pixel value } - belowerr : LOCFSERROR; { error for pixel below cur } - bpreverr : LOCFSERROR; { error for below/prev col } - bnexterr : LOCFSERROR; { error for below/next col } - delta : LOCFSERROR; - prev_errorptr, - errorptr : FSERRORPTR; {register} { => fserrors[] at column before current } - input_ptr, {register} - output_ptr : JSAMPLE_PTR; {register} - colorindex_ci : JSAMPROW; - colormap_ci : JSAMPROW; - pixcode : int; - nc : int; - dir : int; { 1 for left-to-right, -1 for right-to-left } - dirnc : int; { dir * nc } - ci : int; - row : int; - col : JDIMENSION; - width : JDIMENSION; - range_limit : range_limit_table_ptr; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - nc := cinfo^.out_color_components; - width := cinfo^.output_width; - range_limit := cinfo^.sample_range_limit; - - for row := 0 to pred(num_rows) do - begin - { Initialize output values to 0 so can process components separately } - jzero_far( (output_buf)^[row], - size_t(width * SIZEOF(JSAMPLE))); - for ci := 0 to pred(nc) do - begin - input_ptr := JSAMPLE_PTR(@ input_buf^[row]^[ci]); - output_ptr := JSAMPLE_PTR(output_buf^[row]); - errorptr := FSERRORPTR(cquantize^.fserrors[ci]); { => entry before first column } - if (cquantize^.on_odd_row) then - begin - { work right to left in this row } - Inc(input_ptr, (width-1) * JDIMENSION(nc)); { so point to rightmost pixel } - Inc(output_ptr, width-1); - dir := -1; - dirnc := -nc; - Inc(errorptr, (width+1)); { => entry after last column } - end - else - begin - { work left to right in this row } - dir := 1; - dirnc := nc; - {errorptr := cquantize^.fserrors[ci];} - end; - - colorindex_ci := cquantize^.colorindex^[ci]; - - colormap_ci := (cquantize^.sv_colormap)^[ci]; - { Preset error values: no error propagated to first pixel from left } - cur := 0; - { and no error propagated to row below yet } - belowerr := 0; - bpreverr := 0; - - for col := pred(width) downto 0 do - begin - prev_errorptr := errorptr; - Inc(errorptr, dir); { advance errorptr to current column } - - { cur holds the error propagated from the previous pixel on the - current line. Add the error propagated from the previous line - to form the complete error correction term for this pixel, and - round the error term (which is expressed * 16) to an integer. - RIGHT_SHIFT rounds towards minus infinity, so adding 8 is correct - for either sign of the error value. - Note: errorptr points to *previous* column's array entry. } - - cur := (cur + errorptr^ + 8) div 16; - - { Form pixel value + error, and range-limit to 0..MAXJSAMPLE. - The maximum error is +- MAXJSAMPLE; this sets the required size - of the range_limit array. } - - Inc( cur, GETJSAMPLE(input_ptr^)); - cur := GETJSAMPLE(range_limit^[cur]); - { Select output value, accumulate into output code for this pixel } - pixcode := GETJSAMPLE(colorindex_ci^[cur]); - Inc(output_ptr^, JSAMPLE (pixcode)); - { Compute actual representation error at this pixel } - { Note: we can do this even though we don't have the final } - { pixel code, because the colormap is orthogonal. } - Dec(cur, GETJSAMPLE(colormap_ci^[pixcode])); - { Compute error fractions to be propagated to adjacent pixels. - Add these into the running sums, and simultaneously shift the - next-line error sums left by 1 column. } - - bnexterr := cur; - delta := cur * 2; - Inc(cur, delta); { form error * 3 } - prev_errorptr^ := FSERROR (bpreverr + cur); - Inc(cur, delta); { form error * 5 } - bpreverr := belowerr + cur; - belowerr := bnexterr; - Inc(cur, delta); { form error * 7 } - { At this point cur contains the 7/16 error value to be propagated - to the next pixel on the current line, and all the errors for the - next line have been shifted over. We are therefore ready to move on. } - - Inc(input_ptr, dirnc); { advance input ptr to next column } - Inc(output_ptr, dir); { advance output ptr to next column } - - end; - { Post-loop cleanup: we must unload the final error value into the - final fserrors[] entry. Note we need not unload belowerr because - it is for the dummy column before or after the actual array. } - - errorptr^ := FSERROR (bpreverr); { unload prev err into array } - { Nomssi : ?? } - end; - cquantize^.on_odd_row := not cquantize^.on_odd_row; - end; -end; - - -{ Allocate workspace for Floyd-Steinberg errors. } - -{LOCAL} -procedure alloc_fs_workspace (cinfo : j_decompress_ptr); -var - cquantize : my_cquantize_ptr; - arraysize : size_t; - i : int; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - arraysize := size_t ((cinfo^.output_width + 2) * SIZEOF(FSERROR)); - for i := 0 to pred(cinfo^.out_color_components) do - begin - cquantize^.fserrors[i] := FS_ERROR_FIELD_PTR( - cinfo^.mem^.alloc_large(j_common_ptr(cinfo), JPOOL_IMAGE, arraysize)); - end; -end; - - -{ Initialize for one-pass color quantization. } - -{METHODDEF} -procedure start_pass_1_quant (cinfo : j_decompress_ptr; - is_pre_scan : boolean); -var - cquantize : my_cquantize_ptr; - arraysize : size_t; - i : int; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - { Install my colormap. } - cinfo^.colormap := cquantize^.sv_colormap; - cinfo^.actual_number_of_colors := cquantize^.sv_actual; - - { Initialize for desired dithering mode. } - case (cinfo^.dither_mode) of - JDITHER_NONE: - if (cinfo^.out_color_components = 3) then - cquantize^.pub.color_quantize := color_quantize3 - else - cquantize^.pub.color_quantize := color_quantize; - JDITHER_ORDERED: - begin - if (cinfo^.out_color_components = 3) then - cquantize^.pub.color_quantize := quantize3_ord_dither - else - cquantize^.pub.color_quantize := quantize_ord_dither; - cquantize^.row_index := 0; { initialize state for ordered dither } - { If user changed to ordered dither from another mode, - we must recreate the color index table with padding. - This will cost extra space, but probably isn't very likely. } - - if (not cquantize^.is_padded) then - create_colorindex(cinfo); - { Create ordered-dither tables if we didn't already. } - if (cquantize^.odither[0] = NIL) then - create_odither_tables(cinfo); - end; - JDITHER_FS: - begin - cquantize^.pub.color_quantize := quantize_fs_dither; - cquantize^.on_odd_row := FALSE; { initialize state for F-S dither } - { Allocate Floyd-Steinberg workspace if didn't already. } - if (cquantize^.fserrors[0] = NIL) then - alloc_fs_workspace(cinfo); - { Initialize the propagated errors to zero. } - arraysize := size_t ((cinfo^.output_width + 2) * SIZEOF(FSERROR)); - for i := 0 to pred(cinfo^.out_color_components) do - jzero_far({far} pointer( cquantize^.fserrors[i] ), arraysize); - end; - else - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); - end; -end; - - -{ Finish up at the end of the pass. } - -{METHODDEF} -procedure finish_pass_1_quant (cinfo : j_decompress_ptr); -begin - { no work in 1-pass case } -end; - - -{ Switch to a new external colormap between output passes. - Shouldn't get to this module! } - -{METHODDEF} -procedure new_color_map_1_quant (cinfo : j_decompress_ptr); -begin - ERREXIT(j_common_ptr(cinfo), JERR_MODE_CHANGE); -end; - - -{ Module initialization routine for 1-pass color quantization. } - -{GLOBAL} -procedure jinit_1pass_quantizer (cinfo : j_decompress_ptr); -var - cquantize : my_cquantize_ptr; -begin - cquantize := my_cquantize_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_cquantizer))); - cinfo^.cquantize := jpeg_color_quantizer_ptr(cquantize); - cquantize^.pub.start_pass := start_pass_1_quant; - cquantize^.pub.finish_pass := finish_pass_1_quant; - cquantize^.pub.new_color_map := new_color_map_1_quant; - cquantize^.fserrors[0] := NIL; { Flag FS workspace not allocated } - cquantize^.odither[0] := NIL; { Also flag odither arrays not allocated } - - { Make sure my internal arrays won't overflow } - if (cinfo^.out_color_components > MAX_Q_COMPS) then - ERREXIT1(j_common_ptr(cinfo), JERR_QUANT_COMPONENTS, MAX_Q_COMPS); - { Make sure colormap indexes can be represented by JSAMPLEs } - if (cinfo^.desired_number_of_colors > (MAXJSAMPLE+1)) then - ERREXIT1(j_common_ptr(cinfo), JERR_QUANT_MANY_COLORS, MAXJSAMPLE+1); - - { Create the colormap and color index table. } - create_colormap(cinfo); - create_colorindex(cinfo); - - { Allocate Floyd-Steinberg workspace now if requested. - We do this now since it is FAR storage and may affect the memory - manager's space calculations. If the user changes to FS dither - mode in a later pass, we will allocate the space then, and will - possibly overrun the max_memory_to_use setting. } - - if (cinfo^.dither_mode = JDITHER_FS) then - alloc_fs_workspace(cinfo); -end; - - -end. +unit imjquant1; + +{ This file contains 1-pass color quantization (color mapping) routines. + These routines provide mapping to a fixed color map using equally spaced + color values. Optional Floyd-Steinberg or ordered dithering is available. } + +{ Original: jquant1.c; Copyright (C) 1991-1996, Thomas G. Lane. } + +interface + +{$I imjconfig.inc} + +uses + imjpeglib; + +{GLOBAL} +procedure jinit_1pass_quantizer (cinfo : j_decompress_ptr); + +implementation + +uses + imjmorecfg, + imjdeferr, + imjerror, + imjutils; + +{ The main purpose of 1-pass quantization is to provide a fast, if not very + high quality, colormapped output capability. A 2-pass quantizer usually + gives better visual quality; however, for quantized grayscale output this + quantizer is perfectly adequate. Dithering is highly recommended with this + quantizer, though you can turn it off if you really want to. + + In 1-pass quantization the colormap must be chosen in advance of seeing the + image. We use a map consisting of all combinations of Ncolors[i] color + values for the i'th component. The Ncolors[] values are chosen so that + their product, the total number of colors, is no more than that requested. + (In most cases, the product will be somewhat less.) + + Since the colormap is orthogonal, the representative value for each color + component can be determined without considering the other components; + then these indexes can be combined into a colormap index by a standard + N-dimensional-array-subscript calculation. Most of the arithmetic involved + can be precalculated and stored in the lookup table colorindex[]. + colorindex[i][j] maps pixel value j in component i to the nearest + representative value (grid plane) for that component; this index is + multiplied by the array stride for component i, so that the + index of the colormap entry closest to a given pixel value is just + sum( colorindex[component-number][pixel-component-value] ) + Aside from being fast, this scheme allows for variable spacing between + representative values with no additional lookup cost. + + If gamma correction has been applied in color conversion, it might be wise + to adjust the color grid spacing so that the representative colors are + equidistant in linear space. At this writing, gamma correction is not + implemented by jdcolor, so nothing is done here. } + + +{ Declarations for ordered dithering. + + We use a standard 16x16 ordered dither array. The basic concept of ordered + dithering is described in many references, for instance Dale Schumacher's + chapter II.2 of Graphics Gems II (James Arvo, ed. Academic Press, 1991). + In place of Schumacher's comparisons against a "threshold" value, we add a + "dither" value to the input pixel and then round the result to the nearest + output value. The dither value is equivalent to (0.5 - threshold) times + the distance between output values. For ordered dithering, we assume that + the output colors are equally spaced; if not, results will probably be + worse, since the dither may be too much or too little at a given point. + + The normal calculation would be to form pixel value + dither, range-limit + this to 0..MAXJSAMPLE, and then index into the colorindex table as usual. + We can skip the separate range-limiting step by extending the colorindex + table in both directions. } + + +const + ODITHER_SIZE = 16; { dimension of dither matrix } +{ NB: if ODITHER_SIZE is not a power of 2, ODITHER_MASK uses will break } + ODITHER_CELLS = (ODITHER_SIZE*ODITHER_SIZE); { # cells in matrix } + ODITHER_MASK = (ODITHER_SIZE-1); { mask for wrapping around counters } + +type + ODITHER_vector = Array[0..ODITHER_SIZE-1] of int; + ODITHER_MATRIX = Array[0..ODITHER_SIZE-1] of ODITHER_vector; + {ODITHER_MATRIX_PTR = ^array[0..ODITHER_SIZE-1] of int;} + ODITHER_MATRIX_PTR = ^ODITHER_MATRIX; + +const + base_dither_matrix : Array[0..ODITHER_SIZE-1,0..ODITHER_SIZE-1] of UINT8 + = ( + { Bayer's order-4 dither array. Generated by the code given in + Stephen Hawley's article "Ordered Dithering" in Graphics Gems I. + The values in this array must range from 0 to ODITHER_CELLS-1. } + + ( 0,192, 48,240, 12,204, 60,252, 3,195, 51,243, 15,207, 63,255 ), + ( 128, 64,176,112,140, 76,188,124,131, 67,179,115,143, 79,191,127 ), + ( 32,224, 16,208, 44,236, 28,220, 35,227, 19,211, 47,239, 31,223 ), + ( 160, 96,144, 80,172,108,156, 92,163, 99,147, 83,175,111,159, 95 ), + ( 8,200, 56,248, 4,196, 52,244, 11,203, 59,251, 7,199, 55,247 ), + ( 136, 72,184,120,132, 68,180,116,139, 75,187,123,135, 71,183,119 ), + ( 40,232, 24,216, 36,228, 20,212, 43,235, 27,219, 39,231, 23,215 ), + ( 168,104,152, 88,164,100,148, 84,171,107,155, 91,167,103,151, 87 ), + ( 2,194, 50,242, 14,206, 62,254, 1,193, 49,241, 13,205, 61,253 ), + ( 130, 66,178,114,142, 78,190,126,129, 65,177,113,141, 77,189,125 ), + ( 34,226, 18,210, 46,238, 30,222, 33,225, 17,209, 45,237, 29,221 ), + ( 162, 98,146, 82,174,110,158, 94,161, 97,145, 81,173,109,157, 93 ), + ( 10,202, 58,250, 6,198, 54,246, 9,201, 57,249, 5,197, 53,245 ), + ( 138, 74,186,122,134, 70,182,118,137, 73,185,121,133, 69,181,117 ), + ( 42,234, 26,218, 38,230, 22,214, 41,233, 25,217, 37,229, 21,213 ), + ( 170,106,154, 90,166,102,150, 86,169,105,153, 89,165,101,149, 85 ) + ); + + +{ Declarations for Floyd-Steinberg dithering. + + Errors are accumulated into the array fserrors[], at a resolution of + 1/16th of a pixel count. The error at a given pixel is propagated + to its not-yet-processed neighbors using the standard F-S fractions, + ... (here) 7/16 + 3/16 5/16 1/16 + We work left-to-right on even rows, right-to-left on odd rows. + + We can get away with a single array (holding one row's worth of errors) + by using it to store the current row's errors at pixel columns not yet + processed, but the next row's errors at columns already processed. We + need only a few extra variables to hold the errors immediately around the + current column. (If we are lucky, those variables are in registers, but + even if not, they're probably cheaper to access than array elements are.) + + The fserrors[] array is indexed [component#][position]. + We provide (#columns + 2) entries per component; the extra entry at each + end saves us from special-casing the first and last pixels. + + Note: on a wide image, we might not have enough room in a PC's near data + segment to hold the error array; so it is allocated with alloc_large. } + +{$ifdef BITS_IN_JSAMPLE_IS_8} +type + FSERROR = INT16; { 16 bits should be enough } + LOCFSERROR = int; { use 'int' for calculation temps } +{$else} +type + FSERROR = INT32; { may need more than 16 bits } + LOCFSERROR = INT32; { be sure calculation temps are big enough } +{$endif} + +type + jFSError = 0..(MaxInt div SIZEOF(FSERROR))-1; + FS_ERROR_FIELD = array[jFSError] of FSERROR; + FS_ERROR_FIELD_PTR = ^FS_ERROR_FIELD;{far} + { pointer to error array (in FAR storage!) } + FSERRORPTR = ^FSERROR; + + +{ Private subobject } + +const + MAX_Q_COMPS = 4; { max components I can handle } + +type + my_cquantize_ptr = ^my_cquantizer; + my_cquantizer = record + pub : jpeg_color_quantizer; { public fields } + + { Initially allocated colormap is saved here } + sv_colormap : JSAMPARRAY; { The color map as a 2-D pixel array } + sv_actual : int; { number of entries in use } + + colorindex : JSAMPARRAY; { Precomputed mapping for speed } + { colorindex[i][j] = index of color closest to pixel value j in component i, + premultiplied as described above. Since colormap indexes must fit into + JSAMPLEs, the entries of this array will too. } + + is_padded : boolean; { is the colorindex padded for odither? } + + Ncolors : array[0..MAX_Q_COMPS-1] of int; + { # of values alloced to each component } + + { Variables for ordered dithering } + row_index : int; { cur row's vertical index in dither matrix } + odither : array[0..MAX_Q_COMPS-1] of ODITHER_MATRIX_PTR; + { one dither array per component } + { Variables for Floyd-Steinberg dithering } + fserrors : array[0..MAX_Q_COMPS-1] of FS_ERROR_FIELD_PTR; + { accumulated errors } + on_odd_row : boolean; { flag to remember which row we are on } + end; + + +{ Policy-making subroutines for create_colormap and create_colorindex. + These routines determine the colormap to be used. The rest of the module + only assumes that the colormap is orthogonal. + + * select_ncolors decides how to divvy up the available colors + among the components. + * output_value defines the set of representative values for a component. + * largest_input_value defines the mapping from input values to + representative values for a component. + Note that the latter two routines may impose different policies for + different components, though this is not currently done. } + + + +{LOCAL} +function select_ncolors (cinfo : j_decompress_ptr; + var Ncolors : array of int) : int; +{ Determine allocation of desired colors to components, } +{ and fill in Ncolors[] array to indicate choice. } +{ Return value is total number of colors (product of Ncolors[] values). } +var + nc : int; + max_colors : int; + total_colors, iroot, i, j : int; + changed : boolean; + temp : long; +const + RGB_order:array[0..2] of int = (RGB_GREEN, RGB_RED, RGB_BLUE); +begin + nc := cinfo^.out_color_components; { number of color components } + max_colors := cinfo^.desired_number_of_colors; + + { We can allocate at least the nc'th root of max_colors per component. } + { Compute floor(nc'th root of max_colors). } + iroot := 1; + repeat + Inc(iroot); + temp := iroot; { set temp = iroot ** nc } + for i := 1 to pred(nc) do + temp := temp * iroot; + until (temp > long(max_colors)); { repeat till iroot exceeds root } + Dec(iroot); { now iroot = floor(root) } + + { Must have at least 2 color values per component } + if (iroot < 2) then + ERREXIT1(j_common_ptr(cinfo), JERR_QUANT_FEW_COLORS, int(temp)); + + { Initialize to iroot color values for each component } + total_colors := 1; + for i := 0 to pred(nc) do + begin + Ncolors[i] := iroot; + total_colors := total_colors * iroot; + end; + + { We may be able to increment the count for one or more components without + exceeding max_colors, though we know not all can be incremented. + Sometimes, the first component can be incremented more than once! + (Example: for 16 colors, we start at 2*2*2, go to 3*2*2, then 4*2*2.) + In RGB colorspace, try to increment G first, then R, then B. } + + repeat + changed := FALSE; + for i := 0 to pred(nc) do + begin + if cinfo^.out_color_space = JCS_RGB then + j := RGB_order[i] + else + j := i; + { calculate new total_colors if Ncolors[j] is incremented } + temp := total_colors div Ncolors[j]; + temp := temp * (Ncolors[j]+1); { done in long arith to avoid oflo } + if (temp > long(max_colors)) then + break; { won't fit, done with this pass } + Inc(Ncolors[j]); { OK, apply the increment } + total_colors := int(temp); + changed := TRUE; + end; + until not changed; + + select_ncolors := total_colors; +end; + + +{LOCAL} +function output_value (cinfo : j_decompress_ptr; + ci : int; j : int; maxj : int) : int; +{ Return j'th output value, where j will range from 0 to maxj } +{ The output values must fall in 0..MAXJSAMPLE in increasing order } +begin + { We always provide values 0 and MAXJSAMPLE for each component; + any additional values are equally spaced between these limits. + (Forcing the upper and lower values to the limits ensures that + dithering can't produce a color outside the selected gamut.) } + + output_value := int (( INT32(j) * MAXJSAMPLE + maxj div 2) div maxj); +end; + + +{LOCAL} +function largest_input_value (cinfo : j_decompress_ptr; + ci : int; j : int; maxj : int) : int; +{ Return largest input value that should map to j'th output value } +{ Must have largest(j=0) >= 0, and largest(j=maxj) >= MAXJSAMPLE } +begin + { Breakpoints are halfway between values returned by output_value } + largest_input_value := int (( INT32(2*j + 1) * MAXJSAMPLE + + maxj) div (2*maxj)); +end; + + +{ Create the colormap. } + +{LOCAL} +procedure create_colormap (cinfo : j_decompress_ptr); +var + cquantize : my_cquantize_ptr; + colormap : JSAMPARRAY; { Created colormap } + + total_colors : int; { Number of distinct output colors } + i,j,k, nci, blksize, blkdist, ptr, val : int; +begin + cquantize := my_cquantize_ptr (cinfo^.cquantize); + + { Select number of colors for each component } + total_colors := select_ncolors(cinfo, cquantize^.Ncolors); + + { Report selected color counts } + {$IFDEF DEBUG} + if (cinfo^.out_color_components = 3) then + TRACEMS4(j_common_ptr(cinfo), 1, JTRC_QUANT_3_NCOLORS, + total_colors, cquantize^.Ncolors[0], + cquantize^.Ncolors[1], cquantize^.Ncolors[2]) + else + TRACEMS1(j_common_ptr(cinfo), 1, JTRC_QUANT_NCOLORS, total_colors); + {$ENDIF} + + { Allocate and fill in the colormap. } + { The colors are ordered in the map in standard row-major order, } + { i.e. rightmost (highest-indexed) color changes most rapidly. } + + colormap := cinfo^.mem^.alloc_sarray( + j_common_ptr(cinfo), JPOOL_IMAGE, + JDIMENSION(total_colors), JDIMENSION(cinfo^.out_color_components)); + + { blksize is number of adjacent repeated entries for a component } + { blkdist is distance between groups of identical entries for a component } + blkdist := total_colors; + + for i := 0 to pred(cinfo^.out_color_components) do + begin + { fill in colormap entries for i'th color component } + nci := cquantize^.Ncolors[i]; { # of distinct values for this color } + blksize := blkdist div nci; + for j := 0 to pred(nci) do + begin + { Compute j'th output value (out of nci) for component } + val := output_value(cinfo, i, j, nci-1); + { Fill in all colormap entries that have this value of this component } + ptr := j * blksize; + while (ptr < total_colors) do + begin + { fill in blksize entries beginning at ptr } + for k := 0 to pred(blksize) do + colormap^[i]^[ptr+k] := JSAMPLE(val); + + Inc(ptr, blkdist); + end; + end; + blkdist := blksize; { blksize of this color is blkdist of next } + end; + + { Save the colormap in private storage, + where it will survive color quantization mode changes. } + + cquantize^.sv_colormap := colormap; + cquantize^.sv_actual := total_colors; +end; + +{ Create the color index table. } + +{LOCAL} +procedure create_colorindex (cinfo : j_decompress_ptr); +var + cquantize : my_cquantize_ptr; + indexptr, + help_indexptr : JSAMPROW; { for negative offsets } + i,j,k, nci, blksize, val, pad : int; +begin + cquantize := my_cquantize_ptr (cinfo^.cquantize); + { For ordered dither, we pad the color index tables by MAXJSAMPLE in + each direction (input index values can be -MAXJSAMPLE .. 2*MAXJSAMPLE). + This is not necessary in the other dithering modes. However, we + flag whether it was done in case user changes dithering mode. } + + if (cinfo^.dither_mode = JDITHER_ORDERED) then + begin + pad := MAXJSAMPLE*2; + cquantize^.is_padded := TRUE; + end + else + begin + pad := 0; + cquantize^.is_padded := FALSE; + end; + + cquantize^.colorindex := cinfo^.mem^.alloc_sarray + (j_common_ptr(cinfo), JPOOL_IMAGE, + JDIMENSION(MAXJSAMPLE+1 + pad), + JDIMENSION(cinfo^.out_color_components)); + + { blksize is number of adjacent repeated entries for a component } + blksize := cquantize^.sv_actual; + + for i := 0 to pred(cinfo^.out_color_components) do + begin + { fill in colorindex entries for i'th color component } + nci := cquantize^.Ncolors[i]; { # of distinct values for this color } + blksize := blksize div nci; + + { adjust colorindex pointers to provide padding at negative indexes. } + if (pad <> 0) then + Inc(JSAMPLE_PTR(cquantize^.colorindex^[i]), MAXJSAMPLE); + + { in loop, val = index of current output value, } + { and k = largest j that maps to current val } + indexptr := cquantize^.colorindex^[i]; + val := 0; + k := largest_input_value(cinfo, i, 0, nci-1); + for j := 0 to MAXJSAMPLE do + begin + while (j > k) do { advance val if past boundary } + begin + Inc(val); + k := largest_input_value(cinfo, i, val, nci-1); + end; + { premultiply so that no multiplication needed in main processing } + indexptr^[j] := JSAMPLE (val * blksize); + end; + { Pad at both ends if necessary } + if (pad <> 0) then + begin + help_indexptr := indexptr; + { adjust the help pointer to avoid negative offsets } + Dec(JSAMPLE_PTR(help_indexptr), MAXJSAMPLE); + + for j := 1 to MAXJSAMPLE do + begin + {indexptr^[-j] := indexptr^[0];} + help_indexptr^[MAXJSAMPLE-j] := indexptr^[0]; + indexptr^[MAXJSAMPLE+j] := indexptr^[MAXJSAMPLE]; + end; + end; + end; +end; + + +{ Create an ordered-dither array for a component having ncolors + distinct output values. } + +{LOCAL} +function make_odither_array (cinfo : j_decompress_ptr; + ncolors : int) : ODITHER_MATRIX_PTR; +var + odither : ODITHER_MATRIX_PTR; + j, k : int; + num, den : INT32; +begin + odither := ODITHER_MATRIX_PTR ( + cinfo^.mem^.alloc_small(j_common_ptr(cinfo), JPOOL_IMAGE, + SIZEOF(ODITHER_MATRIX))); + { The inter-value distance for this color is MAXJSAMPLE/(ncolors-1). + Hence the dither value for the matrix cell with fill order f + (f=0..N-1) should be (N-1-2*f)/(2*N) * MAXJSAMPLE/(ncolors-1). + On 16-bit-int machine, be careful to avoid overflow. } + + den := 2 * ODITHER_CELLS * ( INT32(ncolors - 1)); + for j := 0 to pred(ODITHER_SIZE) do + begin + for k := 0 to pred(ODITHER_SIZE) do + begin + num := ( INT32(ODITHER_CELLS-1 - 2*( int(base_dither_matrix[j][k])))) + * MAXJSAMPLE; + { Ensure round towards zero despite C's lack of consistency + about rounding negative values in integer division... } + + if num<0 then + odither^[j][k] := int (-((-num) div den)) + else + odither^[j][k] := int (num div den); + end; + end; + make_odither_array := odither; +end; + + +{ Create the ordered-dither tables. + Components having the same number of representative colors may + share a dither table. } + +{LOCAL} +procedure create_odither_tables (cinfo : j_decompress_ptr); +var + cquantize : my_cquantize_ptr; + odither : ODITHER_MATRIX_PTR; + i, j, nci : int; +begin + cquantize := my_cquantize_ptr (cinfo^.cquantize); + + for i := 0 to pred(cinfo^.out_color_components) do + begin + nci := cquantize^.Ncolors[i]; { # of distinct values for this color } + odither := NIL; { search for matching prior component } + for j := 0 to pred(i) do + begin + if (nci = cquantize^.Ncolors[j]) then + begin + odither := cquantize^.odither[j]; + break; + end; + end; + if (odither = NIL) then { need a new table? } + odither := make_odither_array(cinfo, nci); + cquantize^.odither[i] := odither; + end; +end; + + +{ Map some rows of pixels to the output colormapped representation. } + +{METHODDEF} +procedure color_quantize (cinfo : j_decompress_ptr; + input_buf : JSAMPARRAY; + output_buf : JSAMPARRAY; + num_rows : int); +{ General case, no dithering } +var + cquantize : my_cquantize_ptr; + colorindex : JSAMPARRAY; + pixcode, ci : int; {register} + ptrin, ptrout : JSAMPLE_PTR; {register} + row : int; + col : JDIMENSION; + width : JDIMENSION; + nc : int; {register} +begin + cquantize := my_cquantize_ptr (cinfo^.cquantize); + colorindex := cquantize^.colorindex; + width := cinfo^.output_width; + nc := cinfo^.out_color_components; + + for row := 0 to pred(num_rows) do + begin + ptrin := JSAMPLE_PTR(input_buf^[row]); + ptrout := JSAMPLE_PTR(output_buf^[row]); + for col := pred(width) downto 0 do + begin + pixcode := 0; + for ci := 0 to pred(nc) do + begin + Inc(pixcode, GETJSAMPLE(colorindex^[ci]^[GETJSAMPLE(ptrin^)]) ); + Inc(ptrin); + end; + ptrout^ := JSAMPLE (pixcode); + Inc(ptrout); + end; + end; +end; + + +{METHODDEF} +procedure color_quantize3 (cinfo : j_decompress_ptr; + input_buf : JSAMPARRAY; + output_buf : JSAMPARRAY; + num_rows : int); +{ Fast path for out_color_components=3, no dithering } +var + cquantize : my_cquantize_ptr; + pixcode : int; {register} + ptrin, ptrout : JSAMPLE_PTR; {register} + colorindex0 : JSAMPROW; + colorindex1 : JSAMPROW; + colorindex2 : JSAMPROW; + row : int; + col : JDIMENSION; + width : JDIMENSION; +begin + cquantize := my_cquantize_ptr (cinfo^.cquantize); + colorindex0 := (cquantize^.colorindex)^[0]; + colorindex1 := (cquantize^.colorindex)^[1]; + colorindex2 := (cquantize^.colorindex)^[2]; + width := cinfo^.output_width; + + for row := 0 to pred(num_rows) do + begin + ptrin := JSAMPLE_PTR(input_buf^[row]); + ptrout := JSAMPLE_PTR(output_buf^[row]); + for col := pred(width) downto 0 do + begin + pixcode := GETJSAMPLE((colorindex0)^[GETJSAMPLE(ptrin^)]); + Inc(ptrin); + Inc( pixcode, GETJSAMPLE((colorindex1)^[GETJSAMPLE(ptrin^)]) ); + Inc(ptrin); + Inc( pixcode, GETJSAMPLE((colorindex2)^[GETJSAMPLE(ptrin^)]) ); + Inc(ptrin); + ptrout^ := JSAMPLE (pixcode); + Inc(ptrout); + end; + end; +end; + + +{METHODDEF} +procedure quantize_ord_dither (cinfo : j_decompress_ptr; + input_buf : JSAMPARRAY; + output_buf : JSAMPARRAY; + num_rows : int); +{ General case, with ordered dithering } +var + cquantize : my_cquantize_ptr; + input_ptr, {register} + output_ptr : JSAMPLE_PTR; {register} + colorindex_ci : JSAMPROW; + dither : ^ODITHER_vector; { points to active row of dither matrix } + row_index, col_index : int; { current indexes into dither matrix } + nc : int; + ci : int; + row : int; + col : JDIMENSION; + width : JDIMENSION; +var + pad_offset : int; +begin + cquantize := my_cquantize_ptr (cinfo^.cquantize); + nc := cinfo^.out_color_components; + width := cinfo^.output_width; + + { Nomssi: work around negative offset } + if my_cquantize_ptr (cinfo^.cquantize)^.is_padded then + pad_offset := MAXJSAMPLE + else + pad_offset := 0; + + for row := 0 to pred(num_rows) do + begin + { Initialize output values to 0 so can process components separately } + jzero_far( {far} pointer(output_buf^[row]), + size_t(width * SIZEOF(JSAMPLE))); + row_index := cquantize^.row_index; + for ci := 0 to pred(nc) do + begin + input_ptr := JSAMPLE_PTR(@ input_buf^[row]^[ci]); + output_ptr := JSAMPLE_PTR(output_buf^[row]); + colorindex_ci := cquantize^.colorindex^[ci]; + { Nomssi } + Dec(JSAMPLE_PTR(colorindex_ci), pad_offset); + + dither := @(cquantize^.odither[ci]^[row_index]); + col_index := 0; + + for col := pred(width) downto 0 do + begin + { Form pixel value + dither, range-limit to 0..MAXJSAMPLE, + select output value, accumulate into output code for this pixel. + Range-limiting need not be done explicitly, as we have extended + the colorindex table to produce the right answers for out-of-range + inputs. The maximum dither is +- MAXJSAMPLE; this sets the + required amount of padding. } + + Inc(output_ptr^, + colorindex_ci^[GETJSAMPLE(input_ptr^)+ pad_offset + + dither^[col_index]]); + Inc(output_ptr); + Inc(input_ptr, nc); + col_index := (col_index + 1) and ODITHER_MASK; + end; + end; + { Advance row index for next row } + row_index := (row_index + 1) and ODITHER_MASK; + cquantize^.row_index := row_index; + end; +end; + +{METHODDEF} +procedure quantize3_ord_dither (cinfo : j_decompress_ptr; + input_buf : JSAMPARRAY; + output_buf : JSAMPARRAY; + num_rows : int); +{ Fast path for out_color_components=3, with ordered dithering } +var + cquantize : my_cquantize_ptr; + pixcode : int; {register} + input_ptr : JSAMPLE_PTR; {register} + output_ptr : JSAMPLE_PTR; {register} + colorindex0 : JSAMPROW; + colorindex1 : JSAMPROW; + colorindex2 : JSAMPROW; + dither0 : ^ODITHER_vector; { points to active row of dither matrix } + dither1 : ^ODITHER_vector; + dither2 : ^ODITHER_vector; + row_index, col_index : int; { current indexes into dither matrix } + row : int; + col : JDIMENSION; + width : JDIMENSION; +var + pad_offset : int; +begin + cquantize := my_cquantize_ptr (cinfo^.cquantize); + colorindex0 := (cquantize^.colorindex)^[0]; + colorindex1 := (cquantize^.colorindex)^[1]; + colorindex2 := (cquantize^.colorindex)^[2]; + width := cinfo^.output_width; + + { Nomssi: work around negative offset } + if my_cquantize_ptr (cinfo^.cquantize)^.is_padded then + pad_offset := MAXJSAMPLE + else + pad_offset := 0; + + Dec(JSAMPLE_PTR(colorindex0), pad_offset); + Dec(JSAMPLE_PTR(colorindex1), pad_offset); + Dec(JSAMPLE_PTR(colorindex2), pad_offset); + + for row := 0 to pred(num_rows) do + begin + row_index := cquantize^.row_index; + input_ptr := JSAMPLE_PTR(input_buf^[row]); + output_ptr := JSAMPLE_PTR(output_buf^[row]); + dither0 := @(cquantize^.odither[0]^[row_index]); + dither1 := @(cquantize^.odither[1]^[row_index]); + dither2 := @(cquantize^.odither[2]^[row_index]); + col_index := 0; + + + for col := pred(width) downto 0 do + begin + pixcode := GETJSAMPLE(colorindex0^[GETJSAMPLE(input_ptr^) + pad_offset + + dither0^[col_index]]); + Inc(input_ptr); + Inc(pixcode, GETJSAMPLE(colorindex1^[GETJSAMPLE(input_ptr^) + pad_offset + + dither1^[col_index]])); + Inc(input_ptr); + Inc(pixcode, GETJSAMPLE(colorindex2^[GETJSAMPLE(input_ptr^) + pad_offset + + dither2^[col_index]])); + Inc(input_ptr); + output_ptr^ := JSAMPLE (pixcode); + Inc(output_ptr); + col_index := (col_index + 1) and ODITHER_MASK; + end; + row_index := (row_index + 1) and ODITHER_MASK; + cquantize^.row_index := row_index; + end; +end; + + +{METHODDEF} +procedure quantize_fs_dither (cinfo : j_decompress_ptr; + input_buf : JSAMPARRAY; + output_buf : JSAMPARRAY; + num_rows : int); +{ General case, with Floyd-Steinberg dithering } +var + cquantize : my_cquantize_ptr; + cur : LOCFSERROR; {register} { current error or pixel value } + belowerr : LOCFSERROR; { error for pixel below cur } + bpreverr : LOCFSERROR; { error for below/prev col } + bnexterr : LOCFSERROR; { error for below/next col } + delta : LOCFSERROR; + prev_errorptr, + errorptr : FSERRORPTR; {register} { => fserrors[] at column before current } + input_ptr, {register} + output_ptr : JSAMPLE_PTR; {register} + colorindex_ci : JSAMPROW; + colormap_ci : JSAMPROW; + pixcode : int; + nc : int; + dir : int; { 1 for left-to-right, -1 for right-to-left } + dirnc : int; { dir * nc } + ci : int; + row : int; + col : JDIMENSION; + width : JDIMENSION; + range_limit : range_limit_table_ptr; +begin + cquantize := my_cquantize_ptr (cinfo^.cquantize); + nc := cinfo^.out_color_components; + width := cinfo^.output_width; + range_limit := cinfo^.sample_range_limit; + + for row := 0 to pred(num_rows) do + begin + { Initialize output values to 0 so can process components separately } + jzero_far( (output_buf)^[row], + size_t(width * SIZEOF(JSAMPLE))); + for ci := 0 to pred(nc) do + begin + input_ptr := JSAMPLE_PTR(@ input_buf^[row]^[ci]); + output_ptr := JSAMPLE_PTR(output_buf^[row]); + errorptr := FSERRORPTR(cquantize^.fserrors[ci]); { => entry before first column } + if (cquantize^.on_odd_row) then + begin + { work right to left in this row } + Inc(input_ptr, (width-1) * JDIMENSION(nc)); { so point to rightmost pixel } + Inc(output_ptr, width-1); + dir := -1; + dirnc := -nc; + Inc(errorptr, (width+1)); { => entry after last column } + end + else + begin + { work left to right in this row } + dir := 1; + dirnc := nc; + {errorptr := cquantize^.fserrors[ci];} + end; + + colorindex_ci := cquantize^.colorindex^[ci]; + + colormap_ci := (cquantize^.sv_colormap)^[ci]; + { Preset error values: no error propagated to first pixel from left } + cur := 0; + { and no error propagated to row below yet } + belowerr := 0; + bpreverr := 0; + + for col := pred(width) downto 0 do + begin + prev_errorptr := errorptr; + Inc(errorptr, dir); { advance errorptr to current column } + + { cur holds the error propagated from the previous pixel on the + current line. Add the error propagated from the previous line + to form the complete error correction term for this pixel, and + round the error term (which is expressed * 16) to an integer. + RIGHT_SHIFT rounds towards minus infinity, so adding 8 is correct + for either sign of the error value. + Note: errorptr points to *previous* column's array entry. } + + cur := (cur + errorptr^ + 8) div 16; + + { Form pixel value + error, and range-limit to 0..MAXJSAMPLE. + The maximum error is +- MAXJSAMPLE; this sets the required size + of the range_limit array. } + + Inc( cur, GETJSAMPLE(input_ptr^)); + cur := GETJSAMPLE(range_limit^[cur]); + { Select output value, accumulate into output code for this pixel } + pixcode := GETJSAMPLE(colorindex_ci^[cur]); + Inc(output_ptr^, JSAMPLE (pixcode)); + { Compute actual representation error at this pixel } + { Note: we can do this even though we don't have the final } + { pixel code, because the colormap is orthogonal. } + Dec(cur, GETJSAMPLE(colormap_ci^[pixcode])); + { Compute error fractions to be propagated to adjacent pixels. + Add these into the running sums, and simultaneously shift the + next-line error sums left by 1 column. } + + bnexterr := cur; + delta := cur * 2; + Inc(cur, delta); { form error * 3 } + prev_errorptr^ := FSERROR (bpreverr + cur); + Inc(cur, delta); { form error * 5 } + bpreverr := belowerr + cur; + belowerr := bnexterr; + Inc(cur, delta); { form error * 7 } + { At this point cur contains the 7/16 error value to be propagated + to the next pixel on the current line, and all the errors for the + next line have been shifted over. We are therefore ready to move on. } + + Inc(input_ptr, dirnc); { advance input ptr to next column } + Inc(output_ptr, dir); { advance output ptr to next column } + + end; + { Post-loop cleanup: we must unload the final error value into the + final fserrors[] entry. Note we need not unload belowerr because + it is for the dummy column before or after the actual array. } + + errorptr^ := FSERROR (bpreverr); { unload prev err into array } + { Nomssi : ?? } + end; + cquantize^.on_odd_row := not cquantize^.on_odd_row; + end; +end; + + +{ Allocate workspace for Floyd-Steinberg errors. } + +{LOCAL} +procedure alloc_fs_workspace (cinfo : j_decompress_ptr); +var + cquantize : my_cquantize_ptr; + arraysize : size_t; + i : int; +begin + cquantize := my_cquantize_ptr (cinfo^.cquantize); + arraysize := size_t ((cinfo^.output_width + 2) * SIZEOF(FSERROR)); + for i := 0 to pred(cinfo^.out_color_components) do + begin + cquantize^.fserrors[i] := FS_ERROR_FIELD_PTR( + cinfo^.mem^.alloc_large(j_common_ptr(cinfo), JPOOL_IMAGE, arraysize)); + end; +end; + + +{ Initialize for one-pass color quantization. } + +{METHODDEF} +procedure start_pass_1_quant (cinfo : j_decompress_ptr; + is_pre_scan : boolean); +var + cquantize : my_cquantize_ptr; + arraysize : size_t; + i : int; +begin + cquantize := my_cquantize_ptr (cinfo^.cquantize); + { Install my colormap. } + cinfo^.colormap := cquantize^.sv_colormap; + cinfo^.actual_number_of_colors := cquantize^.sv_actual; + + { Initialize for desired dithering mode. } + case (cinfo^.dither_mode) of + JDITHER_NONE: + if (cinfo^.out_color_components = 3) then + cquantize^.pub.color_quantize := color_quantize3 + else + cquantize^.pub.color_quantize := color_quantize; + JDITHER_ORDERED: + begin + if (cinfo^.out_color_components = 3) then + cquantize^.pub.color_quantize := quantize3_ord_dither + else + cquantize^.pub.color_quantize := quantize_ord_dither; + cquantize^.row_index := 0; { initialize state for ordered dither } + { If user changed to ordered dither from another mode, + we must recreate the color index table with padding. + This will cost extra space, but probably isn't very likely. } + + if (not cquantize^.is_padded) then + create_colorindex(cinfo); + { Create ordered-dither tables if we didn't already. } + if (cquantize^.odither[0] = NIL) then + create_odither_tables(cinfo); + end; + JDITHER_FS: + begin + cquantize^.pub.color_quantize := quantize_fs_dither; + cquantize^.on_odd_row := FALSE; { initialize state for F-S dither } + { Allocate Floyd-Steinberg workspace if didn't already. } + if (cquantize^.fserrors[0] = NIL) then + alloc_fs_workspace(cinfo); + { Initialize the propagated errors to zero. } + arraysize := size_t ((cinfo^.output_width + 2) * SIZEOF(FSERROR)); + for i := 0 to pred(cinfo^.out_color_components) do + jzero_far({far} pointer( cquantize^.fserrors[i] ), arraysize); + end; + else + ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); + end; +end; + + +{ Finish up at the end of the pass. } + +{METHODDEF} +procedure finish_pass_1_quant (cinfo : j_decompress_ptr); +begin + { no work in 1-pass case } +end; + + +{ Switch to a new external colormap between output passes. + Shouldn't get to this module! } + +{METHODDEF} +procedure new_color_map_1_quant (cinfo : j_decompress_ptr); +begin + ERREXIT(j_common_ptr(cinfo), JERR_MODE_CHANGE); +end; + + +{ Module initialization routine for 1-pass color quantization. } + +{GLOBAL} +procedure jinit_1pass_quantizer (cinfo : j_decompress_ptr); +var + cquantize : my_cquantize_ptr; +begin + cquantize := my_cquantize_ptr( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + SIZEOF(my_cquantizer))); + cinfo^.cquantize := jpeg_color_quantizer_ptr(cquantize); + cquantize^.pub.start_pass := start_pass_1_quant; + cquantize^.pub.finish_pass := finish_pass_1_quant; + cquantize^.pub.new_color_map := new_color_map_1_quant; + cquantize^.fserrors[0] := NIL; { Flag FS workspace not allocated } + cquantize^.odither[0] := NIL; { Also flag odither arrays not allocated } + + { Make sure my internal arrays won't overflow } + if (cinfo^.out_color_components > MAX_Q_COMPS) then + ERREXIT1(j_common_ptr(cinfo), JERR_QUANT_COMPONENTS, MAX_Q_COMPS); + { Make sure colormap indexes can be represented by JSAMPLEs } + if (cinfo^.desired_number_of_colors > (MAXJSAMPLE+1)) then + ERREXIT1(j_common_ptr(cinfo), JERR_QUANT_MANY_COLORS, MAXJSAMPLE+1); + + { Create the colormap and color index table. } + create_colormap(cinfo); + create_colorindex(cinfo); + + { Allocate Floyd-Steinberg workspace now if requested. + We do this now since it is FAR storage and may affect the memory + manager's space calculations. If the user changes to FS dither + mode in a later pass, we will allocate the space then, and will + possibly overrun the max_memory_to_use setting. } + + if (cinfo^.dither_mode = JDITHER_FS) then + alloc_fs_workspace(cinfo); +end; + + +end. diff --git a/Imaging/JpegLib/imjquant2.pas b/Imaging/JpegLib/imjquant2.pas index 21cc232..a1e7a44 100644 --- a/Imaging/JpegLib/imjquant2.pas +++ b/Imaging/JpegLib/imjquant2.pas @@ -1,1551 +1,1551 @@ -unit imjquant2; - - -{ This file contains 2-pass color quantization (color mapping) routines. - These routines provide selection of a custom color map for an image, - followed by mapping of the image to that color map, with optional - Floyd-Steinberg dithering. - It is also possible to use just the second pass to map to an arbitrary - externally-given color map. - - Note: ordered dithering is not supported, since there isn't any fast - way to compute intercolor distances; it's unclear that ordered dither's - fundamental assumptions even hold with an irregularly spaced color map. } - -{ Original: jquant2.c; Copyright (C) 1991-1996, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjdeferr, - imjerror, - imjutils, - imjpeglib; - -{ Module initialization routine for 2-pass color quantization. } - - -{GLOBAL} -procedure jinit_2pass_quantizer (cinfo : j_decompress_ptr); - -implementation - -{ This module implements the well-known Heckbert paradigm for color - quantization. Most of the ideas used here can be traced back to - Heckbert's seminal paper - Heckbert, Paul. "Color Image Quantization for Frame Buffer Display", - Proc. SIGGRAPH '82, Computer Graphics v.16 #3 (July 1982), pp 297-304. - - In the first pass over the image, we accumulate a histogram showing the - usage count of each possible color. To keep the histogram to a reasonable - size, we reduce the precision of the input; typical practice is to retain - 5 or 6 bits per color, so that 8 or 4 different input values are counted - in the same histogram cell. - - Next, the color-selection step begins with a box representing the whole - color space, and repeatedly splits the "largest" remaining box until we - have as many boxes as desired colors. Then the mean color in each - remaining box becomes one of the possible output colors. - - The second pass over the image maps each input pixel to the closest output - color (optionally after applying a Floyd-Steinberg dithering correction). - This mapping is logically trivial, but making it go fast enough requires - considerable care. - - Heckbert-style quantizers vary a good deal in their policies for choosing - the "largest" box and deciding where to cut it. The particular policies - used here have proved out well in experimental comparisons, but better ones - may yet be found. - - In earlier versions of the IJG code, this module quantized in YCbCr color - space, processing the raw upsampled data without a color conversion step. - This allowed the color conversion math to be done only once per colormap - entry, not once per pixel. However, that optimization precluded other - useful optimizations (such as merging color conversion with upsampling) - and it also interfered with desired capabilities such as quantizing to an - externally-supplied colormap. We have therefore abandoned that approach. - The present code works in the post-conversion color space, typically RGB. - - To improve the visual quality of the results, we actually work in scaled - RGB space, giving G distances more weight than R, and R in turn more than - B. To do everything in integer math, we must use integer scale factors. - The 2/3/1 scale factors used here correspond loosely to the relative - weights of the colors in the NTSC grayscale equation. - If you want to use this code to quantize a non-RGB color space, you'll - probably need to change these scale factors. } - -const - R_SCALE = 2; { scale R distances by this much } - G_SCALE = 3; { scale G distances by this much } - B_SCALE = 1; { and B by this much } - -{ Relabel R/G/B as components 0/1/2, respecting the RGB ordering defined - in jmorecfg.h. As the code stands, it will do the right thing for R,G,B - and B,G,R orders. If you define some other weird order in jmorecfg.h, - you'll get compile errors until you extend this logic. In that case - you'll probably want to tweak the histogram sizes too. } - -{$ifdef RGB_RED_IS_0} -const - C0_SCALE = R_SCALE; - C1_SCALE = G_SCALE; - C2_SCALE = B_SCALE; -{$else} -const - C0_SCALE = B_SCALE; - C1_SCALE = G_SCALE; - C2_SCALE = R_SCALE; -{$endif} - - -{ First we have the histogram data structure and routines for creating it. - - The number of bits of precision can be adjusted by changing these symbols. - We recommend keeping 6 bits for G and 5 each for R and B. - If you have plenty of memory and cycles, 6 bits all around gives marginally - better results; if you are short of memory, 5 bits all around will save - some space but degrade the results. - To maintain a fully accurate histogram, we'd need to allocate a "long" - (preferably unsigned long) for each cell. In practice this is overkill; - we can get by with 16 bits per cell. Few of the cell counts will overflow, - and clamping those that do overflow to the maximum value will give close- - enough results. This reduces the recommended histogram size from 256Kb - to 128Kb, which is a useful savings on PC-class machines. - (In the second pass the histogram space is re-used for pixel mapping data; - in that capacity, each cell must be able to store zero to the number of - desired colors. 16 bits/cell is plenty for that too.) - Since the JPEG code is intended to run in small memory model on 80x86 - machines, we can't just allocate the histogram in one chunk. Instead - of a true 3-D array, we use a row of pointers to 2-D arrays. Each - pointer corresponds to a C0 value (typically 2^5 = 32 pointers) and - each 2-D array has 2^6*2^5 = 2048 or 2^6*2^6 = 4096 entries. Note that - on 80x86 machines, the pointer row is in near memory but the actual - arrays are in far memory (same arrangement as we use for image arrays). } - - -const - MAXNUMCOLORS = (MAXJSAMPLE+1); { maximum size of colormap } - -{ These will do the right thing for either R,G,B or B,G,R color order, - but you may not like the results for other color orders. } - -const - HIST_C0_BITS = 5; { bits of precision in R/B histogram } - HIST_C1_BITS = 6; { bits of precision in G histogram } - HIST_C2_BITS = 5; { bits of precision in B/R histogram } - -{ Number of elements along histogram axes. } -const - HIST_C0_ELEMS = (1 shl HIST_C0_BITS); - HIST_C1_ELEMS = (1 shl HIST_C1_BITS); - HIST_C2_ELEMS = (1 shl HIST_C2_BITS); - -{ These are the amounts to shift an input value to get a histogram index. } -const - C0_SHIFT = (BITS_IN_JSAMPLE-HIST_C0_BITS); - C1_SHIFT = (BITS_IN_JSAMPLE-HIST_C1_BITS); - C2_SHIFT = (BITS_IN_JSAMPLE-HIST_C2_BITS); - - -type { Nomssi } - RGBptr = ^RGBtype; - RGBtype = packed record - r,g,b : JSAMPLE; - end; -type - histcell = UINT16; { histogram cell; prefer an unsigned type } - -type - histptr = ^histcell {FAR}; { for pointers to histogram cells } - -type - hist1d = array[0..HIST_C2_ELEMS-1] of histcell; { typedefs for the array } - {hist1d_ptr = ^hist1d;} - hist1d_field = array[0..HIST_C1_ELEMS-1] of hist1d; - { type for the 2nd-level pointers } - hist2d = ^hist1d_field; - hist2d_field = array[0..HIST_C0_ELEMS-1] of hist2d; - hist3d = ^hist2d_field; { type for top-level pointer } - - -{ Declarations for Floyd-Steinberg dithering. - - Errors are accumulated into the array fserrors[], at a resolution of - 1/16th of a pixel count. The error at a given pixel is propagated - to its not-yet-processed neighbors using the standard F-S fractions, - ... (here) 7/16 - 3/16 5/16 1/16 - We work left-to-right on even rows, right-to-left on odd rows. - - We can get away with a single array (holding one row's worth of errors) - by using it to store the current row's errors at pixel columns not yet - processed, but the next row's errors at columns already processed. We - need only a few extra variables to hold the errors immediately around the - current column. (If we are lucky, those variables are in registers, but - even if not, they're probably cheaper to access than array elements are.) - - The fserrors[] array has (#columns + 2) entries; the extra entry at - each end saves us from special-casing the first and last pixels. - Each entry is three values long, one value for each color component. - - Note: on a wide image, we might not have enough room in a PC's near data - segment to hold the error array; so it is allocated with alloc_large. } - - -{$ifdef BITS_IN_JSAMPLE_IS_8} -type - FSERROR = INT16; { 16 bits should be enough } - LOCFSERROR = int; { use 'int' for calculation temps } -{$else} -type - FSERROR = INT32; { may need more than 16 bits } - LOCFSERROR = INT32; { be sure calculation temps are big enough } -{$endif} -type { Nomssi } - RGB_FSERROR_PTR = ^RGB_FSERROR; - RGB_FSERROR = packed record - r,g,b : FSERROR; - end; - LOCRGB_FSERROR = packed record - r,g,b : LOCFSERROR; - end; - -type - FSERROR_PTR = ^FSERROR; - jFSError = 0..(MaxInt div SIZEOF(RGB_FSERROR))-1; - FS_ERROR_FIELD = array[jFSError] of RGB_FSERROR; - FS_ERROR_FIELD_PTR = ^FS_ERROR_FIELD;{far} - { pointer to error array (in FAR storage!) } - -type - error_limit_array = array[-MAXJSAMPLE..MAXJSAMPLE] of int; - { table for clamping the applied error } - error_limit_ptr = ^error_limit_array; - -{ Private subobject } -type - my_cquantize_ptr = ^my_cquantizer; - my_cquantizer = record - pub : jpeg_color_quantizer; { public fields } - - { Space for the eventually created colormap is stashed here } - sv_colormap : JSAMPARRAY; { colormap allocated at init time } - desired : int; { desired # of colors = size of colormap } - - { Variables for accumulating image statistics } - histogram : hist3d; { pointer to the histogram } - - needs_zeroed : boolean; { TRUE if next pass must zero histogram } - - { Variables for Floyd-Steinberg dithering } - fserrors : FS_ERROR_FIELD_PTR; { accumulated errors } - on_odd_row : boolean; { flag to remember which row we are on } - error_limiter : error_limit_ptr; { table for clamping the applied error } - end; - - - -{ Prescan some rows of pixels. - In this module the prescan simply updates the histogram, which has been - initialized to zeroes by start_pass. - An output_buf parameter is required by the method signature, but no data - is actually output (in fact the buffer controller is probably passing a - NIL pointer). } - -{METHODDEF} -procedure prescan_quantize (cinfo : j_decompress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPARRAY; - num_rows : int); -var - cquantize : my_cquantize_ptr; - {register} ptr : RGBptr; - {register} histp : histptr; - {register} histogram : hist3d; - row : int; - col : JDIMENSION; - width : JDIMENSION; -begin - cquantize := my_cquantize_ptr(cinfo^.cquantize); - histogram := cquantize^.histogram; - width := cinfo^.output_width; - - for row := 0 to pred(num_rows) do - begin - ptr := RGBptr(input_buf^[row]); - for col := pred(width) downto 0 do - begin - { get pixel value and index into the histogram } - histp := @(histogram^[GETJSAMPLE(ptr^.r) shr C0_SHIFT]^ - [GETJSAMPLE(ptr^.g) shr C1_SHIFT] - [GETJSAMPLE(ptr^.b) shr C2_SHIFT]); - { increment, check for overflow and undo increment if so. } - Inc(histp^); - if (histp^ <= 0) then - Dec(histp^); - Inc(ptr); - end; - end; -end; - -{ Next we have the really interesting routines: selection of a colormap - given the completed histogram. - These routines work with a list of "boxes", each representing a rectangular - subset of the input color space (to histogram precision). } - -type - box = record - { The bounds of the box (inclusive); expressed as histogram indexes } - c0min, c0max : int; - c1min, c1max : int; - c2min, c2max : int; - { The volume (actually 2-norm) of the box } - volume : INT32; - { The number of nonzero histogram cells within this box } - colorcount : long; - end; - -type - jBoxList = 0..(MaxInt div SizeOf(box))-1; - box_field = array[jBoxlist] of box; - boxlistptr = ^box_field; - boxptr = ^box; - -{LOCAL} -function find_biggest_color_pop (boxlist : boxlistptr; numboxes : int) : boxptr; -{ Find the splittable box with the largest color population } -{ Returns NIL if no splittable boxes remain } -var - boxp : boxptr ; {register} - i : int; {register} - maxc : long; {register} - which : boxptr; -begin - which := NIL; - boxp := @(boxlist^[0]); - maxc := 0; - for i := 0 to pred(numboxes) do - begin - if (boxp^.colorcount > maxc) and (boxp^.volume > 0) then - begin - which := boxp; - maxc := boxp^.colorcount; - end; - Inc(boxp); - end; - find_biggest_color_pop := which; -end; - - -{LOCAL} -function find_biggest_volume (boxlist : boxlistptr; numboxes : int) : boxptr; -{ Find the splittable box with the largest (scaled) volume } -{ Returns NULL if no splittable boxes remain } -var - {register} boxp : boxptr; - {register} i : int; - {register} maxv : INT32; - which : boxptr; -begin - maxv := 0; - which := NIL; - boxp := @(boxlist^[0]); - for i := 0 to pred(numboxes) do - begin - if (boxp^.volume > maxv) then - begin - which := boxp; - maxv := boxp^.volume; - end; - Inc(boxp); - end; - find_biggest_volume := which; -end; - - -{LOCAL} -procedure update_box (cinfo : j_decompress_ptr; var boxp : box); -label - have_c0min, have_c0max, - have_c1min, have_c1max, - have_c2min, have_c2max; -{ Shrink the min/max bounds of a box to enclose only nonzero elements, } -{ and recompute its volume and population } -var - cquantize : my_cquantize_ptr; - histogram : hist3d; - histp : histptr; - c0,c1,c2 : int; - c0min,c0max,c1min,c1max,c2min,c2max : int; - dist0,dist1,dist2 : INT32; - ccount : long; -begin - cquantize := my_cquantize_ptr(cinfo^.cquantize); - histogram := cquantize^.histogram; - - c0min := boxp.c0min; c0max := boxp.c0max; - c1min := boxp.c1min; c1max := boxp.c1max; - c2min := boxp.c2min; c2max := boxp.c2max; - - if (c0max > c0min) then - for c0 := c0min to c0max do - for c1 := c1min to c1max do - begin - histp := @(histogram^[c0]^[c1][c2min]); - for c2 := c2min to c2max do - begin - if (histp^ <> 0) then - begin - c0min := c0; - boxp.c0min := c0min; - goto have_c0min; - end; - Inc(histp); - end; - end; - have_c0min: - if (c0max > c0min) then - for c0 := c0max downto c0min do - for c1 := c1min to c1max do - begin - histp := @(histogram^[c0]^[c1][c2min]); - for c2 := c2min to c2max do - begin - if ( histp^ <> 0) then - begin - c0max := c0; - boxp.c0max := c0; - goto have_c0max; - end; - Inc(histp); - end; - end; - have_c0max: - if (c1max > c1min) then - for c1 := c1min to c1max do - for c0 := c0min to c0max do - begin - histp := @(histogram^[c0]^[c1][c2min]); - for c2 := c2min to c2max do - begin - if (histp^ <> 0) then - begin - c1min := c1; - boxp.c1min := c1; - goto have_c1min; - end; - Inc(histp); - end; - end; - have_c1min: - if (c1max > c1min) then - for c1 := c1max downto c1min do - for c0 := c0min to c0max do - begin - histp := @(histogram^[c0]^[c1][c2min]); - for c2 := c2min to c2max do - begin - if (histp^ <> 0) then - begin - c1max := c1; - boxp.c1max := c1; - goto have_c1max; - end; - Inc(histp); - end; - end; - have_c1max: - if (c2max > c2min) then - for c2 := c2min to c2max do - for c0 := c0min to c0max do - begin - histp := @(histogram^[c0]^[c1min][c2]); - for c1 := c1min to c1max do - begin - if (histp^ <> 0) then - begin - c2min := c2; - boxp.c2min := c2min; - goto have_c2min; - end; - Inc(histp, HIST_C2_ELEMS); - end; - end; - have_c2min: - if (c2max > c2min) then - for c2 := c2max downto c2min do - for c0 := c0min to c0max do - begin - histp := @(histogram^[c0]^[c1min][c2]); - for c1 := c1min to c1max do - begin - if (histp^ <> 0) then - begin - c2max := c2; - boxp.c2max := c2max; - goto have_c2max; - end; - Inc(histp, HIST_C2_ELEMS); - end; - end; - have_c2max: - - { Update box volume. - We use 2-norm rather than real volume here; this biases the method - against making long narrow boxes, and it has the side benefit that - a box is splittable iff norm > 0. - Since the differences are expressed in histogram-cell units, - we have to shift back to JSAMPLE units to get consistent distances; - after which, we scale according to the selected distance scale factors.} - - dist0 := ((c0max - c0min) shl C0_SHIFT) * C0_SCALE; - dist1 := ((c1max - c1min) shl C1_SHIFT) * C1_SCALE; - dist2 := ((c2max - c2min) shl C2_SHIFT) * C2_SCALE; - boxp.volume := dist0*dist0 + dist1*dist1 + dist2*dist2; - - { Now scan remaining volume of box and compute population } - ccount := 0; - for c0 := c0min to c0max do - for c1 := c1min to c1max do - begin - histp := @(histogram^[c0]^[c1][c2min]); - for c2 := c2min to c2max do - begin - if (histp^ <> 0) then - Inc(ccount); - Inc(histp); - end; - end; - boxp.colorcount := ccount; -end; - - -{LOCAL} -function median_cut (cinfo : j_decompress_ptr; boxlist : boxlistptr; - numboxes : int; desired_colors : int) : int; -{ Repeatedly select and split the largest box until we have enough boxes } -var - n,lb : int; - c0,c1,c2,cmax : int; - {register} b1,b2 : boxptr; -begin - while (numboxes < desired_colors) do - begin - { Select box to split. - Current algorithm: by population for first half, then by volume. } - - if (numboxes*2 <= desired_colors) then - b1 := find_biggest_color_pop(boxlist, numboxes) - else - b1 := find_biggest_volume(boxlist, numboxes); - - if (b1 = NIL) then { no splittable boxes left! } - break; - b2 := @(boxlist^[numboxes]); { where new box will go } - { Copy the color bounds to the new box. } - b2^.c0max := b1^.c0max; b2^.c1max := b1^.c1max; b2^.c2max := b1^.c2max; - b2^.c0min := b1^.c0min; b2^.c1min := b1^.c1min; b2^.c2min := b1^.c2min; - { Choose which axis to split the box on. - Current algorithm: longest scaled axis. - See notes in update_box about scaling distances. } - - c0 := ((b1^.c0max - b1^.c0min) shl C0_SHIFT) * C0_SCALE; - c1 := ((b1^.c1max - b1^.c1min) shl C1_SHIFT) * C1_SCALE; - c2 := ((b1^.c2max - b1^.c2min) shl C2_SHIFT) * C2_SCALE; - { We want to break any ties in favor of green, then red, blue last. - This code does the right thing for R,G,B or B,G,R color orders only. } - -{$ifdef RGB_RED_IS_0} - cmax := c1; n := 1; - if (c0 > cmax) then - begin - cmax := c0; - n := 0; - end; - if (c2 > cmax) then - n := 2; -{$else} - cmax := c1; - n := 1; - if (c2 > cmax) then - begin - cmax := c2; - n := 2; - end; - if (c0 > cmax) then - n := 0; -{$endif} - { Choose split point along selected axis, and update box bounds. - Current algorithm: split at halfway point. - (Since the box has been shrunk to minimum volume, - any split will produce two nonempty subboxes.) - Note that lb value is max for lower box, so must be < old max. } - - case n of - 0:begin - lb := (b1^.c0max + b1^.c0min) div 2; - b1^.c0max := lb; - b2^.c0min := lb+1; - end; - 1:begin - lb := (b1^.c1max + b1^.c1min) div 2; - b1^.c1max := lb; - b2^.c1min := lb+1; - end; - 2:begin - lb := (b1^.c2max + b1^.c2min) div 2; - b1^.c2max := lb; - b2^.c2min := lb+1; - end; - end; - { Update stats for boxes } - update_box(cinfo, b1^); - update_box(cinfo, b2^); - Inc(numboxes); - end; - median_cut := numboxes; -end; - - -{LOCAL} -procedure compute_color (cinfo : j_decompress_ptr; - const boxp : box; icolor : int); -{ Compute representative color for a box, put it in colormap[icolor] } -var - { Current algorithm: mean weighted by pixels (not colors) } - { Note it is important to get the rounding correct! } - cquantize : my_cquantize_ptr; - histogram : hist3d; - histp : histptr; - c0,c1,c2 : int; - c0min,c0max,c1min,c1max,c2min,c2max : int; - count : long; - total : long; - c0total : long; - c1total : long; - c2total : long; -begin - cquantize := my_cquantize_ptr(cinfo^.cquantize); - histogram := cquantize^.histogram; - total := 0; - c0total := 0; - c1total := 0; - c2total := 0; - - c0min := boxp.c0min; c0max := boxp.c0max; - c1min := boxp.c1min; c1max := boxp.c1max; - c2min := boxp.c2min; c2max := boxp.c2max; - - for c0 := c0min to c0max do - for c1 := c1min to c1max do - begin - histp := @(histogram^[c0]^[c1][c2min]); - for c2 := c2min to c2max do - begin - count := histp^; - Inc(histp); - if (count <> 0) then - begin - Inc(total, count); - Inc(c0total, ((c0 shl C0_SHIFT) + ((1 shl C0_SHIFT) shr 1)) * count); - Inc(c1total, ((c1 shl C1_SHIFT) + ((1 shl C1_SHIFT) shr 1)) * count); - Inc(c2total, ((c2 shl C2_SHIFT) + ((1 shl C2_SHIFT) shr 1)) * count); - end; - end; - end; - - cinfo^.colormap^[0]^[icolor] := JSAMPLE ((c0total + (total shr 1)) div total); - cinfo^.colormap^[1]^[icolor] := JSAMPLE ((c1total + (total shr 1)) div total); - cinfo^.colormap^[2]^[icolor] := JSAMPLE ((c2total + (total shr 1)) div total); -end; - - -{LOCAL} -procedure select_colors (cinfo : j_decompress_ptr; desired_colors : int); -{ Master routine for color selection } -var - boxlist : boxlistptr; - numboxes : int; - i : int; -begin - { Allocate workspace for box list } - boxlist := boxlistptr(cinfo^.mem^.alloc_small( - j_common_ptr(cinfo), JPOOL_IMAGE, desired_colors * SIZEOF(box))); - { Initialize one box containing whole space } - numboxes := 1; - boxlist^[0].c0min := 0; - boxlist^[0].c0max := MAXJSAMPLE shr C0_SHIFT; - boxlist^[0].c1min := 0; - boxlist^[0].c1max := MAXJSAMPLE shr C1_SHIFT; - boxlist^[0].c2min := 0; - boxlist^[0].c2max := MAXJSAMPLE shr C2_SHIFT; - { Shrink it to actually-used volume and set its statistics } - update_box(cinfo, boxlist^[0]); - { Perform median-cut to produce final box list } - numboxes := median_cut(cinfo, boxlist, numboxes, desired_colors); - { Compute the representative color for each box, fill colormap } - for i := 0 to pred(numboxes) do - compute_color(cinfo, boxlist^[i], i); - cinfo^.actual_number_of_colors := numboxes; - {$IFDEF DEBUG} - TRACEMS1(j_common_ptr(cinfo), 1, JTRC_QUANT_SELECTED, numboxes); - {$ENDIF} -end; - - -{ These routines are concerned with the time-critical task of mapping input - colors to the nearest color in the selected colormap. - - We re-use the histogram space as an "inverse color map", essentially a - cache for the results of nearest-color searches. All colors within a - histogram cell will be mapped to the same colormap entry, namely the one - closest to the cell's center. This may not be quite the closest entry to - the actual input color, but it's almost as good. A zero in the cache - indicates we haven't found the nearest color for that cell yet; the array - is cleared to zeroes before starting the mapping pass. When we find the - nearest color for a cell, its colormap index plus one is recorded in the - cache for future use. The pass2 scanning routines call fill_inverse_cmap - when they need to use an unfilled entry in the cache. - - Our method of efficiently finding nearest colors is based on the "locally - sorted search" idea described by Heckbert and on the incremental distance - calculation described by Spencer W. Thomas in chapter III.1 of Graphics - Gems II (James Arvo, ed. Academic Press, 1991). Thomas points out that - the distances from a given colormap entry to each cell of the histogram can - be computed quickly using an incremental method: the differences between - distances to adjacent cells themselves differ by a constant. This allows a - fairly fast implementation of the "brute force" approach of computing the - distance from every colormap entry to every histogram cell. Unfortunately, - it needs a work array to hold the best-distance-so-far for each histogram - cell (because the inner loop has to be over cells, not colormap entries). - The work array elements have to be INT32s, so the work array would need - 256Kb at our recommended precision. This is not feasible in DOS machines. - - To get around these problems, we apply Thomas' method to compute the - nearest colors for only the cells within a small subbox of the histogram. - The work array need be only as big as the subbox, so the memory usage - problem is solved. Furthermore, we need not fill subboxes that are never - referenced in pass2; many images use only part of the color gamut, so a - fair amount of work is saved. An additional advantage of this - approach is that we can apply Heckbert's locality criterion to quickly - eliminate colormap entries that are far away from the subbox; typically - three-fourths of the colormap entries are rejected by Heckbert's criterion, - and we need not compute their distances to individual cells in the subbox. - The speed of this approach is heavily influenced by the subbox size: too - small means too much overhead, too big loses because Heckbert's criterion - can't eliminate as many colormap entries. Empirically the best subbox - size seems to be about 1/512th of the histogram (1/8th in each direction). - - Thomas' article also describes a refined method which is asymptotically - faster than the brute-force method, but it is also far more complex and - cannot efficiently be applied to small subboxes. It is therefore not - useful for programs intended to be portable to DOS machines. On machines - with plenty of memory, filling the whole histogram in one shot with Thomas' - refined method might be faster than the present code --- but then again, - it might not be any faster, and it's certainly more complicated. } - - - -{ log2(histogram cells in update box) for each axis; this can be adjusted } -const - BOX_C0_LOG = (HIST_C0_BITS-3); - BOX_C1_LOG = (HIST_C1_BITS-3); - BOX_C2_LOG = (HIST_C2_BITS-3); - - BOX_C0_ELEMS = (1 shl BOX_C0_LOG); { # of hist cells in update box } - BOX_C1_ELEMS = (1 shl BOX_C1_LOG); - BOX_C2_ELEMS = (1 shl BOX_C2_LOG); - - BOX_C0_SHIFT = (C0_SHIFT + BOX_C0_LOG); - BOX_C1_SHIFT = (C1_SHIFT + BOX_C1_LOG); - BOX_C2_SHIFT = (C2_SHIFT + BOX_C2_LOG); - - -{ The next three routines implement inverse colormap filling. They could - all be folded into one big routine, but splitting them up this way saves - some stack space (the mindist[] and bestdist[] arrays need not coexist) - and may allow some compilers to produce better code by registerizing more - inner-loop variables. } - -{LOCAL} -function find_nearby_colors (cinfo : j_decompress_ptr; - minc0 : int; minc1 : int; minc2 : int; - var colorlist : array of JSAMPLE) : int; -{ Locate the colormap entries close enough to an update box to be candidates - for the nearest entry to some cell(s) in the update box. The update box - is specified by the center coordinates of its first cell. The number of - candidate colormap entries is returned, and their colormap indexes are - placed in colorlist[]. - This routine uses Heckbert's "locally sorted search" criterion to select - the colors that need further consideration. } - -var - numcolors : int; - maxc0, maxc1, maxc2 : int; - centerc0, centerc1, centerc2 : int; - i, x, ncolors : int; - minmaxdist, min_dist, max_dist, tdist : INT32; - mindist : array[0..MAXNUMCOLORS-1] of INT32; - { min distance to colormap entry i } -begin - numcolors := cinfo^.actual_number_of_colors; - - { Compute true coordinates of update box's upper corner and center. - Actually we compute the coordinates of the center of the upper-corner - histogram cell, which are the upper bounds of the volume we care about. - Note that since ">>" rounds down, the "center" values may be closer to - min than to max; hence comparisons to them must be "<=", not "<". } - - maxc0 := minc0 + ((1 shl BOX_C0_SHIFT) - (1 shl C0_SHIFT)); - centerc0 := (minc0 + maxc0) shr 1; - maxc1 := minc1 + ((1 shl BOX_C1_SHIFT) - (1 shl C1_SHIFT)); - centerc1 := (minc1 + maxc1) shr 1; - maxc2 := minc2 + ((1 shl BOX_C2_SHIFT) - (1 shl C2_SHIFT)); - centerc2 := (minc2 + maxc2) shr 1; - - { For each color in colormap, find: - 1. its minimum squared-distance to any point in the update box - (zero if color is within update box); - 2. its maximum squared-distance to any point in the update box. - Both of these can be found by considering only the corners of the box. - We save the minimum distance for each color in mindist[]; - only the smallest maximum distance is of interest. } - - minmaxdist := long($7FFFFFFF); - - for i := 0 to pred(numcolors) do - begin - { We compute the squared-c0-distance term, then add in the other two. } - x := GETJSAMPLE(cinfo^.colormap^[0]^[i]); - if (x < minc0) then - begin - tdist := (x - minc0) * C0_SCALE; - min_dist := tdist*tdist; - tdist := (x - maxc0) * C0_SCALE; - max_dist := tdist*tdist; - end - else - if (x > maxc0) then - begin - tdist := (x - maxc0) * C0_SCALE; - min_dist := tdist*tdist; - tdist := (x - minc0) * C0_SCALE; - max_dist := tdist*tdist; - end - else - begin - { within cell range so no contribution to min_dist } - min_dist := 0; - if (x <= centerc0) then - begin - tdist := (x - maxc0) * C0_SCALE; - max_dist := tdist*tdist; - end - else - begin - tdist := (x - minc0) * C0_SCALE; - max_dist := tdist*tdist; - end; - end; - - x := GETJSAMPLE(cinfo^.colormap^[1]^[i]); - if (x < minc1) then - begin - tdist := (x - minc1) * C1_SCALE; - Inc(min_dist, tdist*tdist); - tdist := (x - maxc1) * C1_SCALE; - Inc(max_dist, tdist*tdist); - end - else - if (x > maxc1) then - begin - tdist := (x - maxc1) * C1_SCALE; - Inc(min_dist, tdist*tdist); - tdist := (x - minc1) * C1_SCALE; - Inc(max_dist, tdist*tdist); - end - else - begin - { within cell range so no contribution to min_dist } - if (x <= centerc1) then - begin - tdist := (x - maxc1) * C1_SCALE; - Inc(max_dist, tdist*tdist); - end - else - begin - tdist := (x - minc1) * C1_SCALE; - Inc(max_dist, tdist*tdist); - end - end; - - x := GETJSAMPLE(cinfo^.colormap^[2]^[i]); - if (x < minc2) then - begin - tdist := (x - minc2) * C2_SCALE; - Inc(min_dist, tdist*tdist); - tdist := (x - maxc2) * C2_SCALE; - Inc(max_dist, tdist*tdist); - end - else - if (x > maxc2) then - begin - tdist := (x - maxc2) * C2_SCALE; - Inc(min_dist, tdist*tdist); - tdist := (x - minc2) * C2_SCALE; - Inc(max_dist, tdist*tdist); - end - else - begin - { within cell range so no contribution to min_dist } - if (x <= centerc2) then - begin - tdist := (x - maxc2) * C2_SCALE; - Inc(max_dist, tdist*tdist); - end - else - begin - tdist := (x - minc2) * C2_SCALE; - Inc(max_dist, tdist*tdist); - end; - end; - - mindist[i] := min_dist; { save away the results } - if (max_dist < minmaxdist) then - minmaxdist := max_dist; - end; - - { Now we know that no cell in the update box is more than minmaxdist - away from some colormap entry. Therefore, only colors that are - within minmaxdist of some part of the box need be considered. } - - ncolors := 0; - for i := 0 to pred(numcolors) do - begin - if (mindist[i] <= minmaxdist) then - begin - colorlist[ncolors] := JSAMPLE(i); - Inc(ncolors); - end; - end; - find_nearby_colors := ncolors; -end; - - -{LOCAL} -procedure find_best_colors (cinfo : j_decompress_ptr; - minc0 : int; minc1 : int; minc2 : int; - numcolors : int; - var colorlist : array of JSAMPLE; - var bestcolor : array of JSAMPLE); -{ Find the closest colormap entry for each cell in the update box, - given the list of candidate colors prepared by find_nearby_colors. - Return the indexes of the closest entries in the bestcolor[] array. - This routine uses Thomas' incremental distance calculation method to - find the distance from a colormap entry to successive cells in the box. } -const - { Nominal steps between cell centers ("x" in Thomas article) } - STEP_C0 = ((1 shl C0_SHIFT) * C0_SCALE); - STEP_C1 = ((1 shl C1_SHIFT) * C1_SCALE); - STEP_C2 = ((1 shl C2_SHIFT) * C2_SCALE); -var - ic0, ic1, ic2 : int; - i, icolor : int; - {register} bptr : INT32PTR; { pointer into bestdist[] array } - cptr : JSAMPLE_PTR; { pointer into bestcolor[] array } - dist0, dist1 : INT32; { initial distance values } - {register} dist2 : INT32; { current distance in inner loop } - xx0, xx1 : INT32; { distance increments } - {register} xx2 : INT32; - inc0, inc1, inc2 : INT32; { initial values for increments } - { This array holds the distance to the nearest-so-far color for each cell } - bestdist : array[0..BOX_C0_ELEMS * BOX_C1_ELEMS * BOX_C2_ELEMS-1] of INT32; -begin - { Initialize best-distance for each cell of the update box } - for i := BOX_C0_ELEMS*BOX_C1_ELEMS*BOX_C2_ELEMS-1 downto 0 do - bestdist[i] := $7FFFFFFF; - - { For each color selected by find_nearby_colors, - compute its distance to the center of each cell in the box. - If that's less than best-so-far, update best distance and color number. } - - - - for i := 0 to pred(numcolors) do - begin - icolor := GETJSAMPLE(colorlist[i]); - { Compute (square of) distance from minc0/c1/c2 to this color } - inc0 := (minc0 - GETJSAMPLE(cinfo^.colormap^[0]^[icolor])) * C0_SCALE; - dist0 := inc0*inc0; - inc1 := (minc1 - GETJSAMPLE(cinfo^.colormap^[1]^[icolor])) * C1_SCALE; - Inc(dist0, inc1*inc1); - inc2 := (minc2 - GETJSAMPLE(cinfo^.colormap^[2]^[icolor])) * C2_SCALE; - Inc(dist0, inc2*inc2); - { Form the initial difference increments } - inc0 := inc0 * (2 * STEP_C0) + STEP_C0 * STEP_C0; - inc1 := inc1 * (2 * STEP_C1) + STEP_C1 * STEP_C1; - inc2 := inc2 * (2 * STEP_C2) + STEP_C2 * STEP_C2; - { Now loop over all cells in box, updating distance per Thomas method } - bptr := @bestdist[0]; - cptr := @bestcolor[0]; - xx0 := inc0; - for ic0 := BOX_C0_ELEMS-1 downto 0 do - begin - dist1 := dist0; - xx1 := inc1; - for ic1 := BOX_C1_ELEMS-1 downto 0 do - begin - dist2 := dist1; - xx2 := inc2; - for ic2 := BOX_C2_ELEMS-1 downto 0 do - begin - if (dist2 < bptr^) then - begin - bptr^ := dist2; - cptr^ := JSAMPLE (icolor); - end; - Inc(dist2, xx2); - Inc(xx2, 2 * STEP_C2 * STEP_C2); - Inc(bptr); - Inc(cptr); - end; - Inc(dist1, xx1); - Inc(xx1, 2 * STEP_C1 * STEP_C1); - end; - Inc(dist0, xx0); - Inc(xx0, 2 * STEP_C0 * STEP_C0); - end; - end; -end; - - -{LOCAL} -procedure fill_inverse_cmap (cinfo : j_decompress_ptr; - c0 : int; c1 : int; c2 : int); -{ Fill the inverse-colormap entries in the update box that contains } -{ histogram cell c0/c1/c2. (Only that one cell MUST be filled, but } -{ we can fill as many others as we wish.) } -var - cquantize : my_cquantize_ptr; - histogram : hist3d; - minc0, minc1, minc2 : int; { lower left corner of update box } - ic0, ic1, ic2 : int; - {register} cptr : JSAMPLE_PTR; { pointer into bestcolor[] array } - {register} cachep : histptr; { pointer into main cache array } - { This array lists the candidate colormap indexes. } - colorlist : array[0..MAXNUMCOLORS-1] of JSAMPLE; - numcolors : int; { number of candidate colors } - { This array holds the actually closest colormap index for each cell. } - bestcolor : array[0..BOX_C0_ELEMS * BOX_C1_ELEMS * BOX_C2_ELEMS-1] of JSAMPLE; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - histogram := cquantize^.histogram; - - { Convert cell coordinates to update box ID } - c0 := c0 shr BOX_C0_LOG; - c1 := c1 shr BOX_C1_LOG; - c2 := c2 shr BOX_C2_LOG; - - { Compute true coordinates of update box's origin corner. - Actually we compute the coordinates of the center of the corner - histogram cell, which are the lower bounds of the volume we care about.} - - minc0 := (c0 shl BOX_C0_SHIFT) + ((1 shl C0_SHIFT) shr 1); - minc1 := (c1 shl BOX_C1_SHIFT) + ((1 shl C1_SHIFT) shr 1); - minc2 := (c2 shl BOX_C2_SHIFT) + ((1 shl C2_SHIFT) shr 1); - - { Determine which colormap entries are close enough to be candidates - for the nearest entry to some cell in the update box. } - - numcolors := find_nearby_colors(cinfo, minc0, minc1, minc2, colorlist); - - { Determine the actually nearest colors. } - find_best_colors(cinfo, minc0, minc1, minc2, numcolors, colorlist, - bestcolor); - - { Save the best color numbers (plus 1) in the main cache array } - c0 := c0 shl BOX_C0_LOG; { convert ID back to base cell indexes } - c1 := c1 shl BOX_C1_LOG; - c2 := c2 shl BOX_C2_LOG; - cptr := @(bestcolor[0]); - for ic0 := 0 to pred(BOX_C0_ELEMS) do - for ic1 := 0 to pred(BOX_C1_ELEMS) do - begin - cachep := @(histogram^[c0+ic0]^[c1+ic1][c2]); - for ic2 := 0 to pred(BOX_C2_ELEMS) do - begin - cachep^ := histcell (GETJSAMPLE(cptr^) + 1); - Inc(cachep); - Inc(cptr); - end; - end; -end; - - -{ Map some rows of pixels to the output colormapped representation. } - -{METHODDEF} -procedure pass2_no_dither (cinfo : j_decompress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPARRAY; - num_rows : int); -{ This version performs no dithering } -var - cquantize : my_cquantize_ptr; - histogram : hist3d; - {register} inptr : RGBptr; - outptr : JSAMPLE_PTR; - {register} cachep : histptr; - {register} c0, c1, c2 : int; - row : int; - col : JDIMENSION; - width : JDIMENSION; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - histogram := cquantize^.histogram; - width := cinfo^.output_width; - - for row := 0 to pred(num_rows) do - begin - inptr := RGBptr(input_buf^[row]); - outptr := JSAMPLE_PTR(output_buf^[row]); - for col := pred(width) downto 0 do - begin - { get pixel value and index into the cache } - c0 := GETJSAMPLE(inptr^.r) shr C0_SHIFT; - c1 := GETJSAMPLE(inptr^.g) shr C1_SHIFT; - c2 := GETJSAMPLE(inptr^.b) shr C2_SHIFT; - Inc(inptr); - cachep := @(histogram^[c0]^[c1][c2]); - { If we have not seen this color before, find nearest colormap entry } - { and update the cache } - if (cachep^ = 0) then - fill_inverse_cmap(cinfo, c0,c1,c2); - { Now emit the colormap index for this cell } - outptr^ := JSAMPLE (cachep^ - 1); - Inc(outptr); - end; - end; -end; - - -{METHODDEF} -procedure pass2_fs_dither (cinfo : j_decompress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPARRAY; - num_rows : int); -{ This version performs Floyd-Steinberg dithering } -var - cquantize : my_cquantize_ptr; - histogram : hist3d; - {register} cur : LOCRGB_FSERROR; { current error or pixel value } - belowerr : LOCRGB_FSERROR; { error for pixel below cur } - bpreverr : LOCRGB_FSERROR; { error for below/prev col } - prev_errorptr, - {register} errorptr : RGB_FSERROR_PTR; { => fserrors[] at column before current } - inptr : RGBptr; { => current input pixel } - outptr : JSAMPLE_PTR; { => current output pixel } - cachep : histptr; - dir : int; { +1 or -1 depending on direction } - row : int; - col : JDIMENSION; - width : JDIMENSION; - range_limit : range_limit_table_ptr; - error_limit : error_limit_ptr; - colormap0 : JSAMPROW; - colormap1 : JSAMPROW; - colormap2 : JSAMPROW; - {register} pixcode : int; - {register} bnexterr, delta : LOCFSERROR; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - histogram := cquantize^.histogram; - width := cinfo^.output_width; - range_limit := cinfo^.sample_range_limit; - error_limit := cquantize^.error_limiter; - colormap0 := cinfo^.colormap^[0]; - colormap1 := cinfo^.colormap^[1]; - colormap2 := cinfo^.colormap^[2]; - - for row := 0 to pred(num_rows) do - begin - inptr := RGBptr(input_buf^[row]); - outptr := JSAMPLE_PTR(output_buf^[row]); - errorptr := RGB_FSERROR_PTR(cquantize^.fserrors); { => entry before first real column } - if (cquantize^.on_odd_row) then - begin - { work right to left in this row } - Inc(inptr, (width-1)); { so point to rightmost pixel } - Inc(outptr, width-1); - dir := -1; - Inc(errorptr, (width+1)); { => entry after last column } - cquantize^.on_odd_row := FALSE; { flip for next time } - end - else - begin - { work left to right in this row } - dir := 1; - cquantize^.on_odd_row := TRUE; { flip for next time } - end; - - { Preset error values: no error propagated to first pixel from left } - cur.r := 0; - cur.g := 0; - cur.b := 0; - { and no error propagated to row below yet } - belowerr.r := 0; - belowerr.g := 0; - belowerr.b := 0; - bpreverr.r := 0; - bpreverr.g := 0; - bpreverr.b := 0; - - for col := pred(width) downto 0 do - begin - prev_errorptr := errorptr; - Inc(errorptr, dir); { advance errorptr to current column } - - { curN holds the error propagated from the previous pixel on the - current line. Add the error propagated from the previous line - to form the complete error correction term for this pixel, and - round the error term (which is expressed * 16) to an integer. - RIGHT_SHIFT rounds towards minus infinity, so adding 8 is correct - for either sign of the error value. - Note: prev_errorptr points to *previous* column's array entry. } - - { Nomssi Note: Borland Pascal SHR is unsigned } - cur.r := (cur.r + errorptr^.r + 8) div 16; - cur.g := (cur.g + errorptr^.g + 8) div 16; - cur.b := (cur.b + errorptr^.b + 8) div 16; - { Limit the error using transfer function set by init_error_limit. - See comments with init_error_limit for rationale. } - - cur.r := error_limit^[cur.r]; - cur.g := error_limit^[cur.g]; - cur.b := error_limit^[cur.b]; - { Form pixel value + error, and range-limit to 0..MAXJSAMPLE. - The maximum error is +- MAXJSAMPLE (or less with error limiting); - this sets the required size of the range_limit array. } - - Inc(cur.r, GETJSAMPLE(inptr^.r)); - Inc(cur.g, GETJSAMPLE(inptr^.g)); - Inc(cur.b, GETJSAMPLE(inptr^.b)); - - cur.r := GETJSAMPLE(range_limit^[cur.r]); - cur.g := GETJSAMPLE(range_limit^[cur.g]); - cur.b := GETJSAMPLE(range_limit^[cur.b]); - { Index into the cache with adjusted pixel value } - cachep := @(histogram^[cur.r shr C0_SHIFT]^ - [cur.g shr C1_SHIFT][cur.b shr C2_SHIFT]); - { If we have not seen this color before, find nearest colormap } - { entry and update the cache } - if (cachep^ = 0) then - fill_inverse_cmap(cinfo, cur.r shr C0_SHIFT, - cur.g shr C1_SHIFT, - cur.b shr C2_SHIFT); - { Now emit the colormap index for this cell } - - pixcode := cachep^ - 1; - outptr^ := JSAMPLE (pixcode); - - { Compute representation error for this pixel } - Dec(cur.r, GETJSAMPLE(colormap0^[pixcode])); - Dec(cur.g, GETJSAMPLE(colormap1^[pixcode])); - Dec(cur.b, GETJSAMPLE(colormap2^[pixcode])); - - { Compute error fractions to be propagated to adjacent pixels. - Add these into the running sums, and simultaneously shift the - next-line error sums left by 1 column. } - - bnexterr := cur.r; { Process component 0 } - delta := cur.r * 2; - Inc(cur.r, delta); { form error * 3 } - prev_errorptr^.r := FSERROR (bpreverr.r + cur.r); - Inc(cur.r, delta); { form error * 5 } - bpreverr.r := belowerr.r + cur.r; - belowerr.r := bnexterr; - Inc(cur.r, delta); { form error * 7 } - bnexterr := cur.g; { Process component 1 } - delta := cur.g * 2; - Inc(cur.g, delta); { form error * 3 } - prev_errorptr^.g := FSERROR (bpreverr.g + cur.g); - Inc(cur.g, delta); { form error * 5 } - bpreverr.g := belowerr.g + cur.g; - belowerr.g := bnexterr; - Inc(cur.g, delta); { form error * 7 } - bnexterr := cur.b; { Process component 2 } - delta := cur.b * 2; - Inc(cur.b, delta); { form error * 3 } - prev_errorptr^.b := FSERROR (bpreverr.b + cur.b); - Inc(cur.b, delta); { form error * 5 } - bpreverr.b := belowerr.b + cur.b; - belowerr.b := bnexterr; - Inc(cur.b, delta); { form error * 7 } - - { At this point curN contains the 7/16 error value to be propagated - to the next pixel on the current line, and all the errors for the - next line have been shifted over. We are therefore ready to move on.} - - Inc(inptr, dir); { Advance pixel pointers to next column } - Inc(outptr, dir); - end; - { Post-loop cleanup: we must unload the final error values into the - final fserrors[] entry. Note we need not unload belowerrN because - it is for the dummy column before or after the actual array. } - - errorptr^.r := FSERROR (bpreverr.r); { unload prev errs into array } - errorptr^.g := FSERROR (bpreverr.g); - errorptr^.b := FSERROR (bpreverr.b); - end; -end; - - -{ Initialize the error-limiting transfer function (lookup table). - The raw F-S error computation can potentially compute error values of up to - +- MAXJSAMPLE. But we want the maximum correction applied to a pixel to be - much less, otherwise obviously wrong pixels will be created. (Typical - effects include weird fringes at color-area boundaries, isolated bright - pixels in a dark area, etc.) The standard advice for avoiding this problem - is to ensure that the "corners" of the color cube are allocated as output - colors; then repeated errors in the same direction cannot cause cascading - error buildup. However, that only prevents the error from getting - completely out of hand; Aaron Giles reports that error limiting improves - the results even with corner colors allocated. - A simple clamping of the error values to about +- MAXJSAMPLE/8 works pretty - well, but the smoother transfer function used below is even better. Thanks - to Aaron Giles for this idea. } - -{LOCAL} -procedure init_error_limit (cinfo : j_decompress_ptr); -const - STEPSIZE = ((MAXJSAMPLE+1) div 16); -{ Allocate and fill in the error_limiter table } -var - cquantize : my_cquantize_ptr; - table : error_limit_ptr; - inp, out : int; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - table := error_limit_ptr (cinfo^.mem^.alloc_small - (j_common_ptr (cinfo), JPOOL_IMAGE, (MAXJSAMPLE*2+1) * SIZEOF(int))); - { not needed: Inc(table, MAXJSAMPLE); - so can index -MAXJSAMPLE .. +MAXJSAMPLE } - cquantize^.error_limiter := table; - { Map errors 1:1 up to +- MAXJSAMPLE/16 } - out := 0; - for inp := 0 to pred(STEPSIZE) do - begin - table^[inp] := out; - table^[-inp] := -out; - Inc(out); - end; - { Map errors 1:2 up to +- 3*MAXJSAMPLE/16 } - inp := STEPSIZE; { Nomssi: avoid problems with Delphi2 optimizer } - while (inp < STEPSIZE*3) do - begin - table^[inp] := out; - table^[-inp] := -out; - Inc(inp); - if Odd(inp) then - Inc(out); - end; - { Clamp the rest to final out value (which is (MAXJSAMPLE+1)/8) } - inp := STEPSIZE*3; { Nomssi: avoid problems with Delphi 2 optimizer } - while inp <= MAXJSAMPLE do - begin - table^[inp] := out; - table^[-inp] := -out; - Inc(inp); - end; -end; - -{ Finish up at the end of each pass. } - -{METHODDEF} -procedure finish_pass1 (cinfo : j_decompress_ptr); -var - cquantize : my_cquantize_ptr; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - - { Select the representative colors and fill in cinfo^.colormap } - cinfo^.colormap := cquantize^.sv_colormap; - select_colors(cinfo, cquantize^.desired); - { Force next pass to zero the color index table } - cquantize^.needs_zeroed := TRUE; -end; - - -{METHODDEF} -procedure finish_pass2 (cinfo : j_decompress_ptr); -begin - { no work } -end; - - -{ Initialize for each processing pass. } - -{METHODDEF} -procedure start_pass_2_quant (cinfo : j_decompress_ptr; - is_pre_scan : boolean); -var - cquantize : my_cquantize_ptr; - histogram : hist3d; - i : int; -var - arraysize : size_t; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - histogram := cquantize^.histogram; - { Only F-S dithering or no dithering is supported. } - { If user asks for ordered dither, give him F-S. } - if (cinfo^.dither_mode <> JDITHER_NONE) then - cinfo^.dither_mode := JDITHER_FS; - - if (is_pre_scan) then - begin - { Set up method pointers } - cquantize^.pub.color_quantize := prescan_quantize; - cquantize^.pub.finish_pass := finish_pass1; - cquantize^.needs_zeroed := TRUE; { Always zero histogram } - end - else - begin - { Set up method pointers } - if (cinfo^.dither_mode = JDITHER_FS) then - cquantize^.pub.color_quantize := pass2_fs_dither - else - cquantize^.pub.color_quantize := pass2_no_dither; - cquantize^.pub.finish_pass := finish_pass2; - - { Make sure color count is acceptable } - i := cinfo^.actual_number_of_colors; - if (i < 1) then - ERREXIT1(j_common_ptr(cinfo), JERR_QUANT_FEW_COLORS, 1); - if (i > MAXNUMCOLORS) then - ERREXIT1(j_common_ptr(cinfo), JERR_QUANT_MANY_COLORS, MAXNUMCOLORS); - - if (cinfo^.dither_mode = JDITHER_FS) then - begin - arraysize := size_t ((cinfo^.output_width + 2) * - (3 * SIZEOF(FSERROR))); - { Allocate Floyd-Steinberg workspace if we didn't already. } - if (cquantize^.fserrors = NIL) then - cquantize^.fserrors := FS_ERROR_FIELD_PTR (cinfo^.mem^.alloc_large - (j_common_ptr(cinfo), JPOOL_IMAGE, arraysize)); - { Initialize the propagated errors to zero. } - jzero_far(cquantize^.fserrors, arraysize); - { Make the error-limit table if we didn't already. } - if (cquantize^.error_limiter = NIL) then - init_error_limit(cinfo); - cquantize^.on_odd_row := FALSE; - end; - - end; - { Zero the histogram or inverse color map, if necessary } - if (cquantize^.needs_zeroed) then - begin - for i := 0 to pred(HIST_C0_ELEMS) do - begin - jzero_far( histogram^[i], - HIST_C1_ELEMS*HIST_C2_ELEMS * SIZEOF(histcell)); - end; - cquantize^.needs_zeroed := FALSE; - end; -end; - - -{ Switch to a new external colormap between output passes. } - -{METHODDEF} -procedure new_color_map_2_quant (cinfo : j_decompress_ptr); -var - cquantize : my_cquantize_ptr; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - - { Reset the inverse color map } - cquantize^.needs_zeroed := TRUE; -end; - - -{ Module initialization routine for 2-pass color quantization. } - - -{GLOBAL} -procedure jinit_2pass_quantizer (cinfo : j_decompress_ptr); -var - cquantize : my_cquantize_ptr; - i : int; -var - desired : int; -begin - cquantize := my_cquantize_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_cquantizer))); - cinfo^.cquantize := jpeg_color_quantizer_ptr(cquantize); - cquantize^.pub.start_pass := start_pass_2_quant; - cquantize^.pub.new_color_map := new_color_map_2_quant; - cquantize^.fserrors := NIL; { flag optional arrays not allocated } - cquantize^.error_limiter := NIL; - - { Make sure jdmaster didn't give me a case I can't handle } - if (cinfo^.out_color_components <> 3) then - ERREXIT(j_common_ptr(cinfo), JERR_NOTIMPL); - - { Allocate the histogram/inverse colormap storage } - cquantize^.histogram := hist3d (cinfo^.mem^.alloc_small - (j_common_ptr (cinfo), JPOOL_IMAGE, HIST_C0_ELEMS * SIZEOF(hist2d))); - for i := 0 to pred(HIST_C0_ELEMS) do - begin - cquantize^.histogram^[i] := hist2d (cinfo^.mem^.alloc_large - (j_common_ptr (cinfo), JPOOL_IMAGE, - HIST_C1_ELEMS*HIST_C2_ELEMS * SIZEOF(histcell))); - end; - cquantize^.needs_zeroed := TRUE; { histogram is garbage now } - - { Allocate storage for the completed colormap, if required. - We do this now since it is FAR storage and may affect - the memory manager's space calculations. } - - if (cinfo^.enable_2pass_quant) then - begin - { Make sure color count is acceptable } - desired := cinfo^.desired_number_of_colors; - { Lower bound on # of colors ... somewhat arbitrary as long as > 0 } - if (desired < 8) then - ERREXIT1(j_common_ptr (cinfo), JERR_QUANT_FEW_COLORS, 8); - { Make sure colormap indexes can be represented by JSAMPLEs } - if (desired > MAXNUMCOLORS) then - ERREXIT1(j_common_ptr (cinfo), JERR_QUANT_MANY_COLORS, MAXNUMCOLORS); - cquantize^.sv_colormap := cinfo^.mem^.alloc_sarray - (j_common_ptr (cinfo),JPOOL_IMAGE, JDIMENSION(desired), JDIMENSION(3)); - cquantize^.desired := desired; - end - else - cquantize^.sv_colormap := NIL; - - { Only F-S dithering or no dithering is supported. } - { If user asks for ordered dither, give him F-S. } - if (cinfo^.dither_mode <> JDITHER_NONE) then - cinfo^.dither_mode := JDITHER_FS; - - { Allocate Floyd-Steinberg workspace if necessary. - This isn't really needed until pass 2, but again it is FAR storage. - Although we will cope with a later change in dither_mode, - we do not promise to honor max_memory_to_use if dither_mode changes. } - - if (cinfo^.dither_mode = JDITHER_FS) then - begin - cquantize^.fserrors := FS_ERROR_FIELD_PTR (cinfo^.mem^.alloc_large - (j_common_ptr(cinfo), JPOOL_IMAGE, - size_t ((cinfo^.output_width + 2) * (3 * SIZEOF(FSERROR))) ) ); - { Might as well create the error-limiting table too. } - init_error_limit(cinfo); - end; -end; -{ QUANT_2PASS_SUPPORTED } -end. +unit imjquant2; + + +{ This file contains 2-pass color quantization (color mapping) routines. + These routines provide selection of a custom color map for an image, + followed by mapping of the image to that color map, with optional + Floyd-Steinberg dithering. + It is also possible to use just the second pass to map to an arbitrary + externally-given color map. + + Note: ordered dithering is not supported, since there isn't any fast + way to compute intercolor distances; it's unclear that ordered dither's + fundamental assumptions even hold with an irregularly spaced color map. } + +{ Original: jquant2.c; Copyright (C) 1991-1996, Thomas G. Lane. } + +interface + +{$I imjconfig.inc} + +uses + imjmorecfg, + imjdeferr, + imjerror, + imjutils, + imjpeglib; + +{ Module initialization routine for 2-pass color quantization. } + + +{GLOBAL} +procedure jinit_2pass_quantizer (cinfo : j_decompress_ptr); + +implementation + +{ This module implements the well-known Heckbert paradigm for color + quantization. Most of the ideas used here can be traced back to + Heckbert's seminal paper + Heckbert, Paul. "Color Image Quantization for Frame Buffer Display", + Proc. SIGGRAPH '82, Computer Graphics v.16 #3 (July 1982), pp 297-304. + + In the first pass over the image, we accumulate a histogram showing the + usage count of each possible color. To keep the histogram to a reasonable + size, we reduce the precision of the input; typical practice is to retain + 5 or 6 bits per color, so that 8 or 4 different input values are counted + in the same histogram cell. + + Next, the color-selection step begins with a box representing the whole + color space, and repeatedly splits the "largest" remaining box until we + have as many boxes as desired colors. Then the mean color in each + remaining box becomes one of the possible output colors. + + The second pass over the image maps each input pixel to the closest output + color (optionally after applying a Floyd-Steinberg dithering correction). + This mapping is logically trivial, but making it go fast enough requires + considerable care. + + Heckbert-style quantizers vary a good deal in their policies for choosing + the "largest" box and deciding where to cut it. The particular policies + used here have proved out well in experimental comparisons, but better ones + may yet be found. + + In earlier versions of the IJG code, this module quantized in YCbCr color + space, processing the raw upsampled data without a color conversion step. + This allowed the color conversion math to be done only once per colormap + entry, not once per pixel. However, that optimization precluded other + useful optimizations (such as merging color conversion with upsampling) + and it also interfered with desired capabilities such as quantizing to an + externally-supplied colormap. We have therefore abandoned that approach. + The present code works in the post-conversion color space, typically RGB. + + To improve the visual quality of the results, we actually work in scaled + RGB space, giving G distances more weight than R, and R in turn more than + B. To do everything in integer math, we must use integer scale factors. + The 2/3/1 scale factors used here correspond loosely to the relative + weights of the colors in the NTSC grayscale equation. + If you want to use this code to quantize a non-RGB color space, you'll + probably need to change these scale factors. } + +const + R_SCALE = 2; { scale R distances by this much } + G_SCALE = 3; { scale G distances by this much } + B_SCALE = 1; { and B by this much } + +{ Relabel R/G/B as components 0/1/2, respecting the RGB ordering defined + in jmorecfg.h. As the code stands, it will do the right thing for R,G,B + and B,G,R orders. If you define some other weird order in jmorecfg.h, + you'll get compile errors until you extend this logic. In that case + you'll probably want to tweak the histogram sizes too. } + +{$ifdef RGB_RED_IS_0} +const + C0_SCALE = R_SCALE; + C1_SCALE = G_SCALE; + C2_SCALE = B_SCALE; +{$else} +const + C0_SCALE = B_SCALE; + C1_SCALE = G_SCALE; + C2_SCALE = R_SCALE; +{$endif} + + +{ First we have the histogram data structure and routines for creating it. + + The number of bits of precision can be adjusted by changing these symbols. + We recommend keeping 6 bits for G and 5 each for R and B. + If you have plenty of memory and cycles, 6 bits all around gives marginally + better results; if you are short of memory, 5 bits all around will save + some space but degrade the results. + To maintain a fully accurate histogram, we'd need to allocate a "long" + (preferably unsigned long) for each cell. In practice this is overkill; + we can get by with 16 bits per cell. Few of the cell counts will overflow, + and clamping those that do overflow to the maximum value will give close- + enough results. This reduces the recommended histogram size from 256Kb + to 128Kb, which is a useful savings on PC-class machines. + (In the second pass the histogram space is re-used for pixel mapping data; + in that capacity, each cell must be able to store zero to the number of + desired colors. 16 bits/cell is plenty for that too.) + Since the JPEG code is intended to run in small memory model on 80x86 + machines, we can't just allocate the histogram in one chunk. Instead + of a true 3-D array, we use a row of pointers to 2-D arrays. Each + pointer corresponds to a C0 value (typically 2^5 = 32 pointers) and + each 2-D array has 2^6*2^5 = 2048 or 2^6*2^6 = 4096 entries. Note that + on 80x86 machines, the pointer row is in near memory but the actual + arrays are in far memory (same arrangement as we use for image arrays). } + + +const + MAXNUMCOLORS = (MAXJSAMPLE+1); { maximum size of colormap } + +{ These will do the right thing for either R,G,B or B,G,R color order, + but you may not like the results for other color orders. } + +const + HIST_C0_BITS = 5; { bits of precision in R/B histogram } + HIST_C1_BITS = 6; { bits of precision in G histogram } + HIST_C2_BITS = 5; { bits of precision in B/R histogram } + +{ Number of elements along histogram axes. } +const + HIST_C0_ELEMS = (1 shl HIST_C0_BITS); + HIST_C1_ELEMS = (1 shl HIST_C1_BITS); + HIST_C2_ELEMS = (1 shl HIST_C2_BITS); + +{ These are the amounts to shift an input value to get a histogram index. } +const + C0_SHIFT = (BITS_IN_JSAMPLE-HIST_C0_BITS); + C1_SHIFT = (BITS_IN_JSAMPLE-HIST_C1_BITS); + C2_SHIFT = (BITS_IN_JSAMPLE-HIST_C2_BITS); + + +type { Nomssi } + RGBptr = ^RGBtype; + RGBtype = packed record + r,g,b : JSAMPLE; + end; +type + histcell = UINT16; { histogram cell; prefer an unsigned type } + +type + histptr = ^histcell {FAR}; { for pointers to histogram cells } + +type + hist1d = array[0..HIST_C2_ELEMS-1] of histcell; { typedefs for the array } + {hist1d_ptr = ^hist1d;} + hist1d_field = array[0..HIST_C1_ELEMS-1] of hist1d; + { type for the 2nd-level pointers } + hist2d = ^hist1d_field; + hist2d_field = array[0..HIST_C0_ELEMS-1] of hist2d; + hist3d = ^hist2d_field; { type for top-level pointer } + + +{ Declarations for Floyd-Steinberg dithering. + + Errors are accumulated into the array fserrors[], at a resolution of + 1/16th of a pixel count. The error at a given pixel is propagated + to its not-yet-processed neighbors using the standard F-S fractions, + ... (here) 7/16 + 3/16 5/16 1/16 + We work left-to-right on even rows, right-to-left on odd rows. + + We can get away with a single array (holding one row's worth of errors) + by using it to store the current row's errors at pixel columns not yet + processed, but the next row's errors at columns already processed. We + need only a few extra variables to hold the errors immediately around the + current column. (If we are lucky, those variables are in registers, but + even if not, they're probably cheaper to access than array elements are.) + + The fserrors[] array has (#columns + 2) entries; the extra entry at + each end saves us from special-casing the first and last pixels. + Each entry is three values long, one value for each color component. + + Note: on a wide image, we might not have enough room in a PC's near data + segment to hold the error array; so it is allocated with alloc_large. } + + +{$ifdef BITS_IN_JSAMPLE_IS_8} +type + FSERROR = INT16; { 16 bits should be enough } + LOCFSERROR = int; { use 'int' for calculation temps } +{$else} +type + FSERROR = INT32; { may need more than 16 bits } + LOCFSERROR = INT32; { be sure calculation temps are big enough } +{$endif} +type { Nomssi } + RGB_FSERROR_PTR = ^RGB_FSERROR; + RGB_FSERROR = packed record + r,g,b : FSERROR; + end; + LOCRGB_FSERROR = packed record + r,g,b : LOCFSERROR; + end; + +type + FSERROR_PTR = ^FSERROR; + jFSError = 0..(MaxInt div SIZEOF(RGB_FSERROR))-1; + FS_ERROR_FIELD = array[jFSError] of RGB_FSERROR; + FS_ERROR_FIELD_PTR = ^FS_ERROR_FIELD;{far} + { pointer to error array (in FAR storage!) } + +type + error_limit_array = array[-MAXJSAMPLE..MAXJSAMPLE] of int; + { table for clamping the applied error } + error_limit_ptr = ^error_limit_array; + +{ Private subobject } +type + my_cquantize_ptr = ^my_cquantizer; + my_cquantizer = record + pub : jpeg_color_quantizer; { public fields } + + { Space for the eventually created colormap is stashed here } + sv_colormap : JSAMPARRAY; { colormap allocated at init time } + desired : int; { desired # of colors = size of colormap } + + { Variables for accumulating image statistics } + histogram : hist3d; { pointer to the histogram } + + needs_zeroed : boolean; { TRUE if next pass must zero histogram } + + { Variables for Floyd-Steinberg dithering } + fserrors : FS_ERROR_FIELD_PTR; { accumulated errors } + on_odd_row : boolean; { flag to remember which row we are on } + error_limiter : error_limit_ptr; { table for clamping the applied error } + end; + + + +{ Prescan some rows of pixels. + In this module the prescan simply updates the histogram, which has been + initialized to zeroes by start_pass. + An output_buf parameter is required by the method signature, but no data + is actually output (in fact the buffer controller is probably passing a + NIL pointer). } + +{METHODDEF} +procedure prescan_quantize (cinfo : j_decompress_ptr; + input_buf : JSAMPARRAY; + output_buf : JSAMPARRAY; + num_rows : int); +var + cquantize : my_cquantize_ptr; + {register} ptr : RGBptr; + {register} histp : histptr; + {register} histogram : hist3d; + row : int; + col : JDIMENSION; + width : JDIMENSION; +begin + cquantize := my_cquantize_ptr(cinfo^.cquantize); + histogram := cquantize^.histogram; + width := cinfo^.output_width; + + for row := 0 to pred(num_rows) do + begin + ptr := RGBptr(input_buf^[row]); + for col := pred(width) downto 0 do + begin + { get pixel value and index into the histogram } + histp := @(histogram^[GETJSAMPLE(ptr^.r) shr C0_SHIFT]^ + [GETJSAMPLE(ptr^.g) shr C1_SHIFT] + [GETJSAMPLE(ptr^.b) shr C2_SHIFT]); + { increment, check for overflow and undo increment if so. } + Inc(histp^); + if (histp^ <= 0) then + Dec(histp^); + Inc(ptr); + end; + end; +end; + +{ Next we have the really interesting routines: selection of a colormap + given the completed histogram. + These routines work with a list of "boxes", each representing a rectangular + subset of the input color space (to histogram precision). } + +type + box = record + { The bounds of the box (inclusive); expressed as histogram indexes } + c0min, c0max : int; + c1min, c1max : int; + c2min, c2max : int; + { The volume (actually 2-norm) of the box } + volume : INT32; + { The number of nonzero histogram cells within this box } + colorcount : long; + end; + +type + jBoxList = 0..(MaxInt div SizeOf(box))-1; + box_field = array[jBoxlist] of box; + boxlistptr = ^box_field; + boxptr = ^box; + +{LOCAL} +function find_biggest_color_pop (boxlist : boxlistptr; numboxes : int) : boxptr; +{ Find the splittable box with the largest color population } +{ Returns NIL if no splittable boxes remain } +var + boxp : boxptr ; {register} + i : int; {register} + maxc : long; {register} + which : boxptr; +begin + which := NIL; + boxp := @(boxlist^[0]); + maxc := 0; + for i := 0 to pred(numboxes) do + begin + if (boxp^.colorcount > maxc) and (boxp^.volume > 0) then + begin + which := boxp; + maxc := boxp^.colorcount; + end; + Inc(boxp); + end; + find_biggest_color_pop := which; +end; + + +{LOCAL} +function find_biggest_volume (boxlist : boxlistptr; numboxes : int) : boxptr; +{ Find the splittable box with the largest (scaled) volume } +{ Returns NULL if no splittable boxes remain } +var + {register} boxp : boxptr; + {register} i : int; + {register} maxv : INT32; + which : boxptr; +begin + maxv := 0; + which := NIL; + boxp := @(boxlist^[0]); + for i := 0 to pred(numboxes) do + begin + if (boxp^.volume > maxv) then + begin + which := boxp; + maxv := boxp^.volume; + end; + Inc(boxp); + end; + find_biggest_volume := which; +end; + + +{LOCAL} +procedure update_box (cinfo : j_decompress_ptr; var boxp : box); +label + have_c0min, have_c0max, + have_c1min, have_c1max, + have_c2min, have_c2max; +{ Shrink the min/max bounds of a box to enclose only nonzero elements, } +{ and recompute its volume and population } +var + cquantize : my_cquantize_ptr; + histogram : hist3d; + histp : histptr; + c0,c1,c2 : int; + c0min,c0max,c1min,c1max,c2min,c2max : int; + dist0,dist1,dist2 : INT32; + ccount : long; +begin + cquantize := my_cquantize_ptr(cinfo^.cquantize); + histogram := cquantize^.histogram; + + c0min := boxp.c0min; c0max := boxp.c0max; + c1min := boxp.c1min; c1max := boxp.c1max; + c2min := boxp.c2min; c2max := boxp.c2max; + + if (c0max > c0min) then + for c0 := c0min to c0max do + for c1 := c1min to c1max do + begin + histp := @(histogram^[c0]^[c1][c2min]); + for c2 := c2min to c2max do + begin + if (histp^ <> 0) then + begin + c0min := c0; + boxp.c0min := c0min; + goto have_c0min; + end; + Inc(histp); + end; + end; + have_c0min: + if (c0max > c0min) then + for c0 := c0max downto c0min do + for c1 := c1min to c1max do + begin + histp := @(histogram^[c0]^[c1][c2min]); + for c2 := c2min to c2max do + begin + if ( histp^ <> 0) then + begin + c0max := c0; + boxp.c0max := c0; + goto have_c0max; + end; + Inc(histp); + end; + end; + have_c0max: + if (c1max > c1min) then + for c1 := c1min to c1max do + for c0 := c0min to c0max do + begin + histp := @(histogram^[c0]^[c1][c2min]); + for c2 := c2min to c2max do + begin + if (histp^ <> 0) then + begin + c1min := c1; + boxp.c1min := c1; + goto have_c1min; + end; + Inc(histp); + end; + end; + have_c1min: + if (c1max > c1min) then + for c1 := c1max downto c1min do + for c0 := c0min to c0max do + begin + histp := @(histogram^[c0]^[c1][c2min]); + for c2 := c2min to c2max do + begin + if (histp^ <> 0) then + begin + c1max := c1; + boxp.c1max := c1; + goto have_c1max; + end; + Inc(histp); + end; + end; + have_c1max: + if (c2max > c2min) then + for c2 := c2min to c2max do + for c0 := c0min to c0max do + begin + histp := @(histogram^[c0]^[c1min][c2]); + for c1 := c1min to c1max do + begin + if (histp^ <> 0) then + begin + c2min := c2; + boxp.c2min := c2min; + goto have_c2min; + end; + Inc(histp, HIST_C2_ELEMS); + end; + end; + have_c2min: + if (c2max > c2min) then + for c2 := c2max downto c2min do + for c0 := c0min to c0max do + begin + histp := @(histogram^[c0]^[c1min][c2]); + for c1 := c1min to c1max do + begin + if (histp^ <> 0) then + begin + c2max := c2; + boxp.c2max := c2max; + goto have_c2max; + end; + Inc(histp, HIST_C2_ELEMS); + end; + end; + have_c2max: + + { Update box volume. + We use 2-norm rather than real volume here; this biases the method + against making long narrow boxes, and it has the side benefit that + a box is splittable iff norm > 0. + Since the differences are expressed in histogram-cell units, + we have to shift back to JSAMPLE units to get consistent distances; + after which, we scale according to the selected distance scale factors.} + + dist0 := ((c0max - c0min) shl C0_SHIFT) * C0_SCALE; + dist1 := ((c1max - c1min) shl C1_SHIFT) * C1_SCALE; + dist2 := ((c2max - c2min) shl C2_SHIFT) * C2_SCALE; + boxp.volume := dist0*dist0 + dist1*dist1 + dist2*dist2; + + { Now scan remaining volume of box and compute population } + ccount := 0; + for c0 := c0min to c0max do + for c1 := c1min to c1max do + begin + histp := @(histogram^[c0]^[c1][c2min]); + for c2 := c2min to c2max do + begin + if (histp^ <> 0) then + Inc(ccount); + Inc(histp); + end; + end; + boxp.colorcount := ccount; +end; + + +{LOCAL} +function median_cut (cinfo : j_decompress_ptr; boxlist : boxlistptr; + numboxes : int; desired_colors : int) : int; +{ Repeatedly select and split the largest box until we have enough boxes } +var + n,lb : int; + c0,c1,c2,cmax : int; + {register} b1,b2 : boxptr; +begin + while (numboxes < desired_colors) do + begin + { Select box to split. + Current algorithm: by population for first half, then by volume. } + + if (numboxes*2 <= desired_colors) then + b1 := find_biggest_color_pop(boxlist, numboxes) + else + b1 := find_biggest_volume(boxlist, numboxes); + + if (b1 = NIL) then { no splittable boxes left! } + break; + b2 := @(boxlist^[numboxes]); { where new box will go } + { Copy the color bounds to the new box. } + b2^.c0max := b1^.c0max; b2^.c1max := b1^.c1max; b2^.c2max := b1^.c2max; + b2^.c0min := b1^.c0min; b2^.c1min := b1^.c1min; b2^.c2min := b1^.c2min; + { Choose which axis to split the box on. + Current algorithm: longest scaled axis. + See notes in update_box about scaling distances. } + + c0 := ((b1^.c0max - b1^.c0min) shl C0_SHIFT) * C0_SCALE; + c1 := ((b1^.c1max - b1^.c1min) shl C1_SHIFT) * C1_SCALE; + c2 := ((b1^.c2max - b1^.c2min) shl C2_SHIFT) * C2_SCALE; + { We want to break any ties in favor of green, then red, blue last. + This code does the right thing for R,G,B or B,G,R color orders only. } + +{$ifdef RGB_RED_IS_0} + cmax := c1; n := 1; + if (c0 > cmax) then + begin + cmax := c0; + n := 0; + end; + if (c2 > cmax) then + n := 2; +{$else} + cmax := c1; + n := 1; + if (c2 > cmax) then + begin + cmax := c2; + n := 2; + end; + if (c0 > cmax) then + n := 0; +{$endif} + { Choose split point along selected axis, and update box bounds. + Current algorithm: split at halfway point. + (Since the box has been shrunk to minimum volume, + any split will produce two nonempty subboxes.) + Note that lb value is max for lower box, so must be < old max. } + + case n of + 0:begin + lb := (b1^.c0max + b1^.c0min) div 2; + b1^.c0max := lb; + b2^.c0min := lb+1; + end; + 1:begin + lb := (b1^.c1max + b1^.c1min) div 2; + b1^.c1max := lb; + b2^.c1min := lb+1; + end; + 2:begin + lb := (b1^.c2max + b1^.c2min) div 2; + b1^.c2max := lb; + b2^.c2min := lb+1; + end; + end; + { Update stats for boxes } + update_box(cinfo, b1^); + update_box(cinfo, b2^); + Inc(numboxes); + end; + median_cut := numboxes; +end; + + +{LOCAL} +procedure compute_color (cinfo : j_decompress_ptr; + const boxp : box; icolor : int); +{ Compute representative color for a box, put it in colormap[icolor] } +var + { Current algorithm: mean weighted by pixels (not colors) } + { Note it is important to get the rounding correct! } + cquantize : my_cquantize_ptr; + histogram : hist3d; + histp : histptr; + c0,c1,c2 : int; + c0min,c0max,c1min,c1max,c2min,c2max : int; + count : long; + total : long; + c0total : long; + c1total : long; + c2total : long; +begin + cquantize := my_cquantize_ptr(cinfo^.cquantize); + histogram := cquantize^.histogram; + total := 0; + c0total := 0; + c1total := 0; + c2total := 0; + + c0min := boxp.c0min; c0max := boxp.c0max; + c1min := boxp.c1min; c1max := boxp.c1max; + c2min := boxp.c2min; c2max := boxp.c2max; + + for c0 := c0min to c0max do + for c1 := c1min to c1max do + begin + histp := @(histogram^[c0]^[c1][c2min]); + for c2 := c2min to c2max do + begin + count := histp^; + Inc(histp); + if (count <> 0) then + begin + Inc(total, count); + Inc(c0total, ((c0 shl C0_SHIFT) + ((1 shl C0_SHIFT) shr 1)) * count); + Inc(c1total, ((c1 shl C1_SHIFT) + ((1 shl C1_SHIFT) shr 1)) * count); + Inc(c2total, ((c2 shl C2_SHIFT) + ((1 shl C2_SHIFT) shr 1)) * count); + end; + end; + end; + + cinfo^.colormap^[0]^[icolor] := JSAMPLE ((c0total + (total shr 1)) div total); + cinfo^.colormap^[1]^[icolor] := JSAMPLE ((c1total + (total shr 1)) div total); + cinfo^.colormap^[2]^[icolor] := JSAMPLE ((c2total + (total shr 1)) div total); +end; + + +{LOCAL} +procedure select_colors (cinfo : j_decompress_ptr; desired_colors : int); +{ Master routine for color selection } +var + boxlist : boxlistptr; + numboxes : int; + i : int; +begin + { Allocate workspace for box list } + boxlist := boxlistptr(cinfo^.mem^.alloc_small( + j_common_ptr(cinfo), JPOOL_IMAGE, desired_colors * SIZEOF(box))); + { Initialize one box containing whole space } + numboxes := 1; + boxlist^[0].c0min := 0; + boxlist^[0].c0max := MAXJSAMPLE shr C0_SHIFT; + boxlist^[0].c1min := 0; + boxlist^[0].c1max := MAXJSAMPLE shr C1_SHIFT; + boxlist^[0].c2min := 0; + boxlist^[0].c2max := MAXJSAMPLE shr C2_SHIFT; + { Shrink it to actually-used volume and set its statistics } + update_box(cinfo, boxlist^[0]); + { Perform median-cut to produce final box list } + numboxes := median_cut(cinfo, boxlist, numboxes, desired_colors); + { Compute the representative color for each box, fill colormap } + for i := 0 to pred(numboxes) do + compute_color(cinfo, boxlist^[i], i); + cinfo^.actual_number_of_colors := numboxes; + {$IFDEF DEBUG} + TRACEMS1(j_common_ptr(cinfo), 1, JTRC_QUANT_SELECTED, numboxes); + {$ENDIF} +end; + + +{ These routines are concerned with the time-critical task of mapping input + colors to the nearest color in the selected colormap. + + We re-use the histogram space as an "inverse color map", essentially a + cache for the results of nearest-color searches. All colors within a + histogram cell will be mapped to the same colormap entry, namely the one + closest to the cell's center. This may not be quite the closest entry to + the actual input color, but it's almost as good. A zero in the cache + indicates we haven't found the nearest color for that cell yet; the array + is cleared to zeroes before starting the mapping pass. When we find the + nearest color for a cell, its colormap index plus one is recorded in the + cache for future use. The pass2 scanning routines call fill_inverse_cmap + when they need to use an unfilled entry in the cache. + + Our method of efficiently finding nearest colors is based on the "locally + sorted search" idea described by Heckbert and on the incremental distance + calculation described by Spencer W. Thomas in chapter III.1 of Graphics + Gems II (James Arvo, ed. Academic Press, 1991). Thomas points out that + the distances from a given colormap entry to each cell of the histogram can + be computed quickly using an incremental method: the differences between + distances to adjacent cells themselves differ by a constant. This allows a + fairly fast implementation of the "brute force" approach of computing the + distance from every colormap entry to every histogram cell. Unfortunately, + it needs a work array to hold the best-distance-so-far for each histogram + cell (because the inner loop has to be over cells, not colormap entries). + The work array elements have to be INT32s, so the work array would need + 256Kb at our recommended precision. This is not feasible in DOS machines. + + To get around these problems, we apply Thomas' method to compute the + nearest colors for only the cells within a small subbox of the histogram. + The work array need be only as big as the subbox, so the memory usage + problem is solved. Furthermore, we need not fill subboxes that are never + referenced in pass2; many images use only part of the color gamut, so a + fair amount of work is saved. An additional advantage of this + approach is that we can apply Heckbert's locality criterion to quickly + eliminate colormap entries that are far away from the subbox; typically + three-fourths of the colormap entries are rejected by Heckbert's criterion, + and we need not compute their distances to individual cells in the subbox. + The speed of this approach is heavily influenced by the subbox size: too + small means too much overhead, too big loses because Heckbert's criterion + can't eliminate as many colormap entries. Empirically the best subbox + size seems to be about 1/512th of the histogram (1/8th in each direction). + + Thomas' article also describes a refined method which is asymptotically + faster than the brute-force method, but it is also far more complex and + cannot efficiently be applied to small subboxes. It is therefore not + useful for programs intended to be portable to DOS machines. On machines + with plenty of memory, filling the whole histogram in one shot with Thomas' + refined method might be faster than the present code --- but then again, + it might not be any faster, and it's certainly more complicated. } + + + +{ log2(histogram cells in update box) for each axis; this can be adjusted } +const + BOX_C0_LOG = (HIST_C0_BITS-3); + BOX_C1_LOG = (HIST_C1_BITS-3); + BOX_C2_LOG = (HIST_C2_BITS-3); + + BOX_C0_ELEMS = (1 shl BOX_C0_LOG); { # of hist cells in update box } + BOX_C1_ELEMS = (1 shl BOX_C1_LOG); + BOX_C2_ELEMS = (1 shl BOX_C2_LOG); + + BOX_C0_SHIFT = (C0_SHIFT + BOX_C0_LOG); + BOX_C1_SHIFT = (C1_SHIFT + BOX_C1_LOG); + BOX_C2_SHIFT = (C2_SHIFT + BOX_C2_LOG); + + +{ The next three routines implement inverse colormap filling. They could + all be folded into one big routine, but splitting them up this way saves + some stack space (the mindist[] and bestdist[] arrays need not coexist) + and may allow some compilers to produce better code by registerizing more + inner-loop variables. } + +{LOCAL} +function find_nearby_colors (cinfo : j_decompress_ptr; + minc0 : int; minc1 : int; minc2 : int; + var colorlist : array of JSAMPLE) : int; +{ Locate the colormap entries close enough to an update box to be candidates + for the nearest entry to some cell(s) in the update box. The update box + is specified by the center coordinates of its first cell. The number of + candidate colormap entries is returned, and their colormap indexes are + placed in colorlist[]. + This routine uses Heckbert's "locally sorted search" criterion to select + the colors that need further consideration. } + +var + numcolors : int; + maxc0, maxc1, maxc2 : int; + centerc0, centerc1, centerc2 : int; + i, x, ncolors : int; + minmaxdist, min_dist, max_dist, tdist : INT32; + mindist : array[0..MAXNUMCOLORS-1] of INT32; + { min distance to colormap entry i } +begin + numcolors := cinfo^.actual_number_of_colors; + + { Compute true coordinates of update box's upper corner and center. + Actually we compute the coordinates of the center of the upper-corner + histogram cell, which are the upper bounds of the volume we care about. + Note that since ">>" rounds down, the "center" values may be closer to + min than to max; hence comparisons to them must be "<=", not "<". } + + maxc0 := minc0 + ((1 shl BOX_C0_SHIFT) - (1 shl C0_SHIFT)); + centerc0 := (minc0 + maxc0) shr 1; + maxc1 := minc1 + ((1 shl BOX_C1_SHIFT) - (1 shl C1_SHIFT)); + centerc1 := (minc1 + maxc1) shr 1; + maxc2 := minc2 + ((1 shl BOX_C2_SHIFT) - (1 shl C2_SHIFT)); + centerc2 := (minc2 + maxc2) shr 1; + + { For each color in colormap, find: + 1. its minimum squared-distance to any point in the update box + (zero if color is within update box); + 2. its maximum squared-distance to any point in the update box. + Both of these can be found by considering only the corners of the box. + We save the minimum distance for each color in mindist[]; + only the smallest maximum distance is of interest. } + + minmaxdist := long($7FFFFFFF); + + for i := 0 to pred(numcolors) do + begin + { We compute the squared-c0-distance term, then add in the other two. } + x := GETJSAMPLE(cinfo^.colormap^[0]^[i]); + if (x < minc0) then + begin + tdist := (x - minc0) * C0_SCALE; + min_dist := tdist*tdist; + tdist := (x - maxc0) * C0_SCALE; + max_dist := tdist*tdist; + end + else + if (x > maxc0) then + begin + tdist := (x - maxc0) * C0_SCALE; + min_dist := tdist*tdist; + tdist := (x - minc0) * C0_SCALE; + max_dist := tdist*tdist; + end + else + begin + { within cell range so no contribution to min_dist } + min_dist := 0; + if (x <= centerc0) then + begin + tdist := (x - maxc0) * C0_SCALE; + max_dist := tdist*tdist; + end + else + begin + tdist := (x - minc0) * C0_SCALE; + max_dist := tdist*tdist; + end; + end; + + x := GETJSAMPLE(cinfo^.colormap^[1]^[i]); + if (x < minc1) then + begin + tdist := (x - minc1) * C1_SCALE; + Inc(min_dist, tdist*tdist); + tdist := (x - maxc1) * C1_SCALE; + Inc(max_dist, tdist*tdist); + end + else + if (x > maxc1) then + begin + tdist := (x - maxc1) * C1_SCALE; + Inc(min_dist, tdist*tdist); + tdist := (x - minc1) * C1_SCALE; + Inc(max_dist, tdist*tdist); + end + else + begin + { within cell range so no contribution to min_dist } + if (x <= centerc1) then + begin + tdist := (x - maxc1) * C1_SCALE; + Inc(max_dist, tdist*tdist); + end + else + begin + tdist := (x - minc1) * C1_SCALE; + Inc(max_dist, tdist*tdist); + end + end; + + x := GETJSAMPLE(cinfo^.colormap^[2]^[i]); + if (x < minc2) then + begin + tdist := (x - minc2) * C2_SCALE; + Inc(min_dist, tdist*tdist); + tdist := (x - maxc2) * C2_SCALE; + Inc(max_dist, tdist*tdist); + end + else + if (x > maxc2) then + begin + tdist := (x - maxc2) * C2_SCALE; + Inc(min_dist, tdist*tdist); + tdist := (x - minc2) * C2_SCALE; + Inc(max_dist, tdist*tdist); + end + else + begin + { within cell range so no contribution to min_dist } + if (x <= centerc2) then + begin + tdist := (x - maxc2) * C2_SCALE; + Inc(max_dist, tdist*tdist); + end + else + begin + tdist := (x - minc2) * C2_SCALE; + Inc(max_dist, tdist*tdist); + end; + end; + + mindist[i] := min_dist; { save away the results } + if (max_dist < minmaxdist) then + minmaxdist := max_dist; + end; + + { Now we know that no cell in the update box is more than minmaxdist + away from some colormap entry. Therefore, only colors that are + within minmaxdist of some part of the box need be considered. } + + ncolors := 0; + for i := 0 to pred(numcolors) do + begin + if (mindist[i] <= minmaxdist) then + begin + colorlist[ncolors] := JSAMPLE(i); + Inc(ncolors); + end; + end; + find_nearby_colors := ncolors; +end; + + +{LOCAL} +procedure find_best_colors (cinfo : j_decompress_ptr; + minc0 : int; minc1 : int; minc2 : int; + numcolors : int; + var colorlist : array of JSAMPLE; + var bestcolor : array of JSAMPLE); +{ Find the closest colormap entry for each cell in the update box, + given the list of candidate colors prepared by find_nearby_colors. + Return the indexes of the closest entries in the bestcolor[] array. + This routine uses Thomas' incremental distance calculation method to + find the distance from a colormap entry to successive cells in the box. } +const + { Nominal steps between cell centers ("x" in Thomas article) } + STEP_C0 = ((1 shl C0_SHIFT) * C0_SCALE); + STEP_C1 = ((1 shl C1_SHIFT) * C1_SCALE); + STEP_C2 = ((1 shl C2_SHIFT) * C2_SCALE); +var + ic0, ic1, ic2 : int; + i, icolor : int; + {register} bptr : INT32PTR; { pointer into bestdist[] array } + cptr : JSAMPLE_PTR; { pointer into bestcolor[] array } + dist0, dist1 : INT32; { initial distance values } + {register} dist2 : INT32; { current distance in inner loop } + xx0, xx1 : INT32; { distance increments } + {register} xx2 : INT32; + inc0, inc1, inc2 : INT32; { initial values for increments } + { This array holds the distance to the nearest-so-far color for each cell } + bestdist : array[0..BOX_C0_ELEMS * BOX_C1_ELEMS * BOX_C2_ELEMS-1] of INT32; +begin + { Initialize best-distance for each cell of the update box } + for i := BOX_C0_ELEMS*BOX_C1_ELEMS*BOX_C2_ELEMS-1 downto 0 do + bestdist[i] := $7FFFFFFF; + + { For each color selected by find_nearby_colors, + compute its distance to the center of each cell in the box. + If that's less than best-so-far, update best distance and color number. } + + + + for i := 0 to pred(numcolors) do + begin + icolor := GETJSAMPLE(colorlist[i]); + { Compute (square of) distance from minc0/c1/c2 to this color } + inc0 := (minc0 - GETJSAMPLE(cinfo^.colormap^[0]^[icolor])) * C0_SCALE; + dist0 := inc0*inc0; + inc1 := (minc1 - GETJSAMPLE(cinfo^.colormap^[1]^[icolor])) * C1_SCALE; + Inc(dist0, inc1*inc1); + inc2 := (minc2 - GETJSAMPLE(cinfo^.colormap^[2]^[icolor])) * C2_SCALE; + Inc(dist0, inc2*inc2); + { Form the initial difference increments } + inc0 := inc0 * (2 * STEP_C0) + STEP_C0 * STEP_C0; + inc1 := inc1 * (2 * STEP_C1) + STEP_C1 * STEP_C1; + inc2 := inc2 * (2 * STEP_C2) + STEP_C2 * STEP_C2; + { Now loop over all cells in box, updating distance per Thomas method } + bptr := @bestdist[0]; + cptr := @bestcolor[0]; + xx0 := inc0; + for ic0 := BOX_C0_ELEMS-1 downto 0 do + begin + dist1 := dist0; + xx1 := inc1; + for ic1 := BOX_C1_ELEMS-1 downto 0 do + begin + dist2 := dist1; + xx2 := inc2; + for ic2 := BOX_C2_ELEMS-1 downto 0 do + begin + if (dist2 < bptr^) then + begin + bptr^ := dist2; + cptr^ := JSAMPLE (icolor); + end; + Inc(dist2, xx2); + Inc(xx2, 2 * STEP_C2 * STEP_C2); + Inc(bptr); + Inc(cptr); + end; + Inc(dist1, xx1); + Inc(xx1, 2 * STEP_C1 * STEP_C1); + end; + Inc(dist0, xx0); + Inc(xx0, 2 * STEP_C0 * STEP_C0); + end; + end; +end; + + +{LOCAL} +procedure fill_inverse_cmap (cinfo : j_decompress_ptr; + c0 : int; c1 : int; c2 : int); +{ Fill the inverse-colormap entries in the update box that contains } +{ histogram cell c0/c1/c2. (Only that one cell MUST be filled, but } +{ we can fill as many others as we wish.) } +var + cquantize : my_cquantize_ptr; + histogram : hist3d; + minc0, minc1, minc2 : int; { lower left corner of update box } + ic0, ic1, ic2 : int; + {register} cptr : JSAMPLE_PTR; { pointer into bestcolor[] array } + {register} cachep : histptr; { pointer into main cache array } + { This array lists the candidate colormap indexes. } + colorlist : array[0..MAXNUMCOLORS-1] of JSAMPLE; + numcolors : int; { number of candidate colors } + { This array holds the actually closest colormap index for each cell. } + bestcolor : array[0..BOX_C0_ELEMS * BOX_C1_ELEMS * BOX_C2_ELEMS-1] of JSAMPLE; +begin + cquantize := my_cquantize_ptr (cinfo^.cquantize); + histogram := cquantize^.histogram; + + { Convert cell coordinates to update box ID } + c0 := c0 shr BOX_C0_LOG; + c1 := c1 shr BOX_C1_LOG; + c2 := c2 shr BOX_C2_LOG; + + { Compute true coordinates of update box's origin corner. + Actually we compute the coordinates of the center of the corner + histogram cell, which are the lower bounds of the volume we care about.} + + minc0 := (c0 shl BOX_C0_SHIFT) + ((1 shl C0_SHIFT) shr 1); + minc1 := (c1 shl BOX_C1_SHIFT) + ((1 shl C1_SHIFT) shr 1); + minc2 := (c2 shl BOX_C2_SHIFT) + ((1 shl C2_SHIFT) shr 1); + + { Determine which colormap entries are close enough to be candidates + for the nearest entry to some cell in the update box. } + + numcolors := find_nearby_colors(cinfo, minc0, minc1, minc2, colorlist); + + { Determine the actually nearest colors. } + find_best_colors(cinfo, minc0, minc1, minc2, numcolors, colorlist, + bestcolor); + + { Save the best color numbers (plus 1) in the main cache array } + c0 := c0 shl BOX_C0_LOG; { convert ID back to base cell indexes } + c1 := c1 shl BOX_C1_LOG; + c2 := c2 shl BOX_C2_LOG; + cptr := @(bestcolor[0]); + for ic0 := 0 to pred(BOX_C0_ELEMS) do + for ic1 := 0 to pred(BOX_C1_ELEMS) do + begin + cachep := @(histogram^[c0+ic0]^[c1+ic1][c2]); + for ic2 := 0 to pred(BOX_C2_ELEMS) do + begin + cachep^ := histcell (GETJSAMPLE(cptr^) + 1); + Inc(cachep); + Inc(cptr); + end; + end; +end; + + +{ Map some rows of pixels to the output colormapped representation. } + +{METHODDEF} +procedure pass2_no_dither (cinfo : j_decompress_ptr; + input_buf : JSAMPARRAY; + output_buf : JSAMPARRAY; + num_rows : int); +{ This version performs no dithering } +var + cquantize : my_cquantize_ptr; + histogram : hist3d; + {register} inptr : RGBptr; + outptr : JSAMPLE_PTR; + {register} cachep : histptr; + {register} c0, c1, c2 : int; + row : int; + col : JDIMENSION; + width : JDIMENSION; +begin + cquantize := my_cquantize_ptr (cinfo^.cquantize); + histogram := cquantize^.histogram; + width := cinfo^.output_width; + + for row := 0 to pred(num_rows) do + begin + inptr := RGBptr(input_buf^[row]); + outptr := JSAMPLE_PTR(output_buf^[row]); + for col := pred(width) downto 0 do + begin + { get pixel value and index into the cache } + c0 := GETJSAMPLE(inptr^.r) shr C0_SHIFT; + c1 := GETJSAMPLE(inptr^.g) shr C1_SHIFT; + c2 := GETJSAMPLE(inptr^.b) shr C2_SHIFT; + Inc(inptr); + cachep := @(histogram^[c0]^[c1][c2]); + { If we have not seen this color before, find nearest colormap entry } + { and update the cache } + if (cachep^ = 0) then + fill_inverse_cmap(cinfo, c0,c1,c2); + { Now emit the colormap index for this cell } + outptr^ := JSAMPLE (cachep^ - 1); + Inc(outptr); + end; + end; +end; + + +{METHODDEF} +procedure pass2_fs_dither (cinfo : j_decompress_ptr; + input_buf : JSAMPARRAY; + output_buf : JSAMPARRAY; + num_rows : int); +{ This version performs Floyd-Steinberg dithering } +var + cquantize : my_cquantize_ptr; + histogram : hist3d; + {register} cur : LOCRGB_FSERROR; { current error or pixel value } + belowerr : LOCRGB_FSERROR; { error for pixel below cur } + bpreverr : LOCRGB_FSERROR; { error for below/prev col } + prev_errorptr, + {register} errorptr : RGB_FSERROR_PTR; { => fserrors[] at column before current } + inptr : RGBptr; { => current input pixel } + outptr : JSAMPLE_PTR; { => current output pixel } + cachep : histptr; + dir : int; { +1 or -1 depending on direction } + row : int; + col : JDIMENSION; + width : JDIMENSION; + range_limit : range_limit_table_ptr; + error_limit : error_limit_ptr; + colormap0 : JSAMPROW; + colormap1 : JSAMPROW; + colormap2 : JSAMPROW; + {register} pixcode : int; + {register} bnexterr, delta : LOCFSERROR; +begin + cquantize := my_cquantize_ptr (cinfo^.cquantize); + histogram := cquantize^.histogram; + width := cinfo^.output_width; + range_limit := cinfo^.sample_range_limit; + error_limit := cquantize^.error_limiter; + colormap0 := cinfo^.colormap^[0]; + colormap1 := cinfo^.colormap^[1]; + colormap2 := cinfo^.colormap^[2]; + + for row := 0 to pred(num_rows) do + begin + inptr := RGBptr(input_buf^[row]); + outptr := JSAMPLE_PTR(output_buf^[row]); + errorptr := RGB_FSERROR_PTR(cquantize^.fserrors); { => entry before first real column } + if (cquantize^.on_odd_row) then + begin + { work right to left in this row } + Inc(inptr, (width-1)); { so point to rightmost pixel } + Inc(outptr, width-1); + dir := -1; + Inc(errorptr, (width+1)); { => entry after last column } + cquantize^.on_odd_row := FALSE; { flip for next time } + end + else + begin + { work left to right in this row } + dir := 1; + cquantize^.on_odd_row := TRUE; { flip for next time } + end; + + { Preset error values: no error propagated to first pixel from left } + cur.r := 0; + cur.g := 0; + cur.b := 0; + { and no error propagated to row below yet } + belowerr.r := 0; + belowerr.g := 0; + belowerr.b := 0; + bpreverr.r := 0; + bpreverr.g := 0; + bpreverr.b := 0; + + for col := pred(width) downto 0 do + begin + prev_errorptr := errorptr; + Inc(errorptr, dir); { advance errorptr to current column } + + { curN holds the error propagated from the previous pixel on the + current line. Add the error propagated from the previous line + to form the complete error correction term for this pixel, and + round the error term (which is expressed * 16) to an integer. + RIGHT_SHIFT rounds towards minus infinity, so adding 8 is correct + for either sign of the error value. + Note: prev_errorptr points to *previous* column's array entry. } + + { Nomssi Note: Borland Pascal SHR is unsigned } + cur.r := (cur.r + errorptr^.r + 8) div 16; + cur.g := (cur.g + errorptr^.g + 8) div 16; + cur.b := (cur.b + errorptr^.b + 8) div 16; + { Limit the error using transfer function set by init_error_limit. + See comments with init_error_limit for rationale. } + + cur.r := error_limit^[cur.r]; + cur.g := error_limit^[cur.g]; + cur.b := error_limit^[cur.b]; + { Form pixel value + error, and range-limit to 0..MAXJSAMPLE. + The maximum error is +- MAXJSAMPLE (or less with error limiting); + this sets the required size of the range_limit array. } + + Inc(cur.r, GETJSAMPLE(inptr^.r)); + Inc(cur.g, GETJSAMPLE(inptr^.g)); + Inc(cur.b, GETJSAMPLE(inptr^.b)); + + cur.r := GETJSAMPLE(range_limit^[cur.r]); + cur.g := GETJSAMPLE(range_limit^[cur.g]); + cur.b := GETJSAMPLE(range_limit^[cur.b]); + { Index into the cache with adjusted pixel value } + cachep := @(histogram^[cur.r shr C0_SHIFT]^ + [cur.g shr C1_SHIFT][cur.b shr C2_SHIFT]); + { If we have not seen this color before, find nearest colormap } + { entry and update the cache } + if (cachep^ = 0) then + fill_inverse_cmap(cinfo, cur.r shr C0_SHIFT, + cur.g shr C1_SHIFT, + cur.b shr C2_SHIFT); + { Now emit the colormap index for this cell } + + pixcode := cachep^ - 1; + outptr^ := JSAMPLE (pixcode); + + { Compute representation error for this pixel } + Dec(cur.r, GETJSAMPLE(colormap0^[pixcode])); + Dec(cur.g, GETJSAMPLE(colormap1^[pixcode])); + Dec(cur.b, GETJSAMPLE(colormap2^[pixcode])); + + { Compute error fractions to be propagated to adjacent pixels. + Add these into the running sums, and simultaneously shift the + next-line error sums left by 1 column. } + + bnexterr := cur.r; { Process component 0 } + delta := cur.r * 2; + Inc(cur.r, delta); { form error * 3 } + prev_errorptr^.r := FSERROR (bpreverr.r + cur.r); + Inc(cur.r, delta); { form error * 5 } + bpreverr.r := belowerr.r + cur.r; + belowerr.r := bnexterr; + Inc(cur.r, delta); { form error * 7 } + bnexterr := cur.g; { Process component 1 } + delta := cur.g * 2; + Inc(cur.g, delta); { form error * 3 } + prev_errorptr^.g := FSERROR (bpreverr.g + cur.g); + Inc(cur.g, delta); { form error * 5 } + bpreverr.g := belowerr.g + cur.g; + belowerr.g := bnexterr; + Inc(cur.g, delta); { form error * 7 } + bnexterr := cur.b; { Process component 2 } + delta := cur.b * 2; + Inc(cur.b, delta); { form error * 3 } + prev_errorptr^.b := FSERROR (bpreverr.b + cur.b); + Inc(cur.b, delta); { form error * 5 } + bpreverr.b := belowerr.b + cur.b; + belowerr.b := bnexterr; + Inc(cur.b, delta); { form error * 7 } + + { At this point curN contains the 7/16 error value to be propagated + to the next pixel on the current line, and all the errors for the + next line have been shifted over. We are therefore ready to move on.} + + Inc(inptr, dir); { Advance pixel pointers to next column } + Inc(outptr, dir); + end; + { Post-loop cleanup: we must unload the final error values into the + final fserrors[] entry. Note we need not unload belowerrN because + it is for the dummy column before or after the actual array. } + + errorptr^.r := FSERROR (bpreverr.r); { unload prev errs into array } + errorptr^.g := FSERROR (bpreverr.g); + errorptr^.b := FSERROR (bpreverr.b); + end; +end; + + +{ Initialize the error-limiting transfer function (lookup table). + The raw F-S error computation can potentially compute error values of up to + +- MAXJSAMPLE. But we want the maximum correction applied to a pixel to be + much less, otherwise obviously wrong pixels will be created. (Typical + effects include weird fringes at color-area boundaries, isolated bright + pixels in a dark area, etc.) The standard advice for avoiding this problem + is to ensure that the "corners" of the color cube are allocated as output + colors; then repeated errors in the same direction cannot cause cascading + error buildup. However, that only prevents the error from getting + completely out of hand; Aaron Giles reports that error limiting improves + the results even with corner colors allocated. + A simple clamping of the error values to about +- MAXJSAMPLE/8 works pretty + well, but the smoother transfer function used below is even better. Thanks + to Aaron Giles for this idea. } + +{LOCAL} +procedure init_error_limit (cinfo : j_decompress_ptr); +const + STEPSIZE = ((MAXJSAMPLE+1) div 16); +{ Allocate and fill in the error_limiter table } +var + cquantize : my_cquantize_ptr; + table : error_limit_ptr; + inp, out : int; +begin + cquantize := my_cquantize_ptr (cinfo^.cquantize); + table := error_limit_ptr (cinfo^.mem^.alloc_small + (j_common_ptr (cinfo), JPOOL_IMAGE, (MAXJSAMPLE*2+1) * SIZEOF(int))); + { not needed: Inc(table, MAXJSAMPLE); + so can index -MAXJSAMPLE .. +MAXJSAMPLE } + cquantize^.error_limiter := table; + { Map errors 1:1 up to +- MAXJSAMPLE/16 } + out := 0; + for inp := 0 to pred(STEPSIZE) do + begin + table^[inp] := out; + table^[-inp] := -out; + Inc(out); + end; + { Map errors 1:2 up to +- 3*MAXJSAMPLE/16 } + inp := STEPSIZE; { Nomssi: avoid problems with Delphi2 optimizer } + while (inp < STEPSIZE*3) do + begin + table^[inp] := out; + table^[-inp] := -out; + Inc(inp); + if Odd(inp) then + Inc(out); + end; + { Clamp the rest to final out value (which is (MAXJSAMPLE+1)/8) } + inp := STEPSIZE*3; { Nomssi: avoid problems with Delphi 2 optimizer } + while inp <= MAXJSAMPLE do + begin + table^[inp] := out; + table^[-inp] := -out; + Inc(inp); + end; +end; + +{ Finish up at the end of each pass. } + +{METHODDEF} +procedure finish_pass1 (cinfo : j_decompress_ptr); +var + cquantize : my_cquantize_ptr; +begin + cquantize := my_cquantize_ptr (cinfo^.cquantize); + + { Select the representative colors and fill in cinfo^.colormap } + cinfo^.colormap := cquantize^.sv_colormap; + select_colors(cinfo, cquantize^.desired); + { Force next pass to zero the color index table } + cquantize^.needs_zeroed := TRUE; +end; + + +{METHODDEF} +procedure finish_pass2 (cinfo : j_decompress_ptr); +begin + { no work } +end; + + +{ Initialize for each processing pass. } + +{METHODDEF} +procedure start_pass_2_quant (cinfo : j_decompress_ptr; + is_pre_scan : boolean); +var + cquantize : my_cquantize_ptr; + histogram : hist3d; + i : int; +var + arraysize : size_t; +begin + cquantize := my_cquantize_ptr (cinfo^.cquantize); + histogram := cquantize^.histogram; + { Only F-S dithering or no dithering is supported. } + { If user asks for ordered dither, give him F-S. } + if (cinfo^.dither_mode <> JDITHER_NONE) then + cinfo^.dither_mode := JDITHER_FS; + + if (is_pre_scan) then + begin + { Set up method pointers } + cquantize^.pub.color_quantize := prescan_quantize; + cquantize^.pub.finish_pass := finish_pass1; + cquantize^.needs_zeroed := TRUE; { Always zero histogram } + end + else + begin + { Set up method pointers } + if (cinfo^.dither_mode = JDITHER_FS) then + cquantize^.pub.color_quantize := pass2_fs_dither + else + cquantize^.pub.color_quantize := pass2_no_dither; + cquantize^.pub.finish_pass := finish_pass2; + + { Make sure color count is acceptable } + i := cinfo^.actual_number_of_colors; + if (i < 1) then + ERREXIT1(j_common_ptr(cinfo), JERR_QUANT_FEW_COLORS, 1); + if (i > MAXNUMCOLORS) then + ERREXIT1(j_common_ptr(cinfo), JERR_QUANT_MANY_COLORS, MAXNUMCOLORS); + + if (cinfo^.dither_mode = JDITHER_FS) then + begin + arraysize := size_t ((cinfo^.output_width + 2) * + (3 * SIZEOF(FSERROR))); + { Allocate Floyd-Steinberg workspace if we didn't already. } + if (cquantize^.fserrors = NIL) then + cquantize^.fserrors := FS_ERROR_FIELD_PTR (cinfo^.mem^.alloc_large + (j_common_ptr(cinfo), JPOOL_IMAGE, arraysize)); + { Initialize the propagated errors to zero. } + jzero_far(cquantize^.fserrors, arraysize); + { Make the error-limit table if we didn't already. } + if (cquantize^.error_limiter = NIL) then + init_error_limit(cinfo); + cquantize^.on_odd_row := FALSE; + end; + + end; + { Zero the histogram or inverse color map, if necessary } + if (cquantize^.needs_zeroed) then + begin + for i := 0 to pred(HIST_C0_ELEMS) do + begin + jzero_far( histogram^[i], + HIST_C1_ELEMS*HIST_C2_ELEMS * SIZEOF(histcell)); + end; + cquantize^.needs_zeroed := FALSE; + end; +end; + + +{ Switch to a new external colormap between output passes. } + +{METHODDEF} +procedure new_color_map_2_quant (cinfo : j_decompress_ptr); +var + cquantize : my_cquantize_ptr; +begin + cquantize := my_cquantize_ptr (cinfo^.cquantize); + + { Reset the inverse color map } + cquantize^.needs_zeroed := TRUE; +end; + + +{ Module initialization routine for 2-pass color quantization. } + + +{GLOBAL} +procedure jinit_2pass_quantizer (cinfo : j_decompress_ptr); +var + cquantize : my_cquantize_ptr; + i : int; +var + desired : int; +begin + cquantize := my_cquantize_ptr( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + SIZEOF(my_cquantizer))); + cinfo^.cquantize := jpeg_color_quantizer_ptr(cquantize); + cquantize^.pub.start_pass := start_pass_2_quant; + cquantize^.pub.new_color_map := new_color_map_2_quant; + cquantize^.fserrors := NIL; { flag optional arrays not allocated } + cquantize^.error_limiter := NIL; + + { Make sure jdmaster didn't give me a case I can't handle } + if (cinfo^.out_color_components <> 3) then + ERREXIT(j_common_ptr(cinfo), JERR_NOTIMPL); + + { Allocate the histogram/inverse colormap storage } + cquantize^.histogram := hist3d (cinfo^.mem^.alloc_small + (j_common_ptr (cinfo), JPOOL_IMAGE, HIST_C0_ELEMS * SIZEOF(hist2d))); + for i := 0 to pred(HIST_C0_ELEMS) do + begin + cquantize^.histogram^[i] := hist2d (cinfo^.mem^.alloc_large + (j_common_ptr (cinfo), JPOOL_IMAGE, + HIST_C1_ELEMS*HIST_C2_ELEMS * SIZEOF(histcell))); + end; + cquantize^.needs_zeroed := TRUE; { histogram is garbage now } + + { Allocate storage for the completed colormap, if required. + We do this now since it is FAR storage and may affect + the memory manager's space calculations. } + + if (cinfo^.enable_2pass_quant) then + begin + { Make sure color count is acceptable } + desired := cinfo^.desired_number_of_colors; + { Lower bound on # of colors ... somewhat arbitrary as long as > 0 } + if (desired < 8) then + ERREXIT1(j_common_ptr (cinfo), JERR_QUANT_FEW_COLORS, 8); + { Make sure colormap indexes can be represented by JSAMPLEs } + if (desired > MAXNUMCOLORS) then + ERREXIT1(j_common_ptr (cinfo), JERR_QUANT_MANY_COLORS, MAXNUMCOLORS); + cquantize^.sv_colormap := cinfo^.mem^.alloc_sarray + (j_common_ptr (cinfo),JPOOL_IMAGE, JDIMENSION(desired), JDIMENSION(3)); + cquantize^.desired := desired; + end + else + cquantize^.sv_colormap := NIL; + + { Only F-S dithering or no dithering is supported. } + { If user asks for ordered dither, give him F-S. } + if (cinfo^.dither_mode <> JDITHER_NONE) then + cinfo^.dither_mode := JDITHER_FS; + + { Allocate Floyd-Steinberg workspace if necessary. + This isn't really needed until pass 2, but again it is FAR storage. + Although we will cope with a later change in dither_mode, + we do not promise to honor max_memory_to_use if dither_mode changes. } + + if (cinfo^.dither_mode = JDITHER_FS) then + begin + cquantize^.fserrors := FS_ERROR_FIELD_PTR (cinfo^.mem^.alloc_large + (j_common_ptr(cinfo), JPOOL_IMAGE, + size_t ((cinfo^.output_width + 2) * (3 * SIZEOF(FSERROR))) ) ); + { Might as well create the error-limiting table too. } + init_error_limit(cinfo); + end; +end; +{ QUANT_2PASS_SUPPORTED } +end. diff --git a/Imaging/JpegLib/imjutils.pas b/Imaging/JpegLib/imjutils.pas index 2f78eef..eb147b9 100644 --- a/Imaging/JpegLib/imjutils.pas +++ b/Imaging/JpegLib/imjutils.pas @@ -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. diff --git a/Imaging/JpegLib/readme.txt b/Imaging/JpegLib/readme.txt index bb98251..3cbe890 100644 --- a/Imaging/JpegLib/readme.txt +++ b/Imaging/JpegLib/readme.txt @@ -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 - * -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 + * -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 _____________________________________________________________________________ \ No newline at end of file diff --git a/Imaging/ZLib/imadler.pas b/Imaging/ZLib/imadler.pas index 73a7768..4438056 100644 --- a/Imaging/ZLib/imadler.pas +++ b/Imaging/ZLib/imadler.pas @@ -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. + diff --git a/Imaging/ZLib/iminfblock.pas b/Imaging/ZLib/iminfblock.pas index 556df99..7ab003f 100644 --- a/Imaging/ZLib/iminfblock.pas +++ b/Imaging/ZLib/iminfblock.pas @@ -1,951 +1,951 @@ -Unit iminfblock; - -{ infblock.h and - infblock.c -- interpret and process block types to last block - 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_blocks_new(var z : z_stream; - c : check_func; { check function } - w : uInt { window size } - ) : pInflate_blocks_state; - -function inflate_blocks (var s : inflate_blocks_state; - var z : z_stream; - r : int { initial return code } - ) : int; - -procedure inflate_blocks_reset (var s : inflate_blocks_state; - var z : z_stream; - c : puLong); { check value on output } - - -function inflate_blocks_free(s : pInflate_blocks_state; - var z : z_stream) : int; - -procedure inflate_set_dictionary(var s : inflate_blocks_state; - const d : array of byte; { dictionary } - n : uInt); { dictionary length } - -function inflate_blocks_sync_point(var s : inflate_blocks_state) : int; - -implementation - -uses - iminfcodes, iminftrees, iminfutil; - -{ Tables for deflate from PKZIP's appnote.txt. } -Const - border : Array [0..18] Of Word { Order of the bit length code lengths } - = (16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15); - -{ Notes beyond the 1.93a appnote.txt: - - 1. Distance pointers never point before the beginning of the output - stream. - 2. Distance pointers can point back across blocks, up to 32k away. - 3. There is an implied maximum of 7 bits for the bit length table and - 15 bits for the actual data. - 4. If only one code exists, then it is encoded using one bit. (Zero - would be more efficient, but perhaps a little confusing.) If two - codes exist, they are coded using one bit each (0 and 1). - 5. There is no way of sending zero distance codes--a dummy must be - sent if there are none. (History: a pre 2.0 version of PKZIP would - store blocks with no distance codes, but this was discovered to be - too harsh a criterion.) Valid only for 1.93a. 2.04c does allow - zero distance codes, which is sent as one code of zero bits in - length. - 6. There are up to 286 literal/length codes. Code 256 represents the - end-of-block. Note however that the static length tree defines - 288 codes just to fill out the Huffman codes. Codes 286 and 287 - cannot be used though, since there is no length base or extra bits - defined for them. Similarily, there are up to 30 distance codes. - However, static trees define 32 codes (all 5 bits) to fill out the - Huffman codes, but the last two had better not show up in the data. - 7. Unzip can check dynamic Huffman blocks for complete code sets. - The exception is that a single code would not be complete (see #4). - 8. The five bits following the block type is really the number of - literal codes sent minus 257. - 9. Length codes 8,16,16 are interpreted as 13 length codes of 8 bits - (1+6+6). Therefore, to output three times the length, you output - three codes (1+1+1), whereas to output four times the same length, - you only need two codes (1+3). Hmm. - 10. In the tree reconstruction algorithm, Code = Code + Increment - only if BitLength(i) is not zero. (Pretty obvious.) - 11. Correction: 4 Bits: # of Bit Length codes - 4 (4 - 19) - 12. Note: length code 284 can represent 227-258, but length code 285 - really is 258. The last length deserves its own, short code - since it gets used a lot in very redundant files. The length - 258 is special since 258 - 3 (the min match length) is 255. - 13. The literal/length and distance code bit lengths are read as a - single stream of lengths. It is possible (and advantageous) for - a repeat code (16, 17, or 18) to go across the boundary between - the two sets of lengths. } - - -procedure inflate_blocks_reset (var s : inflate_blocks_state; - var z : z_stream; - c : puLong); { check value on output } -begin - if (c <> Z_NULL) then - c^ := s.check; - if (s.mode = BTREE) or (s.mode = DTREE) then - ZFREE(z, s.sub.trees.blens); - if (s.mode = CODES) then - inflate_codes_free(s.sub.decode.codes, z); - - s.mode := ZTYPE; - s.bitk := 0; - s.bitb := 0; - - s.write := s.window; - s.read := s.window; - if Assigned(s.checkfn) then - begin - s.check := s.checkfn(uLong(0), pBytef(NIL), 0); - z.adler := s.check; - end; - {$IFDEF DEBUG} - Tracev('inflate: blocks reset'); - {$ENDIF} -end; - - -function inflate_blocks_new(var z : z_stream; - c : check_func; { check function } - w : uInt { window size } - ) : pInflate_blocks_state; -var - s : pInflate_blocks_state; -begin - s := pInflate_blocks_state( ZALLOC(z,1, sizeof(inflate_blocks_state)) ); - if (s = Z_NULL) then - begin - inflate_blocks_new := s; - exit; - end; - s^.hufts := huft_ptr( ZALLOC(z, sizeof(inflate_huft), MANY) ); - - if (s^.hufts = Z_NULL) then - begin - ZFREE(z, s); - inflate_blocks_new := Z_NULL; - exit; - end; - - s^.window := pBytef( ZALLOC(z, 1, w) ); - if (s^.window = Z_NULL) then - begin - ZFREE(z, s^.hufts); - ZFREE(z, s); - inflate_blocks_new := Z_NULL; - exit; - end; - s^.zend := s^.window; - Inc(s^.zend, w); - s^.checkfn := c; - s^.mode := ZTYPE; - {$IFDEF DEBUG} - Tracev('inflate: blocks allocated'); - {$ENDIF} - inflate_blocks_reset(s^, z, Z_NULL); - inflate_blocks_new := s; -end; - - -function inflate_blocks (var s : inflate_blocks_state; - var z : z_stream; - r : int) : int; { initial return code } -label - start_btree, start_dtree, - start_blkdone, start_dry, - start_codes; - -var - t : uInt; { temporary storage } - 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 } -{ fixed code blocks } -var - bl, bd : uInt; - tl, td : pInflate_huft; -var - h : pInflate_huft; - i, j, c : uInt; -var - cs : pInflate_codes_state; -begin - { copy input/output information to locals } - 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)); - -{ decompress an inflated block } - - - { process input based on current state } - while True do - Case s.mode of - ZTYPE: - begin - {NEEDBITS(3);} - while (k < 3) 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, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - Dec(n); - b := b or (uLong(p^) shl k); - Inc(p); - Inc(k, 8); - end; - - t := uInt(b) and 7; - s.last := boolean(t and 1); - case (t shr 1) of - 0: { stored } - begin - {$IFDEF DEBUG} - if s.last then - Tracev('inflate: stored block (last)') - else - Tracev('inflate: stored block'); - {$ENDIF} - {DUMPBITS(3);} - b := b shr 3; - Dec(k, 3); - - t := k and 7; { go to byte boundary } - {DUMPBITS(t);} - b := b shr t; - Dec(k, t); - - s.mode := LENS; { get length of stored block } - end; - 1: { fixed } - begin - begin - {$IFDEF DEBUG} - if s.last then - Tracev('inflate: fixed codes blocks (last)') - else - Tracev('inflate: fixed codes blocks'); - {$ENDIF} - inflate_trees_fixed(bl, bd, tl, td, z); - s.sub.decode.codes := inflate_codes_new(bl, bd, tl, td, z); - if (s.sub.decode.codes = Z_NULL) then - begin - r := Z_MEM_ERROR; - { update pointers and return } - 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_blocks := inflate_flush(s,z,r); - exit; - end; - end; - {DUMPBITS(3);} - b := b shr 3; - Dec(k, 3); - - s.mode := CODES; - end; - 2: { dynamic } - begin - {$IFDEF DEBUG} - if s.last then - Tracev('inflate: dynamic codes block (last)') - else - Tracev('inflate: dynamic codes block'); - {$ENDIF} - {DUMPBITS(3);} - b := b shr 3; - Dec(k, 3); - - s.mode := TABLE; - end; - 3: - begin { illegal } - {DUMPBITS(3);} - b := b shr 3; - Dec(k, 3); - - s.mode := BLKBAD; - z.msg := 'invalid block type'; - r := Z_DATA_ERROR; - { update pointers and return } - 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_blocks := inflate_flush(s,z,r); - exit; - end; - end; - end; - LENS: - begin - {NEEDBITS(32);} - while (k < 32) 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, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - Dec(n); - b := b or (uLong(p^) shl k); - Inc(p); - Inc(k, 8); - end; - - if (((not b) shr 16) and $ffff) <> (b and $ffff) then - begin - s.mode := BLKBAD; - z.msg := 'invalid stored block lengths'; - r := Z_DATA_ERROR; - { update pointers and return } - 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_blocks := inflate_flush(s,z,r); - exit; - end; - s.sub.left := uInt(b) and $ffff; - k := 0; - b := 0; { dump bits } - {$IFDEF DEBUG} - Tracev('inflate: stored length '+IntToStr(s.sub.left)); - {$ENDIF} - if s.sub.left <> 0 then - s.mode := STORED - else - if s.last then - s.mode := DRY - else - s.mode := ZTYPE; - end; - STORED: - begin - if (n = 0) then - begin - { update pointers and return } - 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_blocks := inflate_flush(s,z,r); - exit; - end; - {NEEDOUT} - if (m = 0) then - begin - {WRAP} - if (q = s.zend) and (s.read <> s.window) then - begin - q := s.window; - if ptr2int(q) < ptr2int(s.read) then - m := uInt(ptr2int(s.read)-ptr2int(q)-1) - else - m := uInt(ptr2int(s.zend)-ptr2int(q)); - end; - - if (m = 0) then - begin - {FLUSH} - s.write := q; - r := inflate_flush(s,z,r); - 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)); - - {WRAP} - if (q = s.zend) and (s.read <> s.window) then - begin - q := s.window; - if ptr2int(q) < ptr2int(s.read) then - m := uInt(ptr2int(s.read)-ptr2int(q)-1) - else - m := uInt(ptr2int(s.zend)-ptr2int(q)); - end; - - if (m = 0) then - begin - {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_blocks := inflate_flush(s,z,r); - exit; - end; - end; - end; - r := Z_OK; - - t := s.sub.left; - if (t > n) then - t := n; - if (t > m) then - t := m; - zmemcpy(q, p, t); - Inc(p, t); Dec(n, t); - Inc(q, t); Dec(m, t); - Dec(s.sub.left, t); - if (s.sub.left = 0) then - begin - {$IFDEF DEBUG} - if (ptr2int(q) >= ptr2int(s.read)) then - Tracev('inflate: stored end '+ - IntToStr(z.total_out + ptr2int(q) - ptr2int(s.read)) + ' total out') - else - Tracev('inflate: stored end '+ - IntToStr(z.total_out + ptr2int(s.zend) - ptr2int(s.read) + - ptr2int(q) - ptr2int(s.window)) + ' total out'); - {$ENDIF} - if s.last then - s.mode := DRY - else - s.mode := ZTYPE; - end; - end; - TABLE: - begin - {NEEDBITS(14);} - while (k < 14) 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, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - Dec(n); - b := b or (uLong(p^) shl k); - Inc(p); - Inc(k, 8); - end; - - t := uInt(b) and $3fff; - s.sub.trees.table := t; - {$ifndef PKZIP_BUG_WORKAROUND} - if ((t and $1f) > 29) or (((t shr 5) and $1f) > 29) then - begin - s.mode := BLKBAD; - z.msg := 'too many length or distance symbols'; - r := Z_DATA_ERROR; - { update pointers and return } - 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_blocks := inflate_flush(s,z,r); - exit; - end; - {$endif} - t := 258 + (t and $1f) + ((t shr 5) and $1f); - s.sub.trees.blens := puIntArray( ZALLOC(z, t, sizeof(uInt)) ); - if (s.sub.trees.blens = Z_NULL) then - begin - r := Z_MEM_ERROR; - { update pointers and return } - 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_blocks := inflate_flush(s,z,r); - exit; - end; - {DUMPBITS(14);} - b := b shr 14; - Dec(k, 14); - - s.sub.trees.index := 0; - {$IFDEF DEBUG} - Tracev('inflate: table sizes ok'); - {$ENDIF} - s.mode := BTREE; - { fall trough case is handled by the while } - { try GOTO for speed - Nomssi } - goto start_btree; - end; - BTREE: - begin - start_btree: - while (s.sub.trees.index < 4 + (s.sub.trees.table shr 10)) do - begin - {NEEDBITS(3);} - while (k < 3) 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, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - Dec(n); - b := b or (uLong(p^) shl k); - Inc(p); - Inc(k, 8); - end; - - s.sub.trees.blens^[border[s.sub.trees.index]] := uInt(b) and 7; - Inc(s.sub.trees.index); - {DUMPBITS(3);} - b := b shr 3; - Dec(k, 3); - end; - while (s.sub.trees.index < 19) do - begin - s.sub.trees.blens^[border[s.sub.trees.index]] := 0; - Inc(s.sub.trees.index); - end; - s.sub.trees.bb := 7; - t := inflate_trees_bits(s.sub.trees.blens^, s.sub.trees.bb, - s.sub.trees.tb, s.hufts^, z); - if (t <> Z_OK) then - begin - ZFREE(z, s.sub.trees.blens); - r := t; - if (r = Z_DATA_ERROR) then - s.mode := BLKBAD; - { update pointers and return } - 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_blocks := inflate_flush(s,z,r); - exit; - end; - s.sub.trees.index := 0; - {$IFDEF DEBUG} - Tracev('inflate: bits tree ok'); - {$ENDIF} - s.mode := DTREE; - { fall through again } - goto start_dtree; - end; - DTREE: - begin - start_dtree: - while TRUE do - begin - t := s.sub.trees.table; - if not (s.sub.trees.index < 258 + - (t and $1f) + ((t shr 5) and $1f)) then - break; - t := s.sub.trees.bb; - {NEEDBITS(t);} - while (k < t) 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, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - Dec(n); - b := b or (uLong(p^) shl k); - Inc(p); - Inc(k, 8); - end; - - h := s.sub.trees.tb; - Inc(h, uInt(b) and inflate_mask[t]); - t := h^.Bits; - c := h^.Base; - - if (c < 16) then - begin - {DUMPBITS(t);} - b := b shr t; - Dec(k, t); - - s.sub.trees.blens^[s.sub.trees.index] := c; - Inc(s.sub.trees.index); - end - else { c = 16..18 } - begin - if c = 18 then - begin - i := 7; - j := 11; - end - else - begin - i := c - 14; - j := 3; - end; - {NEEDBITS(t + i);} - while (k < t + i) 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, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - Dec(n); - b := b or (uLong(p^) shl k); - Inc(p); - Inc(k, 8); - end; - - {DUMPBITS(t);} - b := b shr t; - Dec(k, t); - - Inc(j, uInt(b) and inflate_mask[i]); - {DUMPBITS(i);} - b := b shr i; - Dec(k, i); - - i := s.sub.trees.index; - t := s.sub.trees.table; - if (i + j > 258 + (t and $1f) + ((t shr 5) and $1f)) or - ((c = 16) and (i < 1)) then - begin - ZFREE(z, s.sub.trees.blens); - s.mode := BLKBAD; - z.msg := 'invalid bit length repeat'; - r := Z_DATA_ERROR; - { update pointers and return } - 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_blocks := inflate_flush(s,z,r); - exit; - end; - if c = 16 then - c := s.sub.trees.blens^[i - 1] - else - c := 0; - repeat - s.sub.trees.blens^[i] := c; - Inc(i); - Dec(j); - until (j=0); - s.sub.trees.index := i; - end; - end; { while } - s.sub.trees.tb := Z_NULL; - begin - bl := 9; { must be <= 9 for lookahead assumptions } - bd := 6; { must be <= 9 for lookahead assumptions } - t := s.sub.trees.table; - t := inflate_trees_dynamic(257 + (t and $1f), - 1 + ((t shr 5) and $1f), - s.sub.trees.blens^, bl, bd, tl, td, s.hufts^, z); - ZFREE(z, s.sub.trees.blens); - if (t <> Z_OK) then - begin - if (t = uInt(Z_DATA_ERROR)) then - s.mode := BLKBAD; - r := t; - { update pointers and return } - 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_blocks := inflate_flush(s,z,r); - exit; - end; - {$IFDEF DEBUG} - Tracev('inflate: trees ok'); - {$ENDIF} - { c renamed to cs } - cs := inflate_codes_new(bl, bd, tl, td, z); - if (cs = Z_NULL) then - begin - r := Z_MEM_ERROR; - { update pointers and return } - 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_blocks := inflate_flush(s,z,r); - exit; - end; - s.sub.decode.codes := cs; - end; - s.mode := CODES; - { yet another falltrough } - goto start_codes; - end; - CODES: - begin - start_codes: - { update pointers } - 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; - - r := inflate_codes(s, z, r); - if (r <> Z_STREAM_END) then - begin - inflate_blocks := inflate_flush(s, z, r); - exit; - end; - r := Z_OK; - inflate_codes_free(s.sub.decode.codes, z); - { load local pointers } - 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)); - {$IFDEF DEBUG} - if (ptr2int(q) >= ptr2int(s.read)) then - Tracev('inflate: codes end '+ - IntToStr(z.total_out + ptr2int(q) - ptr2int(s.read)) + ' total out') - else - Tracev('inflate: codes end '+ - IntToStr(z.total_out + ptr2int(s.zend) - ptr2int(s.read) + - ptr2int(q) - ptr2int(s.window)) + ' total out'); - {$ENDIF} - if (not s.last) then - begin - s.mode := ZTYPE; - continue; { break for switch statement in C-code } - end; - {$ifndef patch112} - if (k > 7) then { return unused byte, if any } - begin - {$IFDEF DEBUG} - Assert(k < 16, 'inflate_codes grabbed too many bytes'); - {$ENDIF} - Dec(k, 8); - Inc(n); - Dec(p); { can always return one } - end; - {$endif} - s.mode := DRY; - { another falltrough } - goto start_dry; - end; - DRY: - begin - start_dry: - {FLUSH} - s.write := q; - r := inflate_flush(s,z,r); - q := s.write; - - { not needed anymore, we are done: - if ptr2int(q) < ptr2int(s.read) then - m := uInt(ptr2int(s.read)-ptr2int(q)-1) - else - m := uInt(ptr2int(s.zend)-ptr2int(q)); - } - - if (s.read <> s.write) then - begin - { update pointers and return } - 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_blocks := inflate_flush(s,z,r); - exit; - end; - s.mode := BLKDONE; - goto start_blkdone; - end; - BLKDONE: - begin - start_blkdone: - r := Z_STREAM_END; - { update pointers and return } - 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_blocks := inflate_flush(s,z,r); - exit; - end; - BLKBAD: - begin - r := Z_DATA_ERROR; - { update pointers and return } - 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_blocks := inflate_flush(s,z,r); - exit; - end; - else - begin - r := Z_STREAM_ERROR; - { update pointers and return } - 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_blocks := inflate_flush(s,z,r); - exit; - end; - end; { Case s.mode of } - -end; - - -function inflate_blocks_free(s : pInflate_blocks_state; - var z : z_stream) : int; -begin - inflate_blocks_reset(s^, z, Z_NULL); - ZFREE(z, s^.window); - ZFREE(z, s^.hufts); - ZFREE(z, s); - {$IFDEF DEBUG} - Trace('inflate: blocks freed'); - {$ENDIF} - inflate_blocks_free := Z_OK; -end; - - -procedure inflate_set_dictionary(var s : inflate_blocks_state; - const d : array of byte; { dictionary } - n : uInt); { dictionary length } -begin - zmemcpy(s.window, pBytef(@d), n); - s.write := s.window; - Inc(s.write, n); - s.read := s.write; -end; - - -{ Returns true if inflate is currently at the end of a block generated - by Z_SYNC_FLUSH or Z_FULL_FLUSH. - IN assertion: s <> Z_NULL } - -function inflate_blocks_sync_point(var s : inflate_blocks_state) : int; -begin - inflate_blocks_sync_point := int(s.mode = LENS); -end; - -end. +Unit iminfblock; + +{ infblock.h and + infblock.c -- interpret and process block types to last block + 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_blocks_new(var z : z_stream; + c : check_func; { check function } + w : uInt { window size } + ) : pInflate_blocks_state; + +function inflate_blocks (var s : inflate_blocks_state; + var z : z_stream; + r : int { initial return code } + ) : int; + +procedure inflate_blocks_reset (var s : inflate_blocks_state; + var z : z_stream; + c : puLong); { check value on output } + + +function inflate_blocks_free(s : pInflate_blocks_state; + var z : z_stream) : int; + +procedure inflate_set_dictionary(var s : inflate_blocks_state; + const d : array of byte; { dictionary } + n : uInt); { dictionary length } + +function inflate_blocks_sync_point(var s : inflate_blocks_state) : int; + +implementation + +uses + iminfcodes, iminftrees, iminfutil; + +{ Tables for deflate from PKZIP's appnote.txt. } +Const + border : Array [0..18] Of Word { Order of the bit length code lengths } + = (16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15); + +{ Notes beyond the 1.93a appnote.txt: + + 1. Distance pointers never point before the beginning of the output + stream. + 2. Distance pointers can point back across blocks, up to 32k away. + 3. There is an implied maximum of 7 bits for the bit length table and + 15 bits for the actual data. + 4. If only one code exists, then it is encoded using one bit. (Zero + would be more efficient, but perhaps a little confusing.) If two + codes exist, they are coded using one bit each (0 and 1). + 5. There is no way of sending zero distance codes--a dummy must be + sent if there are none. (History: a pre 2.0 version of PKZIP would + store blocks with no distance codes, but this was discovered to be + too harsh a criterion.) Valid only for 1.93a. 2.04c does allow + zero distance codes, which is sent as one code of zero bits in + length. + 6. There are up to 286 literal/length codes. Code 256 represents the + end-of-block. Note however that the static length tree defines + 288 codes just to fill out the Huffman codes. Codes 286 and 287 + cannot be used though, since there is no length base or extra bits + defined for them. Similarily, there are up to 30 distance codes. + However, static trees define 32 codes (all 5 bits) to fill out the + Huffman codes, but the last two had better not show up in the data. + 7. Unzip can check dynamic Huffman blocks for complete code sets. + The exception is that a single code would not be complete (see #4). + 8. The five bits following the block type is really the number of + literal codes sent minus 257. + 9. Length codes 8,16,16 are interpreted as 13 length codes of 8 bits + (1+6+6). Therefore, to output three times the length, you output + three codes (1+1+1), whereas to output four times the same length, + you only need two codes (1+3). Hmm. + 10. In the tree reconstruction algorithm, Code = Code + Increment + only if BitLength(i) is not zero. (Pretty obvious.) + 11. Correction: 4 Bits: # of Bit Length codes - 4 (4 - 19) + 12. Note: length code 284 can represent 227-258, but length code 285 + really is 258. The last length deserves its own, short code + since it gets used a lot in very redundant files. The length + 258 is special since 258 - 3 (the min match length) is 255. + 13. The literal/length and distance code bit lengths are read as a + single stream of lengths. It is possible (and advantageous) for + a repeat code (16, 17, or 18) to go across the boundary between + the two sets of lengths. } + + +procedure inflate_blocks_reset (var s : inflate_blocks_state; + var z : z_stream; + c : puLong); { check value on output } +begin + if (c <> Z_NULL) then + c^ := s.check; + if (s.mode = BTREE) or (s.mode = DTREE) then + ZFREE(z, s.sub.trees.blens); + if (s.mode = CODES) then + inflate_codes_free(s.sub.decode.codes, z); + + s.mode := ZTYPE; + s.bitk := 0; + s.bitb := 0; + + s.write := s.window; + s.read := s.window; + if Assigned(s.checkfn) then + begin + s.check := s.checkfn(uLong(0), pBytef(NIL), 0); + z.adler := s.check; + end; + {$IFDEF DEBUG} + Tracev('inflate: blocks reset'); + {$ENDIF} +end; + + +function inflate_blocks_new(var z : z_stream; + c : check_func; { check function } + w : uInt { window size } + ) : pInflate_blocks_state; +var + s : pInflate_blocks_state; +begin + s := pInflate_blocks_state( ZALLOC(z,1, sizeof(inflate_blocks_state)) ); + if (s = Z_NULL) then + begin + inflate_blocks_new := s; + exit; + end; + s^.hufts := huft_ptr( ZALLOC(z, sizeof(inflate_huft), MANY) ); + + if (s^.hufts = Z_NULL) then + begin + ZFREE(z, s); + inflate_blocks_new := Z_NULL; + exit; + end; + + s^.window := pBytef( ZALLOC(z, 1, w) ); + if (s^.window = Z_NULL) then + begin + ZFREE(z, s^.hufts); + ZFREE(z, s); + inflate_blocks_new := Z_NULL; + exit; + end; + s^.zend := s^.window; + Inc(s^.zend, w); + s^.checkfn := c; + s^.mode := ZTYPE; + {$IFDEF DEBUG} + Tracev('inflate: blocks allocated'); + {$ENDIF} + inflate_blocks_reset(s^, z, Z_NULL); + inflate_blocks_new := s; +end; + + +function inflate_blocks (var s : inflate_blocks_state; + var z : z_stream; + r : int) : int; { initial return code } +label + start_btree, start_dtree, + start_blkdone, start_dry, + start_codes; + +var + t : uInt; { temporary storage } + 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 } +{ fixed code blocks } +var + bl, bd : uInt; + tl, td : pInflate_huft; +var + h : pInflate_huft; + i, j, c : uInt; +var + cs : pInflate_codes_state; +begin + { copy input/output information to locals } + 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)); + +{ decompress an inflated block } + + + { process input based on current state } + while True do + Case s.mode of + ZTYPE: + begin + {NEEDBITS(3);} + while (k < 3) 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, ptr2int(p)-ptr2int(z.next_in)); + z.next_in := p; + s.write := q; + inflate_blocks := inflate_flush(s,z,r); + exit; + end; + Dec(n); + b := b or (uLong(p^) shl k); + Inc(p); + Inc(k, 8); + end; + + t := uInt(b) and 7; + s.last := boolean(t and 1); + case (t shr 1) of + 0: { stored } + begin + {$IFDEF DEBUG} + if s.last then + Tracev('inflate: stored block (last)') + else + Tracev('inflate: stored block'); + {$ENDIF} + {DUMPBITS(3);} + b := b shr 3; + Dec(k, 3); + + t := k and 7; { go to byte boundary } + {DUMPBITS(t);} + b := b shr t; + Dec(k, t); + + s.mode := LENS; { get length of stored block } + end; + 1: { fixed } + begin + begin + {$IFDEF DEBUG} + if s.last then + Tracev('inflate: fixed codes blocks (last)') + else + Tracev('inflate: fixed codes blocks'); + {$ENDIF} + inflate_trees_fixed(bl, bd, tl, td, z); + s.sub.decode.codes := inflate_codes_new(bl, bd, tl, td, z); + if (s.sub.decode.codes = Z_NULL) then + begin + r := Z_MEM_ERROR; + { update pointers and return } + 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_blocks := inflate_flush(s,z,r); + exit; + end; + end; + {DUMPBITS(3);} + b := b shr 3; + Dec(k, 3); + + s.mode := CODES; + end; + 2: { dynamic } + begin + {$IFDEF DEBUG} + if s.last then + Tracev('inflate: dynamic codes block (last)') + else + Tracev('inflate: dynamic codes block'); + {$ENDIF} + {DUMPBITS(3);} + b := b shr 3; + Dec(k, 3); + + s.mode := TABLE; + end; + 3: + begin { illegal } + {DUMPBITS(3);} + b := b shr 3; + Dec(k, 3); + + s.mode := BLKBAD; + z.msg := 'invalid block type'; + r := Z_DATA_ERROR; + { update pointers and return } + 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_blocks := inflate_flush(s,z,r); + exit; + end; + end; + end; + LENS: + begin + {NEEDBITS(32);} + while (k < 32) 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, ptr2int(p)-ptr2int(z.next_in)); + z.next_in := p; + s.write := q; + inflate_blocks := inflate_flush(s,z,r); + exit; + end; + Dec(n); + b := b or (uLong(p^) shl k); + Inc(p); + Inc(k, 8); + end; + + if (((not b) shr 16) and $ffff) <> (b and $ffff) then + begin + s.mode := BLKBAD; + z.msg := 'invalid stored block lengths'; + r := Z_DATA_ERROR; + { update pointers and return } + 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_blocks := inflate_flush(s,z,r); + exit; + end; + s.sub.left := uInt(b) and $ffff; + k := 0; + b := 0; { dump bits } + {$IFDEF DEBUG} + Tracev('inflate: stored length '+IntToStr(s.sub.left)); + {$ENDIF} + if s.sub.left <> 0 then + s.mode := STORED + else + if s.last then + s.mode := DRY + else + s.mode := ZTYPE; + end; + STORED: + begin + if (n = 0) then + begin + { update pointers and return } + 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_blocks := inflate_flush(s,z,r); + exit; + end; + {NEEDOUT} + if (m = 0) then + begin + {WRAP} + if (q = s.zend) and (s.read <> s.window) then + begin + q := s.window; + if ptr2int(q) < ptr2int(s.read) then + m := uInt(ptr2int(s.read)-ptr2int(q)-1) + else + m := uInt(ptr2int(s.zend)-ptr2int(q)); + end; + + if (m = 0) then + begin + {FLUSH} + s.write := q; + r := inflate_flush(s,z,r); + 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)); + + {WRAP} + if (q = s.zend) and (s.read <> s.window) then + begin + q := s.window; + if ptr2int(q) < ptr2int(s.read) then + m := uInt(ptr2int(s.read)-ptr2int(q)-1) + else + m := uInt(ptr2int(s.zend)-ptr2int(q)); + end; + + if (m = 0) then + begin + {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_blocks := inflate_flush(s,z,r); + exit; + end; + end; + end; + r := Z_OK; + + t := s.sub.left; + if (t > n) then + t := n; + if (t > m) then + t := m; + zmemcpy(q, p, t); + Inc(p, t); Dec(n, t); + Inc(q, t); Dec(m, t); + Dec(s.sub.left, t); + if (s.sub.left = 0) then + begin + {$IFDEF DEBUG} + if (ptr2int(q) >= ptr2int(s.read)) then + Tracev('inflate: stored end '+ + IntToStr(z.total_out + ptr2int(q) - ptr2int(s.read)) + ' total out') + else + Tracev('inflate: stored end '+ + IntToStr(z.total_out + ptr2int(s.zend) - ptr2int(s.read) + + ptr2int(q) - ptr2int(s.window)) + ' total out'); + {$ENDIF} + if s.last then + s.mode := DRY + else + s.mode := ZTYPE; + end; + end; + TABLE: + begin + {NEEDBITS(14);} + while (k < 14) 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, ptr2int(p)-ptr2int(z.next_in)); + z.next_in := p; + s.write := q; + inflate_blocks := inflate_flush(s,z,r); + exit; + end; + Dec(n); + b := b or (uLong(p^) shl k); + Inc(p); + Inc(k, 8); + end; + + t := uInt(b) and $3fff; + s.sub.trees.table := t; + {$ifndef PKZIP_BUG_WORKAROUND} + if ((t and $1f) > 29) or (((t shr 5) and $1f) > 29) then + begin + s.mode := BLKBAD; + z.msg := 'too many length or distance symbols'; + r := Z_DATA_ERROR; + { update pointers and return } + 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_blocks := inflate_flush(s,z,r); + exit; + end; + {$endif} + t := 258 + (t and $1f) + ((t shr 5) and $1f); + s.sub.trees.blens := puIntArray( ZALLOC(z, t, sizeof(uInt)) ); + if (s.sub.trees.blens = Z_NULL) then + begin + r := Z_MEM_ERROR; + { update pointers and return } + 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_blocks := inflate_flush(s,z,r); + exit; + end; + {DUMPBITS(14);} + b := b shr 14; + Dec(k, 14); + + s.sub.trees.index := 0; + {$IFDEF DEBUG} + Tracev('inflate: table sizes ok'); + {$ENDIF} + s.mode := BTREE; + { fall trough case is handled by the while } + { try GOTO for speed - Nomssi } + goto start_btree; + end; + BTREE: + begin + start_btree: + while (s.sub.trees.index < 4 + (s.sub.trees.table shr 10)) do + begin + {NEEDBITS(3);} + while (k < 3) 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, ptr2int(p)-ptr2int(z.next_in)); + z.next_in := p; + s.write := q; + inflate_blocks := inflate_flush(s,z,r); + exit; + end; + Dec(n); + b := b or (uLong(p^) shl k); + Inc(p); + Inc(k, 8); + end; + + s.sub.trees.blens^[border[s.sub.trees.index]] := uInt(b) and 7; + Inc(s.sub.trees.index); + {DUMPBITS(3);} + b := b shr 3; + Dec(k, 3); + end; + while (s.sub.trees.index < 19) do + begin + s.sub.trees.blens^[border[s.sub.trees.index]] := 0; + Inc(s.sub.trees.index); + end; + s.sub.trees.bb := 7; + t := inflate_trees_bits(s.sub.trees.blens^, s.sub.trees.bb, + s.sub.trees.tb, s.hufts^, z); + if (t <> Z_OK) then + begin + ZFREE(z, s.sub.trees.blens); + r := t; + if (r = Z_DATA_ERROR) then + s.mode := BLKBAD; + { update pointers and return } + 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_blocks := inflate_flush(s,z,r); + exit; + end; + s.sub.trees.index := 0; + {$IFDEF DEBUG} + Tracev('inflate: bits tree ok'); + {$ENDIF} + s.mode := DTREE; + { fall through again } + goto start_dtree; + end; + DTREE: + begin + start_dtree: + while TRUE do + begin + t := s.sub.trees.table; + if not (s.sub.trees.index < 258 + + (t and $1f) + ((t shr 5) and $1f)) then + break; + t := s.sub.trees.bb; + {NEEDBITS(t);} + while (k < t) 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, ptr2int(p)-ptr2int(z.next_in)); + z.next_in := p; + s.write := q; + inflate_blocks := inflate_flush(s,z,r); + exit; + end; + Dec(n); + b := b or (uLong(p^) shl k); + Inc(p); + Inc(k, 8); + end; + + h := s.sub.trees.tb; + Inc(h, uInt(b) and inflate_mask[t]); + t := h^.Bits; + c := h^.Base; + + if (c < 16) then + begin + {DUMPBITS(t);} + b := b shr t; + Dec(k, t); + + s.sub.trees.blens^[s.sub.trees.index] := c; + Inc(s.sub.trees.index); + end + else { c = 16..18 } + begin + if c = 18 then + begin + i := 7; + j := 11; + end + else + begin + i := c - 14; + j := 3; + end; + {NEEDBITS(t + i);} + while (k < t + i) 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, ptr2int(p)-ptr2int(z.next_in)); + z.next_in := p; + s.write := q; + inflate_blocks := inflate_flush(s,z,r); + exit; + end; + Dec(n); + b := b or (uLong(p^) shl k); + Inc(p); + Inc(k, 8); + end; + + {DUMPBITS(t);} + b := b shr t; + Dec(k, t); + + Inc(j, uInt(b) and inflate_mask[i]); + {DUMPBITS(i);} + b := b shr i; + Dec(k, i); + + i := s.sub.trees.index; + t := s.sub.trees.table; + if (i + j > 258 + (t and $1f) + ((t shr 5) and $1f)) or + ((c = 16) and (i < 1)) then + begin + ZFREE(z, s.sub.trees.blens); + s.mode := BLKBAD; + z.msg := 'invalid bit length repeat'; + r := Z_DATA_ERROR; + { update pointers and return } + 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_blocks := inflate_flush(s,z,r); + exit; + end; + if c = 16 then + c := s.sub.trees.blens^[i - 1] + else + c := 0; + repeat + s.sub.trees.blens^[i] := c; + Inc(i); + Dec(j); + until (j=0); + s.sub.trees.index := i; + end; + end; { while } + s.sub.trees.tb := Z_NULL; + begin + bl := 9; { must be <= 9 for lookahead assumptions } + bd := 6; { must be <= 9 for lookahead assumptions } + t := s.sub.trees.table; + t := inflate_trees_dynamic(257 + (t and $1f), + 1 + ((t shr 5) and $1f), + s.sub.trees.blens^, bl, bd, tl, td, s.hufts^, z); + ZFREE(z, s.sub.trees.blens); + if (t <> Z_OK) then + begin + if (t = uInt(Z_DATA_ERROR)) then + s.mode := BLKBAD; + r := t; + { update pointers and return } + 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_blocks := inflate_flush(s,z,r); + exit; + end; + {$IFDEF DEBUG} + Tracev('inflate: trees ok'); + {$ENDIF} + { c renamed to cs } + cs := inflate_codes_new(bl, bd, tl, td, z); + if (cs = Z_NULL) then + begin + r := Z_MEM_ERROR; + { update pointers and return } + 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_blocks := inflate_flush(s,z,r); + exit; + end; + s.sub.decode.codes := cs; + end; + s.mode := CODES; + { yet another falltrough } + goto start_codes; + end; + CODES: + begin + start_codes: + { update pointers } + 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; + + r := inflate_codes(s, z, r); + if (r <> Z_STREAM_END) then + begin + inflate_blocks := inflate_flush(s, z, r); + exit; + end; + r := Z_OK; + inflate_codes_free(s.sub.decode.codes, z); + { load local pointers } + 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)); + {$IFDEF DEBUG} + if (ptr2int(q) >= ptr2int(s.read)) then + Tracev('inflate: codes end '+ + IntToStr(z.total_out + ptr2int(q) - ptr2int(s.read)) + ' total out') + else + Tracev('inflate: codes end '+ + IntToStr(z.total_out + ptr2int(s.zend) - ptr2int(s.read) + + ptr2int(q) - ptr2int(s.window)) + ' total out'); + {$ENDIF} + if (not s.last) then + begin + s.mode := ZTYPE; + continue; { break for switch statement in C-code } + end; + {$ifndef patch112} + if (k > 7) then { return unused byte, if any } + begin + {$IFDEF DEBUG} + Assert(k < 16, 'inflate_codes grabbed too many bytes'); + {$ENDIF} + Dec(k, 8); + Inc(n); + Dec(p); { can always return one } + end; + {$endif} + s.mode := DRY; + { another falltrough } + goto start_dry; + end; + DRY: + begin + start_dry: + {FLUSH} + s.write := q; + r := inflate_flush(s,z,r); + q := s.write; + + { not needed anymore, we are done: + if ptr2int(q) < ptr2int(s.read) then + m := uInt(ptr2int(s.read)-ptr2int(q)-1) + else + m := uInt(ptr2int(s.zend)-ptr2int(q)); + } + + if (s.read <> s.write) then + begin + { update pointers and return } + 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_blocks := inflate_flush(s,z,r); + exit; + end; + s.mode := BLKDONE; + goto start_blkdone; + end; + BLKDONE: + begin + start_blkdone: + r := Z_STREAM_END; + { update pointers and return } + 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_blocks := inflate_flush(s,z,r); + exit; + end; + BLKBAD: + begin + r := Z_DATA_ERROR; + { update pointers and return } + 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_blocks := inflate_flush(s,z,r); + exit; + end; + else + begin + r := Z_STREAM_ERROR; + { update pointers and return } + 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_blocks := inflate_flush(s,z,r); + exit; + end; + end; { Case s.mode of } + +end; + + +function inflate_blocks_free(s : pInflate_blocks_state; + var z : z_stream) : int; +begin + inflate_blocks_reset(s^, z, Z_NULL); + ZFREE(z, s^.window); + ZFREE(z, s^.hufts); + ZFREE(z, s); + {$IFDEF DEBUG} + Trace('inflate: blocks freed'); + {$ENDIF} + inflate_blocks_free := Z_OK; +end; + + +procedure inflate_set_dictionary(var s : inflate_blocks_state; + const d : array of byte; { dictionary } + n : uInt); { dictionary length } +begin + zmemcpy(s.window, pBytef(@d), n); + s.write := s.window; + Inc(s.write, n); + s.read := s.write; +end; + + +{ Returns true if inflate is currently at the end of a block generated + by Z_SYNC_FLUSH or Z_FULL_FLUSH. + IN assertion: s <> Z_NULL } + +function inflate_blocks_sync_point(var s : inflate_blocks_state) : int; +begin + inflate_blocks_sync_point := int(s.mode = LENS); +end; + +end. diff --git a/Imaging/ZLib/iminftrees.pas b/Imaging/ZLib/iminftrees.pas index 94278af..6949a63 100644 --- a/Imaging/ZLib/iminftrees.pas +++ b/Imaging/ZLib/iminftrees.pas @@ -1,781 +1,781 @@ -Unit iminftrees; - -{ inftrees.h -- header to use inftrees.c - inftrees.c -- generate Huffman trees for efficient decoding - 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; - - -{ Maximum size of dynamic tree. The maximum found in a long but non- - exhaustive search was 1004 huft structures (850 for length/literals - and 154 for distances, the latter actually the result of an - exhaustive search). The actual maximum is not known, but the - value below is more than safe. } -const - MANY = 1440; - - -{$ifdef DEBUG} -var - inflate_hufts : uInt; -{$endif} - -function inflate_trees_bits( - var c : array of uIntf; { 19 code lengths } - var bb : uIntf; { bits tree desired/actual depth } - var tb : pinflate_huft; { bits tree result } - var hp : array of Inflate_huft; { space for trees } - var z : z_stream { for messages } - ) : int; - -function inflate_trees_dynamic( - nl : uInt; { number of literal/length codes } - nd : uInt; { number of distance codes } - var c : Array of uIntf; { that many (total) code lengths } - var bl : uIntf; { literal desired/actual bit depth } - var bd : uIntf; { distance desired/actual bit depth } -var tl : pInflate_huft; { literal/length tree result } -var td : pInflate_huft; { distance tree result } -var hp : array of Inflate_huft; { space for trees } -var z : z_stream { for messages } - ) : int; - -function inflate_trees_fixed ( - var bl : uInt; { literal desired/actual bit depth } - var bd : uInt; { distance desired/actual bit depth } - var tl : pInflate_huft; { literal/length tree result } - var td : pInflate_huft; { distance tree result } - var z : z_stream { for memory allocation } - ) : int; - - -implementation - -const - inflate_copyright = 'inflate 1.1.2 Copyright 1995-1998 Mark Adler'; - -{ - If you use the zlib library in a product, an acknowledgment is welcome - in the documentation of your product. If for some reason you cannot - include such an acknowledgment, I would appreciate that you keep this - copyright string in the executable of your product. -} - - -const -{ Tables for deflate from PKZIP's appnote.txt. } - cplens : Array [0..30] Of uInt { Copy lengths for literal codes 257..285 } - = (3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31, - 35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258, 0, 0); - { actually lengths - 2; also see note #13 above about 258 } - - invalid_code = 112; - - cplext : Array [0..30] Of uInt { Extra bits for literal codes 257..285 } - = (0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, - 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 0, invalid_code, invalid_code); - - cpdist : Array [0..29] Of uInt { Copy offsets for distance codes 0..29 } - = (1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, - 257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145, - 8193, 12289, 16385, 24577); - - cpdext : Array [0..29] Of uInt { Extra bits for distance codes } - = (0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, - 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, - 12, 12, 13, 13); - -{ Huffman code decoding is performed using a multi-level table lookup. - The fastest way to decode is to simply build a lookup table whose - size is determined by the longest code. However, the time it takes - to build this table can also be a factor if the data being decoded - is not very long. The most common codes are necessarily the - shortest codes, so those codes dominate the decoding time, and hence - the speed. The idea is you can have a shorter table that decodes the - shorter, more probable codes, and then point to subsidiary tables for - the longer codes. The time it costs to decode the longer codes is - then traded against the time it takes to make longer tables. - - This results of this trade are in the variables lbits and dbits - below. lbits is the number of bits the first level table for literal/ - length codes can decode in one step, and dbits is the same thing for - the distance codes. Subsequent tables are also less than or equal to - those sizes. These values may be adjusted either when all of the - codes are shorter than that, in which case the longest code length in - bits is used, or when the shortest code is *longer* than the requested - table size, in which case the length of the shortest code in bits is - used. - - There are two different values for the two tables, since they code a - different number of possibilities each. The literal/length table - codes 286 possible values, or in a flat code, a little over eight - bits. The distance table codes 30 possible values, or a little less - than five bits, flat. The optimum values for speed end up being - about one bit more than those, so lbits is 8+1 and dbits is 5+1. - The optimum values may differ though from machine to machine, and - possibly even between compilers. Your mileage may vary. } - - -{ If BMAX needs to be larger than 16, then h and x[] should be uLong. } -const - BMAX = 15; { maximum bit length of any code } - -{$DEFINE USE_PTR} - -function huft_build( -var b : array of uIntf; { code lengths in bits (all assumed <= BMAX) } - n : uInt; { number of codes (assumed <= N_MAX) } - s : uInt; { number of simple-valued codes (0..s-1) } -const d : array of uIntf; { list of base values for non-simple codes } -{ array of word } -const e : array of uIntf; { list of extra bits for non-simple codes } -{ array of byte } - t : ppInflate_huft; { result: starting table } -var m : uIntf; { maximum lookup bits, returns actual } -var hp : array of inflate_huft; { space for trees } -var hn : uInt; { hufts used in space } -var v : array of uIntf { working area: values in order of bit length } - ) : int; -{ Given a list of code lengths and a maximum table size, make a set of - tables to decode that set of codes. Return Z_OK on success, Z_BUF_ERROR - if the given code set is incomplete (the tables are still built in this - case), Z_DATA_ERROR if the input is invalid (an over-subscribed set of - lengths), or Z_MEM_ERROR if not enough memory. } -Var - a : uInt; { counter for codes of length k } - c : Array [0..BMAX] Of uInt; { bit length count table } - f : uInt; { i repeats in table every f entries } - g : int; { maximum code length } - h : int; { table level } - i : uInt; {register} { counter, current code } - j : uInt; {register} { counter } - k : Int; {register} { number of bits in current code } - l : int; { bits per table (returned in m) } - mask : uInt; { (1 shl w) - 1, to avoid cc -O bug on HP } - p : ^uIntf; {register} { pointer into c[], b[], or v[] } - q : pInflate_huft; { points to current table } - r : inflate_huft; { table entry for structure assignment } - u : Array [0..BMAX-1] Of pInflate_huft; { table stack } - w : int; {register} { bits before this table = (l*h) } - x : Array [0..BMAX] Of uInt; { bit offsets, then code stack } - {$IFDEF USE_PTR} - xp : puIntf; { pointer into x } - {$ELSE} - xp : uInt; - {$ENDIF} - y : int; { number of dummy codes added } - z : uInt; { number of entries in current table } -Begin - { Generate counts for each bit length } - FillChar(c,SizeOf(c),0) ; { clear c[] } - - for i := 0 to n-1 do - Inc (c[b[i]]); { assume all entries <= BMAX } - - If (c[0] = n) Then { null input--all zero length codes } - Begin - t^ := pInflate_huft(NIL); - m := 0 ; - huft_build := Z_OK ; - Exit; - End ; - - { Find minimum and maximum length, bound [m] by those } - l := m; - for j:=1 To BMAX do - if (c[j] <> 0) then - break; - k := j ; { minimum code length } - if (uInt(l) < j) then - l := j; - for i := BMAX downto 1 do - if (c[i] <> 0) then - break ; - g := i ; { maximum code length } - if (uInt(l) > i) then - l := i; - m := l; - - { Adjust last length count to fill out codes, if needed } - y := 1 shl j ; - while (j < i) do - begin - Dec(y, c[j]) ; - if (y < 0) then - begin - huft_build := Z_DATA_ERROR; { bad input: more codes than bits } - exit; - end ; - Inc(j) ; - y := y shl 1 - end; - Dec (y, c[i]) ; - if (y < 0) then - begin - huft_build := Z_DATA_ERROR; { bad input: more codes than bits } - exit; - end; - Inc(c[i], y); - - { Generate starting offsets into the value table FOR each length } - {$IFDEF USE_PTR} - x[1] := 0; - j := 0; - - p := @c[1]; - xp := @x[2]; - - dec(i); { note that i = g from above } - WHILE (i > 0) DO - BEGIN - inc(j, p^); - xp^ := j; - inc(p); - inc(xp); - dec(i); - END; - {$ELSE} - x[1] := 0; - j := 0 ; - for i := 1 to g do - begin - x[i] := j; - Inc(j, c[i]); - end; - {$ENDIF} - - { Make a table of values in order of bit lengths } - for i := 0 to n-1 do - begin - j := b[i]; - if (j <> 0) then - begin - v[ x[j] ] := i; - Inc(x[j]); - end; - end; - n := x[g]; { set n to length of v } - - { Generate the Huffman codes and for each, make the table entries } - i := 0 ; - x[0] := 0 ; { first Huffman code is zero } - p := Addr(v) ; { grab values in bit order } - h := -1 ; { no tables yet--level -1 } - w := -l ; { bits decoded = (l*h) } - - u[0] := pInflate_huft(NIL); { just to keep compilers happy } - q := pInflate_huft(NIL); { ditto } - z := 0 ; { ditto } - - { go through the bit lengths (k already is bits in shortest code) } - while (k <= g) Do - begin - a := c[k] ; - while (a<>0) Do - begin - Dec (a) ; - { here i is the Huffman code of length k bits for value p^ } - { make tables up to required level } - while (k > w + l) do - begin - - Inc (h) ; - Inc (w, l); { add bits already decoded } - { previous table always l bits } - { compute minimum size table less than or equal to l bits } - - { table size upper limit } - z := g - w; - If (z > uInt(l)) Then - z := l; - - { try a k-w bit table } - j := k - w; - f := 1 shl j; - if (f > a+1) Then { too few codes for k-w bit table } - begin - Dec(f, a+1); { deduct codes from patterns left } - {$IFDEF USE_PTR} - xp := Addr(c[k]); - - if (j < z) then - begin - Inc(j); - while (j < z) do - begin { try smaller tables up to z bits } - f := f shl 1; - Inc (xp) ; - If (f <= xp^) Then - break; { enough codes to use up j bits } - Dec(f, xp^); { else deduct codes from patterns } - Inc(j); - end; - end; - {$ELSE} - xp := k; - - if (j < z) then - begin - Inc (j) ; - While (j < z) Do - begin { try smaller tables up to z bits } - f := f * 2; - Inc (xp) ; - if (f <= c[xp]) then - Break ; { enough codes to use up j bits } - Dec (f, c[xp]) ; { else deduct codes from patterns } - Inc (j); - end; - end; - {$ENDIF} - end; - - z := 1 shl j; { table entries for j-bit table } - - { allocate new table } - if (hn + z > MANY) then { (note: doesn't matter for fixed) } - begin - huft_build := Z_MEM_ERROR; { not enough memory } - exit; - end; - - q := @hp[hn]; - u[h] := q; - Inc(hn, z); - - { connect to last table, if there is one } - if (h <> 0) then - begin - x[h] := i; { save pattern for backing up } - r.bits := Byte(l); { bits to dump before this table } - r.exop := Byte(j); { bits in this table } - j := i shr (w - l); - {r.base := uInt( q - u[h-1] -j);} { offset to this table } - r.base := (ptr2int(q) - ptr2int(u[h-1]) ) div sizeof(q^) - j; - huft_Ptr(u[h-1])^[j] := r; { connect to last table } - end - else - t^ := q; { first table is returned result } - end; - - { set up table entry in r } - r.bits := Byte(k - w); - - { C-code: if (p >= v + n) - see ZUTIL.PAS for comments } - - if ptr2int(p)>=ptr2int(@(v[n])) then { also works under DPMI ?? } - r.exop := 128 + 64 { out of values--invalid code } - else - if (p^ < s) then - begin - if (p^ < 256) then { 256 is end-of-block code } - r.exop := 0 - Else - r.exop := 32 + 64; { EOB_code; } - r.base := p^; { simple code is just the value } - Inc(p); - end - Else - begin - r.exop := Byte(e[p^-s] + 16 + 64); { non-simple--look up in lists } - r.base := d[p^-s]; - Inc (p); - end ; - - { fill code-like entries with r } - f := 1 shl (k - w); - j := i shr w; - while (j < z) do - begin - huft_Ptr(q)^[j] := r; - Inc(j, f); - end; - - { backwards increment the k-bit code i } - j := 1 shl (k-1) ; - while (i and j) <> 0 do - begin - i := i xor j; { bitwise exclusive or } - j := j shr 1 - end ; - i := i xor j; - - { backup over finished tables } - mask := (1 shl w) - 1; { needed on HP, cc -O bug } - while ((i and mask) <> x[h]) do - begin - Dec(h); { don't need to update q } - Dec(w, l); - mask := (1 shl w) - 1; - end; - - end; - - Inc(k); - end; - - { Return Z_BUF_ERROR if we were given an incomplete table } - if (y <> 0) And (g <> 1) then - huft_build := Z_BUF_ERROR - else - huft_build := Z_OK; -end; { huft_build} - - -function inflate_trees_bits( - var c : array of uIntf; { 19 code lengths } - var bb : uIntf; { bits tree desired/actual depth } - var tb : pinflate_huft; { bits tree result } - var hp : array of Inflate_huft; { space for trees } - var z : z_stream { for messages } - ) : int; -var - r : int; - hn : uInt; { hufts used in space } - v : PuIntArray; { work area for huft_build } -begin - hn := 0; - v := PuIntArray( ZALLOC(z, 19, sizeof(uInt)) ); - if (v = Z_NULL) then - begin - inflate_trees_bits := Z_MEM_ERROR; - exit; - end; - - r := huft_build(c, 19, 19, cplens, cplext, - {puIntf(Z_NULL), puIntf(Z_NULL),} - @tb, bb, hp, hn, v^); - if (r = Z_DATA_ERROR) then - z.msg := 'oversubscribed dynamic bit lengths tree' - else - if (r = Z_BUF_ERROR) or (bb = 0) then - begin - z.msg := 'incomplete dynamic bit lengths tree'; - r := Z_DATA_ERROR; - end; - ZFREE(z, v); - inflate_trees_bits := r; -end; - - -function inflate_trees_dynamic( - nl : uInt; { number of literal/length codes } - nd : uInt; { number of distance codes } - var c : Array of uIntf; { that many (total) code lengths } - var bl : uIntf; { literal desired/actual bit depth } - var bd : uIntf; { distance desired/actual bit depth } -var tl : pInflate_huft; { literal/length tree result } -var td : pInflate_huft; { distance tree result } -var hp : array of Inflate_huft; { space for trees } -var z : z_stream { for messages } - ) : int; -var - r : int; - hn : uInt; { hufts used in space } - v : PuIntArray; { work area for huft_build } -begin - hn := 0; - { allocate work area } - v := PuIntArray( ZALLOC(z, 288, sizeof(uInt)) ); - if (v = Z_NULL) then - begin - inflate_trees_dynamic := Z_MEM_ERROR; - exit; - end; - - { build literal/length tree } - r := huft_build(c, nl, 257, cplens, cplext, @tl, bl, hp, hn, v^); - if (r <> Z_OK) or (bl = 0) then - begin - if (r = Z_DATA_ERROR) then - z.msg := 'oversubscribed literal/length tree' - else - if (r <> Z_MEM_ERROR) then - begin - z.msg := 'incomplete literal/length tree'; - r := Z_DATA_ERROR; - end; - - ZFREE(z, v); - inflate_trees_dynamic := r; - exit; - end; - - { build distance tree } - r := huft_build(puIntArray(@c[nl])^, nd, 0, - cpdist, cpdext, @td, bd, hp, hn, v^); - if (r <> Z_OK) or ((bd = 0) and (nl > 257)) then - begin - if (r = Z_DATA_ERROR) then - z.msg := 'oversubscribed literal/length tree' - else - if (r = Z_BUF_ERROR) then - begin -{$ifdef PKZIP_BUG_WORKAROUND} - r := Z_OK; - end; -{$else} - z.msg := 'incomplete literal/length tree'; - r := Z_DATA_ERROR; - end - else - if (r <> Z_MEM_ERROR) then - begin - z.msg := 'empty distance tree with lengths'; - r := Z_DATA_ERROR; - end; - ZFREE(z, v); - inflate_trees_dynamic := r; - exit; -{$endif} - end; - - { done } - ZFREE(z, v); - inflate_trees_dynamic := Z_OK; -end; - -{$UNDEF BUILDFIXED} - -{ build fixed tables only once--keep them here } -{$IFNDEF BUILDFIXED} -{ locals } -var - fixed_built : Boolean = false; -const - FIXEDH = 544; { number of hufts used by fixed tables } -var - fixed_mem : array[0..FIXEDH-1] of inflate_huft; - fixed_bl : uInt; - fixed_bd : uInt; - fixed_tl : pInflate_huft; - fixed_td : pInflate_huft; - -{$ELSE} - -{ inffixed.h -- table for decoding fixed codes } - -{local} -const - fixed_bl = uInt(9); -{local} -const - fixed_bd = uInt(5); -{local} -const - fixed_tl : array [0..288-1] of inflate_huft = ( - Exop, { number of extra bits or operation } - bits : Byte; { number of bits in this code or subcode } - {pad : uInt;} { pad structure to a power of 2 (4 bytes for } - { 16-bit, 8 bytes for 32-bit int's) } - base : uInt; { literal, length base, or distance base } - { or table offset } - - ((96,7),256), ((0,8),80), ((0,8),16), ((84,8),115), ((82,7),31), - ((0,8),112), ((0,8),48), ((0,9),192), ((80,7),10), ((0,8),96), - ((0,8),32), ((0,9),160), ((0,8),0), ((0,8),128), ((0,8),64), - ((0,9),224), ((80,7),6), ((0,8),88), ((0,8),24), ((0,9),144), - ((83,7),59), ((0,8),120), ((0,8),56), ((0,9),208), ((81,7),17), - ((0,8),104), ((0,8),40), ((0,9),176), ((0,8),8), ((0,8),136), - ((0,8),72), ((0,9),240), ((80,7),4), ((0,8),84), ((0,8),20), - ((85,8),227), ((83,7),43), ((0,8),116), ((0,8),52), ((0,9),200), - ((81,7),13), ((0,8),100), ((0,8),36), ((0,9),168), ((0,8),4), - ((0,8),132), ((0,8),68), ((0,9),232), ((80,7),8), ((0,8),92), - ((0,8),28), ((0,9),152), ((84,7),83), ((0,8),124), ((0,8),60), - ((0,9),216), ((82,7),23), ((0,8),108), ((0,8),44), ((0,9),184), - ((0,8),12), ((0,8),140), ((0,8),76), ((0,9),248), ((80,7),3), - ((0,8),82), ((0,8),18), ((85,8),163), ((83,7),35), ((0,8),114), - ((0,8),50), ((0,9),196), ((81,7),11), ((0,8),98), ((0,8),34), - ((0,9),164), ((0,8),2), ((0,8),130), ((0,8),66), ((0,9),228), - ((80,7),7), ((0,8),90), ((0,8),26), ((0,9),148), ((84,7),67), - ((0,8),122), ((0,8),58), ((0,9),212), ((82,7),19), ((0,8),106), - ((0,8),42), ((0,9),180), ((0,8),10), ((0,8),138), ((0,8),74), - ((0,9),244), ((80,7),5), ((0,8),86), ((0,8),22), ((192,8),0), - ((83,7),51), ((0,8),118), ((0,8),54), ((0,9),204), ((81,7),15), - ((0,8),102), ((0,8),38), ((0,9),172), ((0,8),6), ((0,8),134), - ((0,8),70), ((0,9),236), ((80,7),9), ((0,8),94), ((0,8),30), - ((0,9),156), ((84,7),99), ((0,8),126), ((0,8),62), ((0,9),220), - ((82,7),27), ((0,8),110), ((0,8),46), ((0,9),188), ((0,8),14), - ((0,8),142), ((0,8),78), ((0,9),252), ((96,7),256), ((0,8),81), - ((0,8),17), ((85,8),131), ((82,7),31), ((0,8),113), ((0,8),49), - ((0,9),194), ((80,7),10), ((0,8),97), ((0,8),33), ((0,9),162), - ((0,8),1), ((0,8),129), ((0,8),65), ((0,9),226), ((80,7),6), - ((0,8),89), ((0,8),25), ((0,9),146), ((83,7),59), ((0,8),121), - ((0,8),57), ((0,9),210), ((81,7),17), ((0,8),105), ((0,8),41), - ((0,9),178), ((0,8),9), ((0,8),137), ((0,8),73), ((0,9),242), - ((80,7),4), ((0,8),85), ((0,8),21), ((80,8),258), ((83,7),43), - ((0,8),117), ((0,8),53), ((0,9),202), ((81,7),13), ((0,8),101), - ((0,8),37), ((0,9),170), ((0,8),5), ((0,8),133), ((0,8),69), - ((0,9),234), ((80,7),8), ((0,8),93), ((0,8),29), ((0,9),154), - ((84,7),83), ((0,8),125), ((0,8),61), ((0,9),218), ((82,7),23), - ((0,8),109), ((0,8),45), ((0,9),186), ((0,8),13), ((0,8),141), - ((0,8),77), ((0,9),250), ((80,7),3), ((0,8),83), ((0,8),19), - ((85,8),195), ((83,7),35), ((0,8),115), ((0,8),51), ((0,9),198), - ((81,7),11), ((0,8),99), ((0,8),35), ((0,9),166), ((0,8),3), - ((0,8),131), ((0,8),67), ((0,9),230), ((80,7),7), ((0,8),91), - ((0,8),27), ((0,9),150), ((84,7),67), ((0,8),123), ((0,8),59), - ((0,9),214), ((82,7),19), ((0,8),107), ((0,8),43), ((0,9),182), - ((0,8),11), ((0,8),139), ((0,8),75), ((0,9),246), ((80,7),5), - ((0,8),87), ((0,8),23), ((192,8),0), ((83,7),51), ((0,8),119), - ((0,8),55), ((0,9),206), ((81,7),15), ((0,8),103), ((0,8),39), - ((0,9),174), ((0,8),7), ((0,8),135), ((0,8),71), ((0,9),238), - ((80,7),9), ((0,8),95), ((0,8),31), ((0,9),158), ((84,7),99), - ((0,8),127), ((0,8),63), ((0,9),222), ((82,7),27), ((0,8),111), - ((0,8),47), ((0,9),190), ((0,8),15), ((0,8),143), ((0,8),79), - ((0,9),254), ((96,7),256), ((0,8),80), ((0,8),16), ((84,8),115), - ((82,7),31), ((0,8),112), ((0,8),48), ((0,9),193), ((80,7),10), - ((0,8),96), ((0,8),32), ((0,9),161), ((0,8),0), ((0,8),128), - ((0,8),64), ((0,9),225), ((80,7),6), ((0,8),88), ((0,8),24), - ((0,9),145), ((83,7),59), ((0,8),120), ((0,8),56), ((0,9),209), - ((81,7),17), ((0,8),104), ((0,8),40), ((0,9),177), ((0,8),8), - ((0,8),136), ((0,8),72), ((0,9),241), ((80,7),4), ((0,8),84), - ((0,8),20), ((85,8),227), ((83,7),43), ((0,8),116), ((0,8),52), - ((0,9),201), ((81,7),13), ((0,8),100), ((0,8),36), ((0,9),169), - ((0,8),4), ((0,8),132), ((0,8),68), ((0,9),233), ((80,7),8), - ((0,8),92), ((0,8),28), ((0,9),153), ((84,7),83), ((0,8),124), - ((0,8),60), ((0,9),217), ((82,7),23), ((0,8),108), ((0,8),44), - ((0,9),185), ((0,8),12), ((0,8),140), ((0,8),76), ((0,9),249), - ((80,7),3), ((0,8),82), ((0,8),18), ((85,8),163), ((83,7),35), - ((0,8),114), ((0,8),50), ((0,9),197), ((81,7),11), ((0,8),98), - ((0,8),34), ((0,9),165), ((0,8),2), ((0,8),130), ((0,8),66), - ((0,9),229), ((80,7),7), ((0,8),90), ((0,8),26), ((0,9),149), - ((84,7),67), ((0,8),122), ((0,8),58), ((0,9),213), ((82,7),19), - ((0,8),106), ((0,8),42), ((0,9),181), ((0,8),10), ((0,8),138), - ((0,8),74), ((0,9),245), ((80,7),5), ((0,8),86), ((0,8),22), - ((192,8),0), ((83,7),51), ((0,8),118), ((0,8),54), ((0,9),205), - ((81,7),15), ((0,8),102), ((0,8),38), ((0,9),173), ((0,8),6), - ((0,8),134), ((0,8),70), ((0,9),237), ((80,7),9), ((0,8),94), - ((0,8),30), ((0,9),157), ((84,7),99), ((0,8),126), ((0,8),62), - ((0,9),221), ((82,7),27), ((0,8),110), ((0,8),46), ((0,9),189), - ((0,8),14), ((0,8),142), ((0,8),78), ((0,9),253), ((96,7),256), - ((0,8),81), ((0,8),17), ((85,8),131), ((82,7),31), ((0,8),113), - ((0,8),49), ((0,9),195), ((80,7),10), ((0,8),97), ((0,8),33), - ((0,9),163), ((0,8),1), ((0,8),129), ((0,8),65), ((0,9),227), - ((80,7),6), ((0,8),89), ((0,8),25), ((0,9),147), ((83,7),59), - ((0,8),121), ((0,8),57), ((0,9),211), ((81,7),17), ((0,8),105), - ((0,8),41), ((0,9),179), ((0,8),9), ((0,8),137), ((0,8),73), - ((0,9),243), ((80,7),4), ((0,8),85), ((0,8),21), ((80,8),258), - ((83,7),43), ((0,8),117), ((0,8),53), ((0,9),203), ((81,7),13), - ((0,8),101), ((0,8),37), ((0,9),171), ((0,8),5), ((0,8),133), - ((0,8),69), ((0,9),235), ((80,7),8), ((0,8),93), ((0,8),29), - ((0,9),155), ((84,7),83), ((0,8),125), ((0,8),61), ((0,9),219), - ((82,7),23), ((0,8),109), ((0,8),45), ((0,9),187), ((0,8),13), - ((0,8),141), ((0,8),77), ((0,9),251), ((80,7),3), ((0,8),83), - ((0,8),19), ((85,8),195), ((83,7),35), ((0,8),115), ((0,8),51), - ((0,9),199), ((81,7),11), ((0,8),99), ((0,8),35), ((0,9),167), - ((0,8),3), ((0,8),131), ((0,8),67), ((0,9),231), ((80,7),7), - ((0,8),91), ((0,8),27), ((0,9),151), ((84,7),67), ((0,8),123), - ((0,8),59), ((0,9),215), ((82,7),19), ((0,8),107), ((0,8),43), - ((0,9),183), ((0,8),11), ((0,8),139), ((0,8),75), ((0,9),247), - ((80,7),5), ((0,8),87), ((0,8),23), ((192,8),0), ((83,7),51), - ((0,8),119), ((0,8),55), ((0,9),207), ((81,7),15), ((0,8),103), - ((0,8),39), ((0,9),175), ((0,8),7), ((0,8),135), ((0,8),71), - ((0,9),239), ((80,7),9), ((0,8),95), ((0,8),31), ((0,9),159), - ((84,7),99), ((0,8),127), ((0,8),63), ((0,9),223), ((82,7),27), - ((0,8),111), ((0,8),47), ((0,9),191), ((0,8),15), ((0,8),143), - ((0,8),79), ((0,9),255) - ); - -{local} -const - fixed_td : array[0..32-1] of inflate_huft = ( -(Exop:80;bits:5;base:1), (Exop:87;bits:5;base:257), (Exop:83;bits:5;base:17), -(Exop:91;bits:5;base:4097), (Exop:81;bits:5;base), (Exop:89;bits:5;base:1025), -(Exop:85;bits:5;base:65), (Exop:93;bits:5;base:16385), (Exop:80;bits:5;base:3), -(Exop:88;bits:5;base:513), (Exop:84;bits:5;base:33), (Exop:92;bits:5;base:8193), -(Exop:82;bits:5;base:9), (Exop:90;bits:5;base:2049), (Exop:86;bits:5;base:129), -(Exop:192;bits:5;base:24577), (Exop:80;bits:5;base:2), (Exop:87;bits:5;base:385), -(Exop:83;bits:5;base:25), (Exop:91;bits:5;base:6145), (Exop:81;bits:5;base:7), -(Exop:89;bits:5;base:1537), (Exop:85;bits:5;base:97), (Exop:93;bits:5;base:24577), -(Exop:80;bits:5;base:4), (Exop:88;bits:5;base:769), (Exop:84;bits:5;base:49), -(Exop:92;bits:5;base:12289), (Exop:82;bits:5;base:13), (Exop:90;bits:5;base:3073), -(Exop:86;bits:5;base:193), (Exop:192;bits:5;base:24577) - ); -{$ENDIF} - -function inflate_trees_fixed( -var bl : uInt; { literal desired/actual bit depth } -var bd : uInt; { distance desired/actual bit depth } -var tl : pInflate_huft; { literal/length tree result } -var td : pInflate_huft; { distance tree result } -var z : z_stream { for memory allocation } - ) : int; -type - pFixed_table = ^fixed_table; - fixed_table = array[0..288-1] of uIntf; -var - k : int; { temporary variable } - c : pFixed_table; { length list for huft_build } - v : PuIntArray; { work area for huft_build } -var - f : uInt; { number of hufts used in fixed_mem } -begin - { build fixed tables if not already (multiple overlapped executions ok) } - if not fixed_built then - begin - f := 0; - - { allocate memory } - c := pFixed_table( ZALLOC(z, 288, sizeof(uInt)) ); - if (c = Z_NULL) then - begin - inflate_trees_fixed := Z_MEM_ERROR; - exit; - end; - v := PuIntArray( ZALLOC(z, 288, sizeof(uInt)) ); - if (v = Z_NULL) then - begin - ZFREE(z, c); - inflate_trees_fixed := Z_MEM_ERROR; - exit; - end; - - { literal table } - for k := 0 to Pred(144) do - c^[k] := 8; - for k := 144 to Pred(256) do - c^[k] := 9; - for k := 256 to Pred(280) do - c^[k] := 7; - for k := 280 to Pred(288) do - c^[k] := 8; - fixed_bl := 9; - huft_build(c^, 288, 257, cplens, cplext, @fixed_tl, fixed_bl, - fixed_mem, f, v^); - - { distance table } - for k := 0 to Pred(30) do - c^[k] := 5; - fixed_bd := 5; - huft_build(c^, 30, 0, cpdist, cpdext, @fixed_td, fixed_bd, - fixed_mem, f, v^); - - { done } - ZFREE(z, v); - ZFREE(z, c); - fixed_built := True; - end; - bl := fixed_bl; - bd := fixed_bd; - tl := fixed_tl; - td := fixed_td; - inflate_trees_fixed := Z_OK; -end; { inflate_trees_fixed } - - +Unit iminftrees; + +{ inftrees.h -- header to use inftrees.c + inftrees.c -- generate Huffman trees for efficient decoding + 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; + + +{ Maximum size of dynamic tree. The maximum found in a long but non- + exhaustive search was 1004 huft structures (850 for length/literals + and 154 for distances, the latter actually the result of an + exhaustive search). The actual maximum is not known, but the + value below is more than safe. } +const + MANY = 1440; + + +{$ifdef DEBUG} +var + inflate_hufts : uInt; +{$endif} + +function inflate_trees_bits( + var c : array of uIntf; { 19 code lengths } + var bb : uIntf; { bits tree desired/actual depth } + var tb : pinflate_huft; { bits tree result } + var hp : array of Inflate_huft; { space for trees } + var z : z_stream { for messages } + ) : int; + +function inflate_trees_dynamic( + nl : uInt; { number of literal/length codes } + nd : uInt; { number of distance codes } + var c : Array of uIntf; { that many (total) code lengths } + var bl : uIntf; { literal desired/actual bit depth } + var bd : uIntf; { distance desired/actual bit depth } +var tl : pInflate_huft; { literal/length tree result } +var td : pInflate_huft; { distance tree result } +var hp : array of Inflate_huft; { space for trees } +var z : z_stream { for messages } + ) : int; + +function inflate_trees_fixed ( + var bl : uInt; { literal desired/actual bit depth } + var bd : uInt; { distance desired/actual bit depth } + var tl : pInflate_huft; { literal/length tree result } + var td : pInflate_huft; { distance tree result } + var z : z_stream { for memory allocation } + ) : int; + + +implementation + +const + inflate_copyright = 'inflate 1.1.2 Copyright 1995-1998 Mark Adler'; + +{ + If you use the zlib library in a product, an acknowledgment is welcome + in the documentation of your product. If for some reason you cannot + include such an acknowledgment, I would appreciate that you keep this + copyright string in the executable of your product. +} + + +const +{ Tables for deflate from PKZIP's appnote.txt. } + cplens : Array [0..30] Of uInt { Copy lengths for literal codes 257..285 } + = (3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31, + 35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258, 0, 0); + { actually lengths - 2; also see note #13 above about 258 } + + invalid_code = 112; + + cplext : Array [0..30] Of uInt { Extra bits for literal codes 257..285 } + = (0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, + 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 0, invalid_code, invalid_code); + + cpdist : Array [0..29] Of uInt { Copy offsets for distance codes 0..29 } + = (1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, + 257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145, + 8193, 12289, 16385, 24577); + + cpdext : Array [0..29] Of uInt { Extra bits for distance codes } + = (0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, + 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, + 12, 12, 13, 13); + +{ Huffman code decoding is performed using a multi-level table lookup. + The fastest way to decode is to simply build a lookup table whose + size is determined by the longest code. However, the time it takes + to build this table can also be a factor if the data being decoded + is not very long. The most common codes are necessarily the + shortest codes, so those codes dominate the decoding time, and hence + the speed. The idea is you can have a shorter table that decodes the + shorter, more probable codes, and then point to subsidiary tables for + the longer codes. The time it costs to decode the longer codes is + then traded against the time it takes to make longer tables. + + This results of this trade are in the variables lbits and dbits + below. lbits is the number of bits the first level table for literal/ + length codes can decode in one step, and dbits is the same thing for + the distance codes. Subsequent tables are also less than or equal to + those sizes. These values may be adjusted either when all of the + codes are shorter than that, in which case the longest code length in + bits is used, or when the shortest code is *longer* than the requested + table size, in which case the length of the shortest code in bits is + used. + + There are two different values for the two tables, since they code a + different number of possibilities each. The literal/length table + codes 286 possible values, or in a flat code, a little over eight + bits. The distance table codes 30 possible values, or a little less + than five bits, flat. The optimum values for speed end up being + about one bit more than those, so lbits is 8+1 and dbits is 5+1. + The optimum values may differ though from machine to machine, and + possibly even between compilers. Your mileage may vary. } + + +{ If BMAX needs to be larger than 16, then h and x[] should be uLong. } +const + BMAX = 15; { maximum bit length of any code } + +{$DEFINE USE_PTR} + +function huft_build( +var b : array of uIntf; { code lengths in bits (all assumed <= BMAX) } + n : uInt; { number of codes (assumed <= N_MAX) } + s : uInt; { number of simple-valued codes (0..s-1) } +const d : array of uIntf; { list of base values for non-simple codes } +{ array of word } +const e : array of uIntf; { list of extra bits for non-simple codes } +{ array of byte } + t : ppInflate_huft; { result: starting table } +var m : uIntf; { maximum lookup bits, returns actual } +var hp : array of inflate_huft; { space for trees } +var hn : uInt; { hufts used in space } +var v : array of uIntf { working area: values in order of bit length } + ) : int; +{ Given a list of code lengths and a maximum table size, make a set of + tables to decode that set of codes. Return Z_OK on success, Z_BUF_ERROR + if the given code set is incomplete (the tables are still built in this + case), Z_DATA_ERROR if the input is invalid (an over-subscribed set of + lengths), or Z_MEM_ERROR if not enough memory. } +Var + a : uInt; { counter for codes of length k } + c : Array [0..BMAX] Of uInt; { bit length count table } + f : uInt; { i repeats in table every f entries } + g : int; { maximum code length } + h : int; { table level } + i : uInt; {register} { counter, current code } + j : uInt; {register} { counter } + k : Int; {register} { number of bits in current code } + l : int; { bits per table (returned in m) } + mask : uInt; { (1 shl w) - 1, to avoid cc -O bug on HP } + p : ^uIntf; {register} { pointer into c[], b[], or v[] } + q : pInflate_huft; { points to current table } + r : inflate_huft; { table entry for structure assignment } + u : Array [0..BMAX-1] Of pInflate_huft; { table stack } + w : int; {register} { bits before this table = (l*h) } + x : Array [0..BMAX] Of uInt; { bit offsets, then code stack } + {$IFDEF USE_PTR} + xp : puIntf; { pointer into x } + {$ELSE} + xp : uInt; + {$ENDIF} + y : int; { number of dummy codes added } + z : uInt; { number of entries in current table } +Begin + { Generate counts for each bit length } + FillChar(c,SizeOf(c),0) ; { clear c[] } + + for i := 0 to n-1 do + Inc (c[b[i]]); { assume all entries <= BMAX } + + If (c[0] = n) Then { null input--all zero length codes } + Begin + t^ := pInflate_huft(NIL); + m := 0 ; + huft_build := Z_OK ; + Exit; + End ; + + { Find minimum and maximum length, bound [m] by those } + l := m; + for j:=1 To BMAX do + if (c[j] <> 0) then + break; + k := j ; { minimum code length } + if (uInt(l) < j) then + l := j; + for i := BMAX downto 1 do + if (c[i] <> 0) then + break ; + g := i ; { maximum code length } + if (uInt(l) > i) then + l := i; + m := l; + + { Adjust last length count to fill out codes, if needed } + y := 1 shl j ; + while (j < i) do + begin + Dec(y, c[j]) ; + if (y < 0) then + begin + huft_build := Z_DATA_ERROR; { bad input: more codes than bits } + exit; + end ; + Inc(j) ; + y := y shl 1 + end; + Dec (y, c[i]) ; + if (y < 0) then + begin + huft_build := Z_DATA_ERROR; { bad input: more codes than bits } + exit; + end; + Inc(c[i], y); + + { Generate starting offsets into the value table FOR each length } + {$IFDEF USE_PTR} + x[1] := 0; + j := 0; + + p := @c[1]; + xp := @x[2]; + + dec(i); { note that i = g from above } + WHILE (i > 0) DO + BEGIN + inc(j, p^); + xp^ := j; + inc(p); + inc(xp); + dec(i); + END; + {$ELSE} + x[1] := 0; + j := 0 ; + for i := 1 to g do + begin + x[i] := j; + Inc(j, c[i]); + end; + {$ENDIF} + + { Make a table of values in order of bit lengths } + for i := 0 to n-1 do + begin + j := b[i]; + if (j <> 0) then + begin + v[ x[j] ] := i; + Inc(x[j]); + end; + end; + n := x[g]; { set n to length of v } + + { Generate the Huffman codes and for each, make the table entries } + i := 0 ; + x[0] := 0 ; { first Huffman code is zero } + p := Addr(v) ; { grab values in bit order } + h := -1 ; { no tables yet--level -1 } + w := -l ; { bits decoded = (l*h) } + + u[0] := pInflate_huft(NIL); { just to keep compilers happy } + q := pInflate_huft(NIL); { ditto } + z := 0 ; { ditto } + + { go through the bit lengths (k already is bits in shortest code) } + while (k <= g) Do + begin + a := c[k] ; + while (a<>0) Do + begin + Dec (a) ; + { here i is the Huffman code of length k bits for value p^ } + { make tables up to required level } + while (k > w + l) do + begin + + Inc (h) ; + Inc (w, l); { add bits already decoded } + { previous table always l bits } + { compute minimum size table less than or equal to l bits } + + { table size upper limit } + z := g - w; + If (z > uInt(l)) Then + z := l; + + { try a k-w bit table } + j := k - w; + f := 1 shl j; + if (f > a+1) Then { too few codes for k-w bit table } + begin + Dec(f, a+1); { deduct codes from patterns left } + {$IFDEF USE_PTR} + xp := Addr(c[k]); + + if (j < z) then + begin + Inc(j); + while (j < z) do + begin { try smaller tables up to z bits } + f := f shl 1; + Inc (xp) ; + If (f <= xp^) Then + break; { enough codes to use up j bits } + Dec(f, xp^); { else deduct codes from patterns } + Inc(j); + end; + end; + {$ELSE} + xp := k; + + if (j < z) then + begin + Inc (j) ; + While (j < z) Do + begin { try smaller tables up to z bits } + f := f * 2; + Inc (xp) ; + if (f <= c[xp]) then + Break ; { enough codes to use up j bits } + Dec (f, c[xp]) ; { else deduct codes from patterns } + Inc (j); + end; + end; + {$ENDIF} + end; + + z := 1 shl j; { table entries for j-bit table } + + { allocate new table } + if (hn + z > MANY) then { (note: doesn't matter for fixed) } + begin + huft_build := Z_MEM_ERROR; { not enough memory } + exit; + end; + + q := @hp[hn]; + u[h] := q; + Inc(hn, z); + + { connect to last table, if there is one } + if (h <> 0) then + begin + x[h] := i; { save pattern for backing up } + r.bits := Byte(l); { bits to dump before this table } + r.exop := Byte(j); { bits in this table } + j := i shr (w - l); + {r.base := uInt( q - u[h-1] -j);} { offset to this table } + r.base := (ptr2int(q) - ptr2int(u[h-1]) ) div sizeof(q^) - j; + huft_Ptr(u[h-1])^[j] := r; { connect to last table } + end + else + t^ := q; { first table is returned result } + end; + + { set up table entry in r } + r.bits := Byte(k - w); + + { C-code: if (p >= v + n) - see ZUTIL.PAS for comments } + + if ptr2int(p)>=ptr2int(@(v[n])) then { also works under DPMI ?? } + r.exop := 128 + 64 { out of values--invalid code } + else + if (p^ < s) then + begin + if (p^ < 256) then { 256 is end-of-block code } + r.exop := 0 + Else + r.exop := 32 + 64; { EOB_code; } + r.base := p^; { simple code is just the value } + Inc(p); + end + Else + begin + r.exop := Byte(e[p^-s] + 16 + 64); { non-simple--look up in lists } + r.base := d[p^-s]; + Inc (p); + end ; + + { fill code-like entries with r } + f := 1 shl (k - w); + j := i shr w; + while (j < z) do + begin + huft_Ptr(q)^[j] := r; + Inc(j, f); + end; + + { backwards increment the k-bit code i } + j := 1 shl (k-1) ; + while (i and j) <> 0 do + begin + i := i xor j; { bitwise exclusive or } + j := j shr 1 + end ; + i := i xor j; + + { backup over finished tables } + mask := (1 shl w) - 1; { needed on HP, cc -O bug } + while ((i and mask) <> x[h]) do + begin + Dec(h); { don't need to update q } + Dec(w, l); + mask := (1 shl w) - 1; + end; + + end; + + Inc(k); + end; + + { Return Z_BUF_ERROR if we were given an incomplete table } + if (y <> 0) And (g <> 1) then + huft_build := Z_BUF_ERROR + else + huft_build := Z_OK; +end; { huft_build} + + +function inflate_trees_bits( + var c : array of uIntf; { 19 code lengths } + var bb : uIntf; { bits tree desired/actual depth } + var tb : pinflate_huft; { bits tree result } + var hp : array of Inflate_huft; { space for trees } + var z : z_stream { for messages } + ) : int; +var + r : int; + hn : uInt; { hufts used in space } + v : PuIntArray; { work area for huft_build } +begin + hn := 0; + v := PuIntArray( ZALLOC(z, 19, sizeof(uInt)) ); + if (v = Z_NULL) then + begin + inflate_trees_bits := Z_MEM_ERROR; + exit; + end; + + r := huft_build(c, 19, 19, cplens, cplext, + {puIntf(Z_NULL), puIntf(Z_NULL),} + @tb, bb, hp, hn, v^); + if (r = Z_DATA_ERROR) then + z.msg := 'oversubscribed dynamic bit lengths tree' + else + if (r = Z_BUF_ERROR) or (bb = 0) then + begin + z.msg := 'incomplete dynamic bit lengths tree'; + r := Z_DATA_ERROR; + end; + ZFREE(z, v); + inflate_trees_bits := r; +end; + + +function inflate_trees_dynamic( + nl : uInt; { number of literal/length codes } + nd : uInt; { number of distance codes } + var c : Array of uIntf; { that many (total) code lengths } + var bl : uIntf; { literal desired/actual bit depth } + var bd : uIntf; { distance desired/actual bit depth } +var tl : pInflate_huft; { literal/length tree result } +var td : pInflate_huft; { distance tree result } +var hp : array of Inflate_huft; { space for trees } +var z : z_stream { for messages } + ) : int; +var + r : int; + hn : uInt; { hufts used in space } + v : PuIntArray; { work area for huft_build } +begin + hn := 0; + { allocate work area } + v := PuIntArray( ZALLOC(z, 288, sizeof(uInt)) ); + if (v = Z_NULL) then + begin + inflate_trees_dynamic := Z_MEM_ERROR; + exit; + end; + + { build literal/length tree } + r := huft_build(c, nl, 257, cplens, cplext, @tl, bl, hp, hn, v^); + if (r <> Z_OK) or (bl = 0) then + begin + if (r = Z_DATA_ERROR) then + z.msg := 'oversubscribed literal/length tree' + else + if (r <> Z_MEM_ERROR) then + begin + z.msg := 'incomplete literal/length tree'; + r := Z_DATA_ERROR; + end; + + ZFREE(z, v); + inflate_trees_dynamic := r; + exit; + end; + + { build distance tree } + r := huft_build(puIntArray(@c[nl])^, nd, 0, + cpdist, cpdext, @td, bd, hp, hn, v^); + if (r <> Z_OK) or ((bd = 0) and (nl > 257)) then + begin + if (r = Z_DATA_ERROR) then + z.msg := 'oversubscribed literal/length tree' + else + if (r = Z_BUF_ERROR) then + begin +{$ifdef PKZIP_BUG_WORKAROUND} + r := Z_OK; + end; +{$else} + z.msg := 'incomplete literal/length tree'; + r := Z_DATA_ERROR; + end + else + if (r <> Z_MEM_ERROR) then + begin + z.msg := 'empty distance tree with lengths'; + r := Z_DATA_ERROR; + end; + ZFREE(z, v); + inflate_trees_dynamic := r; + exit; +{$endif} + end; + + { done } + ZFREE(z, v); + inflate_trees_dynamic := Z_OK; +end; + +{$UNDEF BUILDFIXED} + +{ build fixed tables only once--keep them here } +{$IFNDEF BUILDFIXED} +{ locals } +var + fixed_built : Boolean = false; +const + FIXEDH = 544; { number of hufts used by fixed tables } +var + fixed_mem : array[0..FIXEDH-1] of inflate_huft; + fixed_bl : uInt; + fixed_bd : uInt; + fixed_tl : pInflate_huft; + fixed_td : pInflate_huft; + +{$ELSE} + +{ inffixed.h -- table for decoding fixed codes } + +{local} +const + fixed_bl = uInt(9); +{local} +const + fixed_bd = uInt(5); +{local} +const + fixed_tl : array [0..288-1] of inflate_huft = ( + Exop, { number of extra bits or operation } + bits : Byte; { number of bits in this code or subcode } + {pad : uInt;} { pad structure to a power of 2 (4 bytes for } + { 16-bit, 8 bytes for 32-bit int's) } + base : uInt; { literal, length base, or distance base } + { or table offset } + + ((96,7),256), ((0,8),80), ((0,8),16), ((84,8),115), ((82,7),31), + ((0,8),112), ((0,8),48), ((0,9),192), ((80,7),10), ((0,8),96), + ((0,8),32), ((0,9),160), ((0,8),0), ((0,8),128), ((0,8),64), + ((0,9),224), ((80,7),6), ((0,8),88), ((0,8),24), ((0,9),144), + ((83,7),59), ((0,8),120), ((0,8),56), ((0,9),208), ((81,7),17), + ((0,8),104), ((0,8),40), ((0,9),176), ((0,8),8), ((0,8),136), + ((0,8),72), ((0,9),240), ((80,7),4), ((0,8),84), ((0,8),20), + ((85,8),227), ((83,7),43), ((0,8),116), ((0,8),52), ((0,9),200), + ((81,7),13), ((0,8),100), ((0,8),36), ((0,9),168), ((0,8),4), + ((0,8),132), ((0,8),68), ((0,9),232), ((80,7),8), ((0,8),92), + ((0,8),28), ((0,9),152), ((84,7),83), ((0,8),124), ((0,8),60), + ((0,9),216), ((82,7),23), ((0,8),108), ((0,8),44), ((0,9),184), + ((0,8),12), ((0,8),140), ((0,8),76), ((0,9),248), ((80,7),3), + ((0,8),82), ((0,8),18), ((85,8),163), ((83,7),35), ((0,8),114), + ((0,8),50), ((0,9),196), ((81,7),11), ((0,8),98), ((0,8),34), + ((0,9),164), ((0,8),2), ((0,8),130), ((0,8),66), ((0,9),228), + ((80,7),7), ((0,8),90), ((0,8),26), ((0,9),148), ((84,7),67), + ((0,8),122), ((0,8),58), ((0,9),212), ((82,7),19), ((0,8),106), + ((0,8),42), ((0,9),180), ((0,8),10), ((0,8),138), ((0,8),74), + ((0,9),244), ((80,7),5), ((0,8),86), ((0,8),22), ((192,8),0), + ((83,7),51), ((0,8),118), ((0,8),54), ((0,9),204), ((81,7),15), + ((0,8),102), ((0,8),38), ((0,9),172), ((0,8),6), ((0,8),134), + ((0,8),70), ((0,9),236), ((80,7),9), ((0,8),94), ((0,8),30), + ((0,9),156), ((84,7),99), ((0,8),126), ((0,8),62), ((0,9),220), + ((82,7),27), ((0,8),110), ((0,8),46), ((0,9),188), ((0,8),14), + ((0,8),142), ((0,8),78), ((0,9),252), ((96,7),256), ((0,8),81), + ((0,8),17), ((85,8),131), ((82,7),31), ((0,8),113), ((0,8),49), + ((0,9),194), ((80,7),10), ((0,8),97), ((0,8),33), ((0,9),162), + ((0,8),1), ((0,8),129), ((0,8),65), ((0,9),226), ((80,7),6), + ((0,8),89), ((0,8),25), ((0,9),146), ((83,7),59), ((0,8),121), + ((0,8),57), ((0,9),210), ((81,7),17), ((0,8),105), ((0,8),41), + ((0,9),178), ((0,8),9), ((0,8),137), ((0,8),73), ((0,9),242), + ((80,7),4), ((0,8),85), ((0,8),21), ((80,8),258), ((83,7),43), + ((0,8),117), ((0,8),53), ((0,9),202), ((81,7),13), ((0,8),101), + ((0,8),37), ((0,9),170), ((0,8),5), ((0,8),133), ((0,8),69), + ((0,9),234), ((80,7),8), ((0,8),93), ((0,8),29), ((0,9),154), + ((84,7),83), ((0,8),125), ((0,8),61), ((0,9),218), ((82,7),23), + ((0,8),109), ((0,8),45), ((0,9),186), ((0,8),13), ((0,8),141), + ((0,8),77), ((0,9),250), ((80,7),3), ((0,8),83), ((0,8),19), + ((85,8),195), ((83,7),35), ((0,8),115), ((0,8),51), ((0,9),198), + ((81,7),11), ((0,8),99), ((0,8),35), ((0,9),166), ((0,8),3), + ((0,8),131), ((0,8),67), ((0,9),230), ((80,7),7), ((0,8),91), + ((0,8),27), ((0,9),150), ((84,7),67), ((0,8),123), ((0,8),59), + ((0,9),214), ((82,7),19), ((0,8),107), ((0,8),43), ((0,9),182), + ((0,8),11), ((0,8),139), ((0,8),75), ((0,9),246), ((80,7),5), + ((0,8),87), ((0,8),23), ((192,8),0), ((83,7),51), ((0,8),119), + ((0,8),55), ((0,9),206), ((81,7),15), ((0,8),103), ((0,8),39), + ((0,9),174), ((0,8),7), ((0,8),135), ((0,8),71), ((0,9),238), + ((80,7),9), ((0,8),95), ((0,8),31), ((0,9),158), ((84,7),99), + ((0,8),127), ((0,8),63), ((0,9),222), ((82,7),27), ((0,8),111), + ((0,8),47), ((0,9),190), ((0,8),15), ((0,8),143), ((0,8),79), + ((0,9),254), ((96,7),256), ((0,8),80), ((0,8),16), ((84,8),115), + ((82,7),31), ((0,8),112), ((0,8),48), ((0,9),193), ((80,7),10), + ((0,8),96), ((0,8),32), ((0,9),161), ((0,8),0), ((0,8),128), + ((0,8),64), ((0,9),225), ((80,7),6), ((0,8),88), ((0,8),24), + ((0,9),145), ((83,7),59), ((0,8),120), ((0,8),56), ((0,9),209), + ((81,7),17), ((0,8),104), ((0,8),40), ((0,9),177), ((0,8),8), + ((0,8),136), ((0,8),72), ((0,9),241), ((80,7),4), ((0,8),84), + ((0,8),20), ((85,8),227), ((83,7),43), ((0,8),116), ((0,8),52), + ((0,9),201), ((81,7),13), ((0,8),100), ((0,8),36), ((0,9),169), + ((0,8),4), ((0,8),132), ((0,8),68), ((0,9),233), ((80,7),8), + ((0,8),92), ((0,8),28), ((0,9),153), ((84,7),83), ((0,8),124), + ((0,8),60), ((0,9),217), ((82,7),23), ((0,8),108), ((0,8),44), + ((0,9),185), ((0,8),12), ((0,8),140), ((0,8),76), ((0,9),249), + ((80,7),3), ((0,8),82), ((0,8),18), ((85,8),163), ((83,7),35), + ((0,8),114), ((0,8),50), ((0,9),197), ((81,7),11), ((0,8),98), + ((0,8),34), ((0,9),165), ((0,8),2), ((0,8),130), ((0,8),66), + ((0,9),229), ((80,7),7), ((0,8),90), ((0,8),26), ((0,9),149), + ((84,7),67), ((0,8),122), ((0,8),58), ((0,9),213), ((82,7),19), + ((0,8),106), ((0,8),42), ((0,9),181), ((0,8),10), ((0,8),138), + ((0,8),74), ((0,9),245), ((80,7),5), ((0,8),86), ((0,8),22), + ((192,8),0), ((83,7),51), ((0,8),118), ((0,8),54), ((0,9),205), + ((81,7),15), ((0,8),102), ((0,8),38), ((0,9),173), ((0,8),6), + ((0,8),134), ((0,8),70), ((0,9),237), ((80,7),9), ((0,8),94), + ((0,8),30), ((0,9),157), ((84,7),99), ((0,8),126), ((0,8),62), + ((0,9),221), ((82,7),27), ((0,8),110), ((0,8),46), ((0,9),189), + ((0,8),14), ((0,8),142), ((0,8),78), ((0,9),253), ((96,7),256), + ((0,8),81), ((0,8),17), ((85,8),131), ((82,7),31), ((0,8),113), + ((0,8),49), ((0,9),195), ((80,7),10), ((0,8),97), ((0,8),33), + ((0,9),163), ((0,8),1), ((0,8),129), ((0,8),65), ((0,9),227), + ((80,7),6), ((0,8),89), ((0,8),25), ((0,9),147), ((83,7),59), + ((0,8),121), ((0,8),57), ((0,9),211), ((81,7),17), ((0,8),105), + ((0,8),41), ((0,9),179), ((0,8),9), ((0,8),137), ((0,8),73), + ((0,9),243), ((80,7),4), ((0,8),85), ((0,8),21), ((80,8),258), + ((83,7),43), ((0,8),117), ((0,8),53), ((0,9),203), ((81,7),13), + ((0,8),101), ((0,8),37), ((0,9),171), ((0,8),5), ((0,8),133), + ((0,8),69), ((0,9),235), ((80,7),8), ((0,8),93), ((0,8),29), + ((0,9),155), ((84,7),83), ((0,8),125), ((0,8),61), ((0,9),219), + ((82,7),23), ((0,8),109), ((0,8),45), ((0,9),187), ((0,8),13), + ((0,8),141), ((0,8),77), ((0,9),251), ((80,7),3), ((0,8),83), + ((0,8),19), ((85,8),195), ((83,7),35), ((0,8),115), ((0,8),51), + ((0,9),199), ((81,7),11), ((0,8),99), ((0,8),35), ((0,9),167), + ((0,8),3), ((0,8),131), ((0,8),67), ((0,9),231), ((80,7),7), + ((0,8),91), ((0,8),27), ((0,9),151), ((84,7),67), ((0,8),123), + ((0,8),59), ((0,9),215), ((82,7),19), ((0,8),107), ((0,8),43), + ((0,9),183), ((0,8),11), ((0,8),139), ((0,8),75), ((0,9),247), + ((80,7),5), ((0,8),87), ((0,8),23), ((192,8),0), ((83,7),51), + ((0,8),119), ((0,8),55), ((0,9),207), ((81,7),15), ((0,8),103), + ((0,8),39), ((0,9),175), ((0,8),7), ((0,8),135), ((0,8),71), + ((0,9),239), ((80,7),9), ((0,8),95), ((0,8),31), ((0,9),159), + ((84,7),99), ((0,8),127), ((0,8),63), ((0,9),223), ((82,7),27), + ((0,8),111), ((0,8),47), ((0,9),191), ((0,8),15), ((0,8),143), + ((0,8),79), ((0,9),255) + ); + +{local} +const + fixed_td : array[0..32-1] of inflate_huft = ( +(Exop:80;bits:5;base:1), (Exop:87;bits:5;base:257), (Exop:83;bits:5;base:17), +(Exop:91;bits:5;base:4097), (Exop:81;bits:5;base), (Exop:89;bits:5;base:1025), +(Exop:85;bits:5;base:65), (Exop:93;bits:5;base:16385), (Exop:80;bits:5;base:3), +(Exop:88;bits:5;base:513), (Exop:84;bits:5;base:33), (Exop:92;bits:5;base:8193), +(Exop:82;bits:5;base:9), (Exop:90;bits:5;base:2049), (Exop:86;bits:5;base:129), +(Exop:192;bits:5;base:24577), (Exop:80;bits:5;base:2), (Exop:87;bits:5;base:385), +(Exop:83;bits:5;base:25), (Exop:91;bits:5;base:6145), (Exop:81;bits:5;base:7), +(Exop:89;bits:5;base:1537), (Exop:85;bits:5;base:97), (Exop:93;bits:5;base:24577), +(Exop:80;bits:5;base:4), (Exop:88;bits:5;base:769), (Exop:84;bits:5;base:49), +(Exop:92;bits:5;base:12289), (Exop:82;bits:5;base:13), (Exop:90;bits:5;base:3073), +(Exop:86;bits:5;base:193), (Exop:192;bits:5;base:24577) + ); +{$ENDIF} + +function inflate_trees_fixed( +var bl : uInt; { literal desired/actual bit depth } +var bd : uInt; { distance desired/actual bit depth } +var tl : pInflate_huft; { literal/length tree result } +var td : pInflate_huft; { distance tree result } +var z : z_stream { for memory allocation } + ) : int; +type + pFixed_table = ^fixed_table; + fixed_table = array[0..288-1] of uIntf; +var + k : int; { temporary variable } + c : pFixed_table; { length list for huft_build } + v : PuIntArray; { work area for huft_build } +var + f : uInt; { number of hufts used in fixed_mem } +begin + { build fixed tables if not already (multiple overlapped executions ok) } + if not fixed_built then + begin + f := 0; + + { allocate memory } + c := pFixed_table( ZALLOC(z, 288, sizeof(uInt)) ); + if (c = Z_NULL) then + begin + inflate_trees_fixed := Z_MEM_ERROR; + exit; + end; + v := PuIntArray( ZALLOC(z, 288, sizeof(uInt)) ); + if (v = Z_NULL) then + begin + ZFREE(z, c); + inflate_trees_fixed := Z_MEM_ERROR; + exit; + end; + + { literal table } + for k := 0 to Pred(144) do + c^[k] := 8; + for k := 144 to Pred(256) do + c^[k] := 9; + for k := 256 to Pred(280) do + c^[k] := 7; + for k := 280 to Pred(288) do + c^[k] := 8; + fixed_bl := 9; + huft_build(c^, 288, 257, cplens, cplext, @fixed_tl, fixed_bl, + fixed_mem, f, v^); + + { distance table } + for k := 0 to Pred(30) do + c^[k] := 5; + fixed_bd := 5; + huft_build(c^, 30, 0, cpdist, cpdext, @fixed_td, fixed_bd, + fixed_mem, f, v^); + + { done } + ZFREE(z, v); + ZFREE(z, c); + fixed_built := True; + end; + bl := fixed_bl; + bd := fixed_bd; + tl := fixed_tl; + td := fixed_td; + inflate_trees_fixed := Z_OK; +end; { inflate_trees_fixed } + + end. \ No newline at end of file diff --git a/Imaging/ZLib/iminfutil.pas b/Imaging/ZLib/iminfutil.pas index d5364f0..384f0d3 100644 --- a/Imaging/ZLib/iminfutil.pas +++ b/Imaging/ZLib/iminfutil.pas @@ -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. diff --git a/Imaging/ZLib/imzconf.inc b/Imaging/ZLib/imzconf.inc index d688a4b..bd518a5 100644 --- a/Imaging/ZLib/imzconf.inc +++ b/Imaging/ZLib/imzconf.inc @@ -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} +{ -------------------------------------------------------------------- } + + diff --git a/Imaging/ZLib/imzutil.pas b/Imaging/ZLib/imzutil.pas index 41ab4ea..420b5fb 100644 --- a/Imaging/ZLib/imzutil.pas +++ b/Imaging/ZLib/imzutil.pas @@ -1,191 +1,191 @@ -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; + + 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. + diff --git a/Imaging/ZLib/readme.txt b/Imaging/ZLib/readme.txt index 887d9ca..f9d8087 100644 --- a/Imaging/ZLib/readme.txt +++ b/Imaging/ZLib/readme.txt @@ -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 March 24th, 2000 \ No newline at end of file diff --git a/Logging.pas b/Logging.pas index feb4b07..f61d21a 100644 --- a/Logging.pas +++ b/Logging.pas @@ -1,39 +1,39 @@ -unit Logging; - -{$mode objfpc}{$H+} - -interface - -uses - MultiLog{$IFNDEF NoLogging}, IPCChannel{$ENDIF}; - -const - lcAll = [0..31]; //all logging classes - lcDebug = 0; - lcError = 1; - lcInfo = 2; - lcWarning = 3; - - lcEvents = 4; - - lcServer = 10; - lcClient = 11; - lcLandscape = 12; - -var - Logger: TLogger; - -implementation - -initialization - Logger := TLogger.Create; - {$IFNDEF NoLogging} - Logger.Channels.Add(TIPCChannel.Create); - Logger.ActiveClasses := lcAll; - {$ENDIF} - -finalization - Logger.Free; - -end. - +unit Logging; + +{$mode objfpc}{$H+} + +interface + +uses + MultiLog{$IFNDEF NoLogging}, IPCChannel{$ENDIF}; + +const + lcAll = [0..31]; //all logging classes + lcDebug = 0; + lcError = 1; + lcInfo = 2; + lcWarning = 3; + + lcEvents = 4; + + lcServer = 10; + lcClient = 11; + lcLandscape = 12; + +var + Logger: TLogger; + +implementation + +initialization + Logger := TLogger.Create; + {$IFNDEF NoLogging} + Logger.Channels.Add(TIPCChannel.Create); + Logger.ActiveClasses := lcAll; + {$ENDIF} + +finalization + Logger.Free; + +end. + diff --git a/MulProvider/UAnimDataProvider.pas b/MulProvider/UAnimDataProvider.pas index 134e5dd..1d121ad 100644 --- a/MulProvider/UAnimDataProvider.pas +++ b/MulProvider/UAnimDataProvider.pas @@ -1,133 +1,133 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2009 Andreas Schneider - *) -unit UAnimDataProvider; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, UMulProvider, UMulBlock, UAnimData; - -type - - TAnimDataArray = array of TAnimData; - - { TAnimDataProvider } - - TAnimDataProvider = class(TMulProvider) - constructor Create(AData: TStream; AReadOnly: Boolean = False); overload; - override; - constructor Create(AData: string; AReadOnly: Boolean = False); overload; - override; - destructor Destroy; override; - protected - FAnimData: TAnimDataArray; - FAnimCount: Cardinal; - function CalculateOffset(AID: Integer): Integer; override; - function GetData(AID, AOffset: Integer): TAnimData; override; - procedure InitArray; - procedure SetData(AID, AOffset: Integer; ABlock: TMulBlock); override; - public - property AnimData: TAnimDataArray read FAnimData; - property AnimCount: Cardinal read FAnimCount; - function GetBlock(AID: Integer): TAnimData; override; - end; - -implementation - -uses - Logging; - -{ TAnimDataProvider } - -constructor TAnimDataProvider.Create(AData: TStream; AReadOnly: Boolean); -begin - inherited Create(AData, AReadOnly); - InitArray; -end; - -constructor TAnimDataProvider.Create(AData: string; AReadOnly: Boolean); -begin - inherited Create(AData, AReadOnly); - InitArray; -end; - -destructor TAnimDataProvider.Destroy; -var - i: Integer; -begin - for i := 0 to Length(FAnimData) - 1 do - FreeAndNil(FAnimData[i]); - - inherited Destroy; -end; - -function TAnimDataProvider.CalculateOffset(AID: Integer): Integer; -begin - Result := GetAnimDataOffset(AID); -end; - -function TAnimDataProvider.GetData(AID, AOffset: Integer): TAnimData; -begin - Result := FAnimData[AID]; -end; - -procedure TAnimDataProvider.InitArray; -var - i: Integer; -begin - FData.Position := 0; - FAnimCount := (FData.Size div AnimDataGroupSize) * 8; - Logger.Send([lcInfo], 'Loading $%x AnimData entries.', [FAnimCount]); - SetLength(FAnimData, FAnimCount); - for i := 0 to FAnimCount - 1 do - begin - if i mod 8 = 0 then - FData.Seek(4, soFromCurrent); - FAnimData[i] := TAnimData.Create(FData); - end; -end; - -procedure TAnimDataProvider.SetData(AID, AOffset: Integer; ABlock: TMulBlock); -begin - FreeAndNil(FAnimData[AID]); - FAnimData[AID] := TAnimData(ABlock.Clone); - - if not FReadOnly then - begin - FData.Position := AOffset; - ABlock.Write(FData); - end; -end; - -function TAnimDataProvider.GetBlock(AID: Integer): TAnimData; -begin - Result := FAnimData[AID].Clone; -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2009 Andreas Schneider + *) +unit UAnimDataProvider; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, UMulProvider, UMulBlock, UAnimData; + +type + + TAnimDataArray = array of TAnimData; + + { TAnimDataProvider } + + TAnimDataProvider = class(TMulProvider) + constructor Create(AData: TStream; AReadOnly: Boolean = False); overload; + override; + constructor Create(AData: string; AReadOnly: Boolean = False); overload; + override; + destructor Destroy; override; + protected + FAnimData: TAnimDataArray; + FAnimCount: Cardinal; + function CalculateOffset(AID: Integer): Integer; override; + function GetData(AID, AOffset: Integer): TAnimData; override; + procedure InitArray; + procedure SetData(AID, AOffset: Integer; ABlock: TMulBlock); override; + public + property AnimData: TAnimDataArray read FAnimData; + property AnimCount: Cardinal read FAnimCount; + function GetBlock(AID: Integer): TAnimData; override; + end; + +implementation + +uses + Logging; + +{ TAnimDataProvider } + +constructor TAnimDataProvider.Create(AData: TStream; AReadOnly: Boolean); +begin + inherited Create(AData, AReadOnly); + InitArray; +end; + +constructor TAnimDataProvider.Create(AData: string; AReadOnly: Boolean); +begin + inherited Create(AData, AReadOnly); + InitArray; +end; + +destructor TAnimDataProvider.Destroy; +var + i: Integer; +begin + for i := 0 to Length(FAnimData) - 1 do + FreeAndNil(FAnimData[i]); + + inherited Destroy; +end; + +function TAnimDataProvider.CalculateOffset(AID: Integer): Integer; +begin + Result := GetAnimDataOffset(AID); +end; + +function TAnimDataProvider.GetData(AID, AOffset: Integer): TAnimData; +begin + Result := FAnimData[AID]; +end; + +procedure TAnimDataProvider.InitArray; +var + i: Integer; +begin + FData.Position := 0; + FAnimCount := (FData.Size div AnimDataGroupSize) * 8; + Logger.Send([lcInfo], 'Loading $%x AnimData entries.', [FAnimCount]); + SetLength(FAnimData, FAnimCount); + for i := 0 to FAnimCount - 1 do + begin + if i mod 8 = 0 then + FData.Seek(4, soFromCurrent); + FAnimData[i] := TAnimData.Create(FData); + end; +end; + +procedure TAnimDataProvider.SetData(AID, AOffset: Integer; ABlock: TMulBlock); +begin + FreeAndNil(FAnimData[AID]); + FAnimData[AID] := TAnimData(ABlock.Clone); + + if not FReadOnly then + begin + FData.Position := AOffset; + ABlock.Write(FData); + end; +end; + +function TAnimDataProvider.GetBlock(AID: Integer): TAnimData; +begin + Result := FAnimData[AID].Clone; +end; + +end. + diff --git a/MulProvider/UArtProvider.pas b/MulProvider/UArtProvider.pas index b9449d1..96e6fc2 100644 --- a/MulProvider/UArtProvider.pas +++ b/MulProvider/UArtProvider.pas @@ -1,101 +1,101 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2009 Andreas Schneider - *) -unit UArtProvider; - -{$mode objfpc}{$H+} - -interface - -uses - Graphics, UMulProvider, UMulBlock, UGenericIndex, UArt, UHue; - -type - TArtProvider = class(TIndexedMulProvider) - protected - function GetData(AID: Integer; AIndex: TGenericIndex): TMulBlock; override; - function GetArtData(AID: Integer; AIndex: TGenericIndex; AColor: Word; - AHue: THue; APartialHue: Boolean): TArt; - public - function GetArt(AID: Integer; AColor: Word; AHue: THue; APartialHue: Boolean): TArt; - function GetFlatLand(AID: Integer): TArt; - end; - -implementation - -{ TArtProvider } - -function TArtProvider.GetData(AID: Integer; AIndex: TGenericIndex): TMulBlock; -begin - Result := GetArtData(AID, AIndex, clBlack, nil, False); -end; - -function TArtProvider.GetArtData(AID: Integer; AIndex: TGenericIndex; - AColor: Word; AHue: THue; APartialHue: Boolean): TArt; -begin - if (AIndex.Lookup > -1) and (AIndex.Size > 0) then - begin - if AID < $4000 then - Result := TArt.Create(FData, AIndex, atLand, AColor, AHue, APartialHue) - else - Result := TArt.Create(FData, AIndex, atStatic, AColor, AHue, APartialHue); - end - else - begin - if AID < $4000 then - Result := TArt.Create(nil, nil, atLand, AColor, AHue, APartialHue) - else - Result := TArt.Create(nil, nil, atStatic, AColor, AHue, APartialHue); - end; - Result.ID := AID; -end; - -function TArtProvider.GetArt(AID: Integer; AColor: Word; AHue: THue; - APartialHue: Boolean): TArt; -var - genericIndex: TGenericIndex; -begin - FIndex.Position := CalculateIndexOffset(AID); - genericIndex := TGenericIndex.Create(FIndex); - Result := GetArtData(AID, genericIndex, AColor, AHue, APartialHue); - genericIndex.Free; - Result.OnChanged := @OnChanged; - Result.OnFinished := @OnFinished; -end; - -function TArtProvider.GetFlatLand(AID: Integer): TArt; -var - genericIndex: TGenericIndex; -begin - FIndex.Position := CalculateIndexOffset(AID); - genericIndex := TGenericIndex.Create(FIndex); - Result := TArt.Create(FData, genericIndex, atLandFlat); - genericIndex.Free; - Result.OnChanged := @OnChanged; - Result.OnFinished := @OnFinished; -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2009 Andreas Schneider + *) +unit UArtProvider; + +{$mode objfpc}{$H+} + +interface + +uses + Graphics, UMulProvider, UMulBlock, UGenericIndex, UArt, UHue; + +type + TArtProvider = class(TIndexedMulProvider) + protected + function GetData(AID: Integer; AIndex: TGenericIndex): TMulBlock; override; + function GetArtData(AID: Integer; AIndex: TGenericIndex; AColor: Word; + AHue: THue; APartialHue: Boolean): TArt; + public + function GetArt(AID: Integer; AColor: Word; AHue: THue; APartialHue: Boolean): TArt; + function GetFlatLand(AID: Integer): TArt; + end; + +implementation + +{ TArtProvider } + +function TArtProvider.GetData(AID: Integer; AIndex: TGenericIndex): TMulBlock; +begin + Result := GetArtData(AID, AIndex, clBlack, nil, False); +end; + +function TArtProvider.GetArtData(AID: Integer; AIndex: TGenericIndex; + AColor: Word; AHue: THue; APartialHue: Boolean): TArt; +begin + if (AIndex.Lookup > -1) and (AIndex.Size > 0) then + begin + if AID < $4000 then + Result := TArt.Create(FData, AIndex, atLand, AColor, AHue, APartialHue) + else + Result := TArt.Create(FData, AIndex, atStatic, AColor, AHue, APartialHue); + end + else + begin + if AID < $4000 then + Result := TArt.Create(nil, nil, atLand, AColor, AHue, APartialHue) + else + Result := TArt.Create(nil, nil, atStatic, AColor, AHue, APartialHue); + end; + Result.ID := AID; +end; + +function TArtProvider.GetArt(AID: Integer; AColor: Word; AHue: THue; + APartialHue: Boolean): TArt; +var + genericIndex: TGenericIndex; +begin + FIndex.Position := CalculateIndexOffset(AID); + genericIndex := TGenericIndex.Create(FIndex); + Result := GetArtData(AID, genericIndex, AColor, AHue, APartialHue); + genericIndex.Free; + Result.OnChanged := @OnChanged; + Result.OnFinished := @OnFinished; +end; + +function TArtProvider.GetFlatLand(AID: Integer): TArt; +var + genericIndex: TGenericIndex; +begin + FIndex.Position := CalculateIndexOffset(AID); + genericIndex := TGenericIndex.Create(FIndex); + Result := TArt.Create(FData, genericIndex, atLandFlat); + genericIndex.Free; + Result.OnChanged := @OnChanged; + Result.OnFinished := @OnFinished; +end; + +end. + diff --git a/MulProvider/UGumpProvider.pas b/MulProvider/UGumpProvider.pas index 48be8a9..856e412 100644 --- a/MulProvider/UGumpProvider.pas +++ b/MulProvider/UGumpProvider.pas @@ -1,63 +1,63 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2007 Andreas Schneider - *) -unit UGumpProvider; - -{$mode objfpc}{$H+} - -interface - -uses - UMulProvider, UMulBlock, UGenericIndex, UGump; - -type - TGumpProvider = class(TIndexedMulProvider) - protected - function GetData(AID: Integer; AIndex: TGenericIndex): TMulBlock; override; - function GetVarious(AID: Integer; ABlock: TMulBlock; ADefault: Integer): Integer; override; - end; - -implementation - -{ TGumpProvider } - -function TGumpProvider.GetData(AID: Integer; AIndex: TGenericIndex): TMulBlock; -begin - if AIndex.Lookup <> LongInt($FFFFFFFF) then - Result := TGump.Create(FData, TGumpIndex(AIndex)) - else - Result := TGump.Create(0, 0); - Result.ID := AID; -end; - -function TGumpProvider.GetVarious(AID: Integer; ABlock: TMulBlock; - ADefault: Integer): Integer; -begin - Result := TGump(ABlock).Graphic.Height or (TGump(ABlock).Graphic.Width shl 16); -end; - -end. - - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2007 Andreas Schneider + *) +unit UGumpProvider; + +{$mode objfpc}{$H+} + +interface + +uses + UMulProvider, UMulBlock, UGenericIndex, UGump; + +type + TGumpProvider = class(TIndexedMulProvider) + protected + function GetData(AID: Integer; AIndex: TGenericIndex): TMulBlock; override; + function GetVarious(AID: Integer; ABlock: TMulBlock; ADefault: Integer): Integer; override; + end; + +implementation + +{ TGumpProvider } + +function TGumpProvider.GetData(AID: Integer; AIndex: TGenericIndex): TMulBlock; +begin + if AIndex.Lookup <> LongInt($FFFFFFFF) then + Result := TGump.Create(FData, TGumpIndex(AIndex)) + else + Result := TGump.Create(0, 0); + Result.ID := AID; +end; + +function TGumpProvider.GetVarious(AID: Integer; ABlock: TMulBlock; + ADefault: Integer): Integer; +begin + Result := TGump(ABlock).Graphic.Height or (TGump(ABlock).Graphic.Width shl 16); +end; + +end. + + diff --git a/MulProvider/UHueProvider.pas b/MulProvider/UHueProvider.pas index b23c8f6..72251df 100644 --- a/MulProvider/UHueProvider.pas +++ b/MulProvider/UHueProvider.pas @@ -1,153 +1,153 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2007 Andreas Schneider - *) -unit UHueProvider; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes, Contnrs, UMulProvider, UMulBlock, UHue; - -type - THueProvider = class(TMulProvider) - constructor Create(AData: TStream; AReadOnly: Boolean = False); overload; override; - constructor Create(AData: string; AReadOnly: Boolean = False); overload; override; - destructor Destroy; override; - protected - FHueGroups: TObjectList; - procedure InitList; - function CalculateOffset(AID: Integer): Integer; override; - function GetData(AID, AOffset: Integer): TMulBlock; override; - procedure SetData(AID, AOffset: Integer; ABlock: TMulBlock); override; - function GetHue(AIndex: Integer): THue; - function GetCount: Integer; - public - function GetBlock(AID: Integer): TMulBlock; override; - property Hues[Index: Integer]: THue read GetHue; - property Count: Integer read GetCount; - end; - -implementation - -{ THueProvider } - -function THueProvider.CalculateOffset(AID: Integer): Integer; -begin - Result := (AID div 8) * 708 + (AID mod 8) * 88; -end; - -constructor THueProvider.Create(AData: TStream; AReadOnly: Boolean = False); -begin - inherited; - InitList; -end; - -constructor THueProvider.Create(AData: string; AReadOnly: Boolean = False); -begin - inherited; - InitList; -end; - -destructor THueProvider.Destroy; -begin - FHueGroups.Free; - inherited; -end; - -function THueProvider.GetBlock(AID: Integer): TMulBlock; -begin - Result := GetData(AID, 0); -end; - -function THueProvider.GetCount: Integer; -begin - Result := FHueGroups.Count * 8; -end; - -function THueProvider.GetData(AID, AOffset: Integer): TMulBlock; -var - group, entry: Integer; -begin - group := (AID div 8) mod FHueGroups.Count; - entry := AID mod 8; - Result := TMulBlock(THueGroup(FHueGroups.Items[group]).HueEntries[entry].Clone); - Result.ID := AID; - Result.OnChanged := @OnChanged; - Result.OnFinished := @OnFinished; -end; - -function THueProvider.GetHue(AIndex: Integer): THue; -var - group, entry: Integer; -begin - group := (AIndex div 8) mod FHueGroups.Count; - entry := AIndex mod 8; - Result := THue(THueGroup(FHueGroups.Items[group]).HueEntries[entry]); - Result.ID := AIndex; -end; - -procedure THueProvider.InitList; -var - i: Integer; -begin - FHueGroups := TObjectList.Create; - FHueGroups.Count := FData.Size div 708; - FData.Position := 0; - i := 0; - while FData.Position < FData.Size do - begin - FHueGroups.Items[i] := THueGroup.Create(FData); - Inc(i); - end; -end; - -procedure THueProvider.SetData(AID, AOffset: Integer; - ABlock: TMulBlock); -var - group, entry: Integer; -begin - group := AID div 8; - entry := AID mod 8; - - if (group >= FHueGroups.Count) or (group < 0) then - begin - group := FHueGroups.Count; - FHueGroups.Add(THueGroup.Create(nil)); - entry := 0; - end; - - THueGroup(FHueGroups.Items[group]).HueEntries[entry] := THue(ABlock.Clone); - - if not FReadOnly then - begin - FData.Position := AOffset; - ABlock.Write(FData); - end; -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2007 Andreas Schneider + *) +unit UHueProvider; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Classes, Contnrs, UMulProvider, UMulBlock, UHue; + +type + THueProvider = class(TMulProvider) + constructor Create(AData: TStream; AReadOnly: Boolean = False); overload; override; + constructor Create(AData: string; AReadOnly: Boolean = False); overload; override; + destructor Destroy; override; + protected + FHueGroups: TObjectList; + procedure InitList; + function CalculateOffset(AID: Integer): Integer; override; + function GetData(AID, AOffset: Integer): TMulBlock; override; + procedure SetData(AID, AOffset: Integer; ABlock: TMulBlock); override; + function GetHue(AIndex: Integer): THue; + function GetCount: Integer; + public + function GetBlock(AID: Integer): TMulBlock; override; + property Hues[Index: Integer]: THue read GetHue; + property Count: Integer read GetCount; + end; + +implementation + +{ THueProvider } + +function THueProvider.CalculateOffset(AID: Integer): Integer; +begin + Result := (AID div 8) * 708 + (AID mod 8) * 88; +end; + +constructor THueProvider.Create(AData: TStream; AReadOnly: Boolean = False); +begin + inherited; + InitList; +end; + +constructor THueProvider.Create(AData: string; AReadOnly: Boolean = False); +begin + inherited; + InitList; +end; + +destructor THueProvider.Destroy; +begin + FHueGroups.Free; + inherited; +end; + +function THueProvider.GetBlock(AID: Integer): TMulBlock; +begin + Result := GetData(AID, 0); +end; + +function THueProvider.GetCount: Integer; +begin + Result := FHueGroups.Count * 8; +end; + +function THueProvider.GetData(AID, AOffset: Integer): TMulBlock; +var + group, entry: Integer; +begin + group := (AID div 8) mod FHueGroups.Count; + entry := AID mod 8; + Result := TMulBlock(THueGroup(FHueGroups.Items[group]).HueEntries[entry].Clone); + Result.ID := AID; + Result.OnChanged := @OnChanged; + Result.OnFinished := @OnFinished; +end; + +function THueProvider.GetHue(AIndex: Integer): THue; +var + group, entry: Integer; +begin + group := (AIndex div 8) mod FHueGroups.Count; + entry := AIndex mod 8; + Result := THue(THueGroup(FHueGroups.Items[group]).HueEntries[entry]); + Result.ID := AIndex; +end; + +procedure THueProvider.InitList; +var + i: Integer; +begin + FHueGroups := TObjectList.Create; + FHueGroups.Count := FData.Size div 708; + FData.Position := 0; + i := 0; + while FData.Position < FData.Size do + begin + FHueGroups.Items[i] := THueGroup.Create(FData); + Inc(i); + end; +end; + +procedure THueProvider.SetData(AID, AOffset: Integer; + ABlock: TMulBlock); +var + group, entry: Integer; +begin + group := AID div 8; + entry := AID mod 8; + + if (group >= FHueGroups.Count) or (group < 0) then + begin + group := FHueGroups.Count; + FHueGroups.Add(THueGroup.Create(nil)); + entry := 0; + end; + + THueGroup(FHueGroups.Items[group]).HueEntries[entry] := THue(ABlock.Clone); + + if not FReadOnly then + begin + FData.Position := AOffset; + ABlock.Write(FData); + end; +end; + +end. + diff --git a/MulProvider/ULightProvider.pas b/MulProvider/ULightProvider.pas index 8016b4f..55b8f34 100644 --- a/MulProvider/ULightProvider.pas +++ b/MulProvider/ULightProvider.pas @@ -1,62 +1,62 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2009 Andreas Schneider - *) -unit ULightProvider; - -{$mode objfpc}{$H+} - -interface - -uses - UMulProvider, UGenericIndex, ULight; - -type - - { TLightProvider } - - TLightProvider = class(TIndexedMulProvider) - protected - function GetData(AID: Integer; AIndex: TGenericIndex): TLight; override; - public - function GetLight(AID: Integer): TLight; - end; - -implementation - -{ TLightProvider } - -function TLightProvider.GetData(AID: Integer; AIndex: TGenericIndex): TLight; -begin - Result := TLight.Create(FData, AIndex); - Result.ID := AID; -end; - -function TLightProvider.GetLight(AID: Integer): TLight; -begin - Result := TLight(GetBlock(AID)); -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2009 Andreas Schneider + *) +unit ULightProvider; + +{$mode objfpc}{$H+} + +interface + +uses + UMulProvider, UGenericIndex, ULight; + +type + + { TLightProvider } + + TLightProvider = class(TIndexedMulProvider) + protected + function GetData(AID: Integer; AIndex: TGenericIndex): TLight; override; + public + function GetLight(AID: Integer): TLight; + end; + +implementation + +{ TLightProvider } + +function TLightProvider.GetData(AID: Integer; AIndex: TGenericIndex): TLight; +begin + Result := TLight.Create(FData, AIndex); + Result.ID := AID; +end; + +function TLightProvider.GetLight(AID: Integer): TLight; +begin + Result := TLight(GetBlock(AID)); +end; + +end. + diff --git a/MulProvider/UMulManager.pas b/MulProvider/UMulManager.pas index 715337a..8ea26d8 100644 --- a/MulProvider/UMulManager.pas +++ b/MulProvider/UMulManager.pas @@ -1,129 +1,129 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2009 Andreas Schneider - *) -unit UMulManager; - -interface - -uses - SysUtils, UTileDataProvider, UArtProvider, UGumpProvider, UTexmapProvider, - UHueProvider, URadarProvider, UAnimDataProvider; - -type - - { TMulManager } - - TMulManager = class - destructor Destroy; override; - protected - FArtProvider: TArtProvider; - FGumpProvider: TGumpProvider; - FTexmapProvider: TTexmapProvider; - FTileDataProvider: TTileDataProvider; - FAnimDataProvider: TAnimDataProvider; - FHueProvider: THueProvider; - FRadarProvider: TRadarProvider; - public - procedure RegisterArtProvider(AArtProvider: TArtProvider); - procedure RegisterGumpProvider(AGumpProvider: TGumpProvider); - procedure RegisterTexmapProvider(ATexmapProvider: TTexmapProvider); - procedure RegisterTileDataProvider(ATileDataProvider: TTileDataProvider); - procedure RegisterAnimDataProvider(AAnimDataProvider: TAnimDataProvider); - procedure RegisterHueProvider(AHueProvider: THueProvider); - procedure RegisterRadarProvider(ARadarProvider: TRadarProvider); - property ArtProvider: TArtProvider read FArtProvider; - property GumpProvider: TGumpProvider read FGumpProvider; - property TexmapProvider: TTexmapProvider read FTexmapProvider; - property TileDataProvider: TTileDataProvider read FTileDataProvider; - property AnimDataProvider: TAnimDataProvider read FAnimDataProvider; - property HueProvider: THueProvider read FHueProvider; - property RadarProvider: TRadarPRovider read FRadarProvider; - end; - -implementation - -{ TMulManager } - -destructor TMulManager.Destroy; -begin - RegisterArtProvider(nil); - RegisterGumpProvider(nil); - RegisterTexmapProvider(nil); - RegisterTileDataProvider(nil); - RegisterHueProvider(nil); - RegisterRadarProvider(nil); - inherited Destroy; -end; - -procedure TMulManager.RegisterArtProvider( - AArtProvider: TArtProvider); -begin - FreeAndNil(FArtProvider); - FArtProvider := AArtProvider; -end; - -procedure TMulManager.RegisterGumpProvider( - AGumpProvider: TGumpProvider); -begin - FreeAndNil(FGumpProvider); - FGumpProvider := AGumpProvider; -end; - -procedure TMulManager.RegisterHueProvider( - AHueProvider: THueProvider); -begin - FreeAndNil(FHueProvider); - FHueProvider := AHueProvider; -end; - -procedure TMulManager.RegisterRadarProvider( - ARadarProvider: TRadarProvider); -begin - FreeAndNil(FRadarProvider); - FRadarProvider := ARadarProvider; -end; - -procedure TMulManager.RegisterTexmapProvider( - ATexmapProvider: TTexmapProvider); -begin - FreeAndNil(FTexmapProvider); - FTexmapProvider := ATexmapProvider; -end; - -procedure TMulManager.RegisterTileDataProvider( - ATileDataProvider: TTileDataProvider); -begin - FreeAndNil(FTileDataProvider); - FTileDataProvider := ATileDataProvider; -end; - -procedure TMulManager.RegisterAnimDataProvider( - AAnimDataProvider: TAnimDataProvider); -begin - FreeAndNil(FAnimDataProvider); - FAnimDataProvider := AAnimDataProvider; -end; - -end. +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2009 Andreas Schneider + *) +unit UMulManager; + +interface + +uses + SysUtils, UTileDataProvider, UArtProvider, UGumpProvider, UTexmapProvider, + UHueProvider, URadarProvider, UAnimDataProvider; + +type + + { TMulManager } + + TMulManager = class + destructor Destroy; override; + protected + FArtProvider: TArtProvider; + FGumpProvider: TGumpProvider; + FTexmapProvider: TTexmapProvider; + FTileDataProvider: TTileDataProvider; + FAnimDataProvider: TAnimDataProvider; + FHueProvider: THueProvider; + FRadarProvider: TRadarProvider; + public + procedure RegisterArtProvider(AArtProvider: TArtProvider); + procedure RegisterGumpProvider(AGumpProvider: TGumpProvider); + procedure RegisterTexmapProvider(ATexmapProvider: TTexmapProvider); + procedure RegisterTileDataProvider(ATileDataProvider: TTileDataProvider); + procedure RegisterAnimDataProvider(AAnimDataProvider: TAnimDataProvider); + procedure RegisterHueProvider(AHueProvider: THueProvider); + procedure RegisterRadarProvider(ARadarProvider: TRadarProvider); + property ArtProvider: TArtProvider read FArtProvider; + property GumpProvider: TGumpProvider read FGumpProvider; + property TexmapProvider: TTexmapProvider read FTexmapProvider; + property TileDataProvider: TTileDataProvider read FTileDataProvider; + property AnimDataProvider: TAnimDataProvider read FAnimDataProvider; + property HueProvider: THueProvider read FHueProvider; + property RadarProvider: TRadarPRovider read FRadarProvider; + end; + +implementation + +{ TMulManager } + +destructor TMulManager.Destroy; +begin + RegisterArtProvider(nil); + RegisterGumpProvider(nil); + RegisterTexmapProvider(nil); + RegisterTileDataProvider(nil); + RegisterHueProvider(nil); + RegisterRadarProvider(nil); + inherited Destroy; +end; + +procedure TMulManager.RegisterArtProvider( + AArtProvider: TArtProvider); +begin + FreeAndNil(FArtProvider); + FArtProvider := AArtProvider; +end; + +procedure TMulManager.RegisterGumpProvider( + AGumpProvider: TGumpProvider); +begin + FreeAndNil(FGumpProvider); + FGumpProvider := AGumpProvider; +end; + +procedure TMulManager.RegisterHueProvider( + AHueProvider: THueProvider); +begin + FreeAndNil(FHueProvider); + FHueProvider := AHueProvider; +end; + +procedure TMulManager.RegisterRadarProvider( + ARadarProvider: TRadarProvider); +begin + FreeAndNil(FRadarProvider); + FRadarProvider := ARadarProvider; +end; + +procedure TMulManager.RegisterTexmapProvider( + ATexmapProvider: TTexmapProvider); +begin + FreeAndNil(FTexmapProvider); + FTexmapProvider := ATexmapProvider; +end; + +procedure TMulManager.RegisterTileDataProvider( + ATileDataProvider: TTileDataProvider); +begin + FreeAndNil(FTileDataProvider); + FTileDataProvider := ATileDataProvider; +end; + +procedure TMulManager.RegisterAnimDataProvider( + AAnimDataProvider: TAnimDataProvider); +begin + FreeAndNil(FAnimDataProvider); + FAnimDataProvider := AAnimDataProvider; +end; + +end. diff --git a/MulProvider/UMulProvider.pas b/MulProvider/UMulProvider.pas index 4ca7cca..730ea6e 100644 --- a/MulProvider/UMulProvider.pas +++ b/MulProvider/UMulProvider.pas @@ -1,391 +1,391 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2009 Andreas Schneider - *) -unit UMulProvider; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes, UBufferedStreams, UMulBlock, UGenericIndex; - -type - TOnProgressEvent = procedure(Total, Current: Integer) of object; - - { TMulEventHandler } - - TMulEventHandler = class - constructor Create; - destructor Destroy; override; - protected - FEvents: TList; - public - procedure RegisterEvent(AEvent: TMulBlockChanged); - procedure UnregisterEvent(AEvent: TMulBlockChanged); - procedure FireEvents(ABlock: TMulBlock); - end; - - { TMulProvider } - - TMulProvider = class - constructor Create; overload; virtual; - constructor Create(AData: TStream; AReadOnly: Boolean = False); overload; virtual; - constructor Create(AData: string; AReadOnly: Boolean = False); overload; virtual; - destructor Destroy; override; - protected - FData: TStream; - FOwnsData: Boolean; - FReadOnly: Boolean; - FChangeEvents: TMulEventHandler; - FFinishedEvents: TMulEventHandler; - function CalculateOffset(AID: Integer): Integer; virtual; abstract; - function GetData(AID, AOffset: Integer): TMulBlock; virtual; abstract; - procedure SetData(AID, AOffset: Integer; ABlock: TMulBlock); virtual; - procedure OnChanged(ABlock: TMulBlock); - procedure OnFinished(ABlock: TMulBlock); - public - function GetBlock(AID: Integer): TMulBlock; virtual; - procedure SetBlock(AID: Integer; ABlock: TMulBlock); virtual; - procedure RegisterOnChangeEvent(AEvent: TMulBlockChanged); - procedure UnregisterOnChangeEvent(AEvent: TMulBlockChanged); - procedure RegisterOnFinishedEvent(AEvent: TMulBlockChanged); - procedure UnregisterOnFinishedEvent(AEvent: TMulBlockChanged); - property Block[ID: Integer]: TMulBlock read GetBlock write SetBlock; - property Data: TStream read FData; - end; - - { TIndexedMulProvider } - - TIndexedMulProvider = class(TMulProvider) - constructor Create(AData, AIndex: TStream; AReadOnly: Boolean = False); overload; virtual; - constructor Create(AData, AIndex: string; AReadOnly: Boolean = False); overload; virtual; - destructor Destroy; override; - protected - FIndex: TBufferedReader; - FEntryCount: Cardinal; - function CalculateIndexOffset(AID: Integer): Integer; virtual; - function GetData(AID: Integer; AIndex: TGenericIndex): TMulBlock; reintroduce; virtual; abstract; - procedure SetData(AID: Integer; AIndex: TGenericIndex; ABlock: TMulBlock); reintroduce; virtual; - function GetVarious(AID: Integer; ABlock: TMulBlock; ADefault: Integer): Integer; virtual; - public - function GetBlock(AID: Integer): TMulBlock; override; - procedure GetBlockEx(AID: Integer; var ABlock: TMulBlock; var AIndex: TGenericIndex); virtual; - procedure SetBlock(AID: Integer; ABlock: TMulBlock); override; - function Exists(AID: Integer): Boolean; virtual; - procedure Defragment(ATempStream: TStream; AOnProgress: TOnProgressEvent = nil); virtual; - property Index: TBufferedReader read FIndex; - property EntryCount: Cardinal read FEntryCount; - end; - -implementation - -type - PMethod = ^TMethod; - -{ TMulEventHandler } - -constructor TMulEventHandler.Create; -begin - inherited; - FEvents := TList.Create; -end; - -destructor TMulEventHandler.Destroy; -var - i: Integer; -begin - if Assigned(FEvents) then - begin - for i := 0 to FEvents.Count - 1 do - Dispose(PMethod(FEvents.Items[i])); - FreeAndNil(FEvents); - end; - inherited Destroy; -end; - -procedure TMulEventHandler.FireEvents(ABlock: TMulBlock); -var - i: Integer; -begin - for i := 0 to FEvents.Count - 1 do - TMulBlockChanged(FEvents.Items[i]^)(ABlock); -end; - -procedure TMulEventHandler.RegisterEvent(AEvent: TMulBlockChanged); -var - eventInfo: PMethod; -begin - UnregisterEvent(AEvent); - New(eventInfo); - eventInfo^.Code := TMethod(AEvent).Code; - eventInfo^.Data := TMethod(AEvent).Data; - FEvents.Add(eventInfo); -end; - -procedure TMulEventHandler.UnregisterEvent(AEvent: TMulBlockChanged); -var - i: Integer; - - function RemoveEntry: Boolean; - begin - Dispose(PMethod(FEvents.Items[i])); - FEvents.Delete(i); - Result := True; - end; - -begin - i := 0; - while (i < FEvents.Count) and ((TMethod(AEvent).Code <> TMethod(FEvents.Items[i]^).Code) or (TMethod(AEvent).Data <> TMethod(FEvents.Items[i]^).Data) or not RemoveEntry) do - Inc(i); -end; - -{ TMulProvider } - -constructor TMulProvider.Create(AData: TStream; AReadOnly: Boolean = False); -begin - Create; - FData := AData; - FOwnsData := False; - FReadOnly := AReadOnly; -end; - -constructor TMulProvider.Create(AData: string; AReadOnly: Boolean = False); -var - mode: Word; -begin - Create; - if AReadOnly then - mode := fmOpenRead or fmShareDenyWrite - else - mode := fmOpenReadWrite or fmShareDenyWrite; - FData := TFileStream.Create(AData, mode); - FOwnsData := True; - FReadOnly := AReadOnly; -end; - -constructor TMulProvider.Create; -begin - inherited; - FChangeEvents := TMulEventHandler.Create; - FFinishedEvents := TMulEventHandler.Create; -end; - -destructor TMulProvider.Destroy; -begin - if FOwnsData and Assigned(FData) then FreeAndNil(FData); - if Assigned(FChangeEvents) then FreeAndNil(FChangeEvents); - if Assigned(FFinishedEvents) then FreeAndNil(FFinishedEvents); - inherited; -end; - -function TMulProvider.GetBlock(AID: Integer): TMulBlock; -begin - Result := GetData(AID, CalculateOffset(AID)); - Result.OnChanged := @OnChanged; - Result.OnFinished := @OnFinished; -end; - -procedure TMulProvider.OnChanged(ABlock: TMulBlock); -begin - SetBlock(ABlock.ID, ABlock); - FChangeEvents.FireEvents(ABlock); -end; - -procedure TMulProvider.OnFinished(ABlock: TMulBlock); -begin - FFinishedEvents.FireEvents(ABlock); - ABlock.Free; -end; - -procedure TMulProvider.RegisterOnChangeEvent(AEvent: TMulBlockChanged); -begin - FChangeEvents.RegisterEvent(AEvent); -end; - -procedure TMulProvider.RegisterOnFinishedEvent(AEvent: TMulBlockChanged); -begin - FFinishedEvents.RegisterEvent(AEvent); -end; - -procedure TMulProvider.SetBlock(AID: Integer; ABlock: TMulBlock); -begin - if FReadOnly then Exit; - SetData(AID, CalculateOffset(AID), ABlock); -end; - -procedure TMulProvider.SetData(AID, AOffset: Integer; ABlock: TMulBlock); -begin - if FReadOnly then Exit; - FData.Position := AOffset; - ABlock.Write(FData); -end; - -procedure TMulProvider.UnregisterOnChangeEvent(AEvent: TMulBlockChanged); -begin - FChangeEvents.UnregisterEvent(AEvent); -end; - -procedure TMulProvider.UnregisterOnFinishedEvent(AEvent: TMulBlockChanged); -begin - FFinishedEvents.UnregisterEvent(AEvent); -end; - -{ TIndexedMulProvider } - -function TIndexedMulProvider.CalculateIndexOffset(AID: Integer): Integer; -begin - Result := 12 * AID; -end; - -constructor TIndexedMulProvider.Create(AData, AIndex: TStream; AReadOnly: Boolean = False); -begin - inherited Create(AData, AReadOnly); - FIndex := TBufferedReader.Create(AIndex); - FEntryCount := AIndex.Size div 12; -end; - -constructor TIndexedMulProvider.Create(AData, AIndex: string; AReadOnly: Boolean = False); -var - mode: Word; -begin - inherited Create(AData, AReadOnly); - if AReadOnly then - mode := fmOpenRead or fmShareDenyWrite - else - mode := fmOpenReadWrite or fmShareDenyWrite; - FIndex := TBufferedReader.Create(TFileStream.Create(AIndex, mode), True); - FEntryCount := FIndex.Size div 12; -end; - -procedure TIndexedMulProvider.Defragment(ATempStream: TStream; AOnProgress: TOnProgressEvent = nil); -var - genericIndex: TGenericIndex; -begin - if FReadOnly then Exit; - ATempStream.Size := FData.Size; - ATempStream.Position := 0; - FIndex.Position := 0; - while FIndex.Position < FIndex.Size do - begin - genericIndex := TGenericIndex.Create(FIndex); - if genericIndex.Lookup > -1 then - begin - FData.Position := genericIndex.Lookup; - genericIndex.Lookup := ATempStream.Position; - ATempStream.CopyFrom(FData, genericIndex.Size); - FIndex.Seek(-12, soFromCurrent); - genericIndex.Write(FIndex); - end; - genericIndex.Free; - if Assigned(AOnProgress) and (FIndex.Position mod 1200 = 0) then - AOnProgress(FIndex.Size, FIndex.Position); - end; - FData.Size := ATempStream.Position; - FData.Position := 0; - ATempStream.Position := 0; - FData.CopyFrom(ATempStream, FData.Size); -end; - -destructor TIndexedMulProvider.Destroy; -begin - FreeAndNil(FIndex); - inherited Destroy; -end; - -function TIndexedMulProvider.Exists(AID: Integer): Boolean; -var - genericIndex: TGenericIndex; -begin - FIndex.Position := CalculateIndexOffset(AID); - genericIndex := TGenericIndex.Create(FIndex); - Result := (genericIndex.Lookup > -1) and (genericIndex.Size > 0); - genericIndex.Free; -end; - -function TIndexedMulProvider.GetBlock(AID: Integer): TMulBlock; -var - genericIndex: TGenericIndex; -begin - GetBlockEx(AID, Result, genericIndex); - genericIndex.Free; -end; - -procedure TIndexedMulProvider.GetBlockEx(AID: Integer; - var ABlock: TMulBlock; var AIndex: TGenericIndex); -begin - FIndex.Position := CalculateIndexOffset(AID); - AIndex := TGenericIndex.Create(FIndex); - ABlock := GetData(AID, AIndex); - ABlock.OnChanged := @OnChanged; - ABlock.OnFinished := @OnFinished; -end; - -function TIndexedMulProvider.GetVarious(AID: Integer; ABlock: TMulBlock; - ADefault: Integer): Integer; -begin - Result := ADefault; -end; - -procedure TIndexedMulProvider.SetBlock(AID: Integer; ABlock: TMulBlock); -var - genericIndex: TGenericIndex; -begin - if FReadOnly then Exit; - FIndex.Position := CalculateIndexOffset(AID); - genericIndex := TGenericIndex.Create(FIndex); - SetData(AID, genericIndex, ABlock); - FIndex.Position := CalculateIndexOffset(AID); - genericIndex.Various := GetVarious(AID, ABlock, genericIndex.Various); - genericIndex.Write(FIndex); - genericIndex.Free; -end; - -procedure TIndexedMulProvider.SetData(AID: Integer; AIndex: TGenericIndex; - ABlock: TMulBlock); -var - size: Integer; -begin - if FReadOnly then Exit; - size := ABlock.GetSize; - if size = 0 then - begin - AIndex.Lookup := -1; - AIndex.Various := -1; - end else if (size > AIndex.Size) or (AIndex.Lookup < 0) then - begin - FData.Position := FData.Size; - AIndex.Lookup := FData.Position; - ABlock.Write(FData); - end else - begin - FData.Position := AIndex.Lookup; - ABlock.Write(FData); - end; - AIndex.Size := size; -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2009 Andreas Schneider + *) +unit UMulProvider; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Classes, UBufferedStreams, UMulBlock, UGenericIndex; + +type + TOnProgressEvent = procedure(Total, Current: Integer) of object; + + { TMulEventHandler } + + TMulEventHandler = class + constructor Create; + destructor Destroy; override; + protected + FEvents: TList; + public + procedure RegisterEvent(AEvent: TMulBlockChanged); + procedure UnregisterEvent(AEvent: TMulBlockChanged); + procedure FireEvents(ABlock: TMulBlock); + end; + + { TMulProvider } + + TMulProvider = class + constructor Create; overload; virtual; + constructor Create(AData: TStream; AReadOnly: Boolean = False); overload; virtual; + constructor Create(AData: string; AReadOnly: Boolean = False); overload; virtual; + destructor Destroy; override; + protected + FData: TStream; + FOwnsData: Boolean; + FReadOnly: Boolean; + FChangeEvents: TMulEventHandler; + FFinishedEvents: TMulEventHandler; + function CalculateOffset(AID: Integer): Integer; virtual; abstract; + function GetData(AID, AOffset: Integer): TMulBlock; virtual; abstract; + procedure SetData(AID, AOffset: Integer; ABlock: TMulBlock); virtual; + procedure OnChanged(ABlock: TMulBlock); + procedure OnFinished(ABlock: TMulBlock); + public + function GetBlock(AID: Integer): TMulBlock; virtual; + procedure SetBlock(AID: Integer; ABlock: TMulBlock); virtual; + procedure RegisterOnChangeEvent(AEvent: TMulBlockChanged); + procedure UnregisterOnChangeEvent(AEvent: TMulBlockChanged); + procedure RegisterOnFinishedEvent(AEvent: TMulBlockChanged); + procedure UnregisterOnFinishedEvent(AEvent: TMulBlockChanged); + property Block[ID: Integer]: TMulBlock read GetBlock write SetBlock; + property Data: TStream read FData; + end; + + { TIndexedMulProvider } + + TIndexedMulProvider = class(TMulProvider) + constructor Create(AData, AIndex: TStream; AReadOnly: Boolean = False); overload; virtual; + constructor Create(AData, AIndex: string; AReadOnly: Boolean = False); overload; virtual; + destructor Destroy; override; + protected + FIndex: TBufferedReader; + FEntryCount: Cardinal; + function CalculateIndexOffset(AID: Integer): Integer; virtual; + function GetData(AID: Integer; AIndex: TGenericIndex): TMulBlock; reintroduce; virtual; abstract; + procedure SetData(AID: Integer; AIndex: TGenericIndex; ABlock: TMulBlock); reintroduce; virtual; + function GetVarious(AID: Integer; ABlock: TMulBlock; ADefault: Integer): Integer; virtual; + public + function GetBlock(AID: Integer): TMulBlock; override; + procedure GetBlockEx(AID: Integer; var ABlock: TMulBlock; var AIndex: TGenericIndex); virtual; + procedure SetBlock(AID: Integer; ABlock: TMulBlock); override; + function Exists(AID: Integer): Boolean; virtual; + procedure Defragment(ATempStream: TStream; AOnProgress: TOnProgressEvent = nil); virtual; + property Index: TBufferedReader read FIndex; + property EntryCount: Cardinal read FEntryCount; + end; + +implementation + +type + PMethod = ^TMethod; + +{ TMulEventHandler } + +constructor TMulEventHandler.Create; +begin + inherited; + FEvents := TList.Create; +end; + +destructor TMulEventHandler.Destroy; +var + i: Integer; +begin + if Assigned(FEvents) then + begin + for i := 0 to FEvents.Count - 1 do + Dispose(PMethod(FEvents.Items[i])); + FreeAndNil(FEvents); + end; + inherited Destroy; +end; + +procedure TMulEventHandler.FireEvents(ABlock: TMulBlock); +var + i: Integer; +begin + for i := 0 to FEvents.Count - 1 do + TMulBlockChanged(FEvents.Items[i]^)(ABlock); +end; + +procedure TMulEventHandler.RegisterEvent(AEvent: TMulBlockChanged); +var + eventInfo: PMethod; +begin + UnregisterEvent(AEvent); + New(eventInfo); + eventInfo^.Code := TMethod(AEvent).Code; + eventInfo^.Data := TMethod(AEvent).Data; + FEvents.Add(eventInfo); +end; + +procedure TMulEventHandler.UnregisterEvent(AEvent: TMulBlockChanged); +var + i: Integer; + + function RemoveEntry: Boolean; + begin + Dispose(PMethod(FEvents.Items[i])); + FEvents.Delete(i); + Result := True; + end; + +begin + i := 0; + while (i < FEvents.Count) and ((TMethod(AEvent).Code <> TMethod(FEvents.Items[i]^).Code) or (TMethod(AEvent).Data <> TMethod(FEvents.Items[i]^).Data) or not RemoveEntry) do + Inc(i); +end; + +{ TMulProvider } + +constructor TMulProvider.Create(AData: TStream; AReadOnly: Boolean = False); +begin + Create; + FData := AData; + FOwnsData := False; + FReadOnly := AReadOnly; +end; + +constructor TMulProvider.Create(AData: string; AReadOnly: Boolean = False); +var + mode: Word; +begin + Create; + if AReadOnly then + mode := fmOpenRead or fmShareDenyWrite + else + mode := fmOpenReadWrite or fmShareDenyWrite; + FData := TFileStream.Create(AData, mode); + FOwnsData := True; + FReadOnly := AReadOnly; +end; + +constructor TMulProvider.Create; +begin + inherited; + FChangeEvents := TMulEventHandler.Create; + FFinishedEvents := TMulEventHandler.Create; +end; + +destructor TMulProvider.Destroy; +begin + if FOwnsData and Assigned(FData) then FreeAndNil(FData); + if Assigned(FChangeEvents) then FreeAndNil(FChangeEvents); + if Assigned(FFinishedEvents) then FreeAndNil(FFinishedEvents); + inherited; +end; + +function TMulProvider.GetBlock(AID: Integer): TMulBlock; +begin + Result := GetData(AID, CalculateOffset(AID)); + Result.OnChanged := @OnChanged; + Result.OnFinished := @OnFinished; +end; + +procedure TMulProvider.OnChanged(ABlock: TMulBlock); +begin + SetBlock(ABlock.ID, ABlock); + FChangeEvents.FireEvents(ABlock); +end; + +procedure TMulProvider.OnFinished(ABlock: TMulBlock); +begin + FFinishedEvents.FireEvents(ABlock); + ABlock.Free; +end; + +procedure TMulProvider.RegisterOnChangeEvent(AEvent: TMulBlockChanged); +begin + FChangeEvents.RegisterEvent(AEvent); +end; + +procedure TMulProvider.RegisterOnFinishedEvent(AEvent: TMulBlockChanged); +begin + FFinishedEvents.RegisterEvent(AEvent); +end; + +procedure TMulProvider.SetBlock(AID: Integer; ABlock: TMulBlock); +begin + if FReadOnly then Exit; + SetData(AID, CalculateOffset(AID), ABlock); +end; + +procedure TMulProvider.SetData(AID, AOffset: Integer; ABlock: TMulBlock); +begin + if FReadOnly then Exit; + FData.Position := AOffset; + ABlock.Write(FData); +end; + +procedure TMulProvider.UnregisterOnChangeEvent(AEvent: TMulBlockChanged); +begin + FChangeEvents.UnregisterEvent(AEvent); +end; + +procedure TMulProvider.UnregisterOnFinishedEvent(AEvent: TMulBlockChanged); +begin + FFinishedEvents.UnregisterEvent(AEvent); +end; + +{ TIndexedMulProvider } + +function TIndexedMulProvider.CalculateIndexOffset(AID: Integer): Integer; +begin + Result := 12 * AID; +end; + +constructor TIndexedMulProvider.Create(AData, AIndex: TStream; AReadOnly: Boolean = False); +begin + inherited Create(AData, AReadOnly); + FIndex := TBufferedReader.Create(AIndex); + FEntryCount := AIndex.Size div 12; +end; + +constructor TIndexedMulProvider.Create(AData, AIndex: string; AReadOnly: Boolean = False); +var + mode: Word; +begin + inherited Create(AData, AReadOnly); + if AReadOnly then + mode := fmOpenRead or fmShareDenyWrite + else + mode := fmOpenReadWrite or fmShareDenyWrite; + FIndex := TBufferedReader.Create(TFileStream.Create(AIndex, mode), True); + FEntryCount := FIndex.Size div 12; +end; + +procedure TIndexedMulProvider.Defragment(ATempStream: TStream; AOnProgress: TOnProgressEvent = nil); +var + genericIndex: TGenericIndex; +begin + if FReadOnly then Exit; + ATempStream.Size := FData.Size; + ATempStream.Position := 0; + FIndex.Position := 0; + while FIndex.Position < FIndex.Size do + begin + genericIndex := TGenericIndex.Create(FIndex); + if genericIndex.Lookup > -1 then + begin + FData.Position := genericIndex.Lookup; + genericIndex.Lookup := ATempStream.Position; + ATempStream.CopyFrom(FData, genericIndex.Size); + FIndex.Seek(-12, soFromCurrent); + genericIndex.Write(FIndex); + end; + genericIndex.Free; + if Assigned(AOnProgress) and (FIndex.Position mod 1200 = 0) then + AOnProgress(FIndex.Size, FIndex.Position); + end; + FData.Size := ATempStream.Position; + FData.Position := 0; + ATempStream.Position := 0; + FData.CopyFrom(ATempStream, FData.Size); +end; + +destructor TIndexedMulProvider.Destroy; +begin + FreeAndNil(FIndex); + inherited Destroy; +end; + +function TIndexedMulProvider.Exists(AID: Integer): Boolean; +var + genericIndex: TGenericIndex; +begin + FIndex.Position := CalculateIndexOffset(AID); + genericIndex := TGenericIndex.Create(FIndex); + Result := (genericIndex.Lookup > -1) and (genericIndex.Size > 0); + genericIndex.Free; +end; + +function TIndexedMulProvider.GetBlock(AID: Integer): TMulBlock; +var + genericIndex: TGenericIndex; +begin + GetBlockEx(AID, Result, genericIndex); + genericIndex.Free; +end; + +procedure TIndexedMulProvider.GetBlockEx(AID: Integer; + var ABlock: TMulBlock; var AIndex: TGenericIndex); +begin + FIndex.Position := CalculateIndexOffset(AID); + AIndex := TGenericIndex.Create(FIndex); + ABlock := GetData(AID, AIndex); + ABlock.OnChanged := @OnChanged; + ABlock.OnFinished := @OnFinished; +end; + +function TIndexedMulProvider.GetVarious(AID: Integer; ABlock: TMulBlock; + ADefault: Integer): Integer; +begin + Result := ADefault; +end; + +procedure TIndexedMulProvider.SetBlock(AID: Integer; ABlock: TMulBlock); +var + genericIndex: TGenericIndex; +begin + if FReadOnly then Exit; + FIndex.Position := CalculateIndexOffset(AID); + genericIndex := TGenericIndex.Create(FIndex); + SetData(AID, genericIndex, ABlock); + FIndex.Position := CalculateIndexOffset(AID); + genericIndex.Various := GetVarious(AID, ABlock, genericIndex.Various); + genericIndex.Write(FIndex); + genericIndex.Free; +end; + +procedure TIndexedMulProvider.SetData(AID: Integer; AIndex: TGenericIndex; + ABlock: TMulBlock); +var + size: Integer; +begin + if FReadOnly then Exit; + size := ABlock.GetSize; + if size = 0 then + begin + AIndex.Lookup := -1; + AIndex.Various := -1; + end else if (size > AIndex.Size) or (AIndex.Lookup < 0) then + begin + FData.Position := FData.Size; + AIndex.Lookup := FData.Position; + ABlock.Write(FData); + end else + begin + FData.Position := AIndex.Lookup; + ABlock.Write(FData); + end; + AIndex.Size := size; +end; + +end. + diff --git a/MulProvider/URadarProvider.pas b/MulProvider/URadarProvider.pas index a48c407..8f6c0e1 100644 --- a/MulProvider/URadarProvider.pas +++ b/MulProvider/URadarProvider.pas @@ -1,106 +1,106 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2009 Andreas Schneider - *) -unit URadarProvider; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes, UBufferedStreams; - -type - - { TRadarProvider } - - TRadarProvider = class - constructor Create; overload; virtual; - constructor Create(AData: TStream; AReadOnly: Boolean = False); overload; virtual; - constructor Create(AData: string; AReadOnly: Boolean = False); overload; virtual; - destructor Destroy; override; - protected - FData: TBufferedReader; - FReadOnly: Boolean; - public - function GetColor(AID: Integer): Word; - procedure SetColor(AID: Integer; AColor: Word); - end; - -implementation - -{ TRaderProvider } - -constructor TRadarProvider.Create; -begin - inherited Create; -end; - -constructor TRadarProvider.Create(AData: TStream; AReadOnly: Boolean); -begin - Create; - FData := TBufferedReader.Create(AData, False); - FReadOnly := AReadOnly; -end; - -constructor TRadarProvider.Create(AData: string; AReadOnly: Boolean); -var - mode: Word; -begin - Create; - if AReadOnly then - mode := fmOpenRead or fmShareDenyWrite - else - mode := fmOpenReadWrite or fmShareDenyWrite; - FData := TBufferedReader.Create(TFileStream.Create(AData, mode), True); - FReadOnly := AReadOnly; -end; - -destructor TRadarProvider.Destroy; -begin - FreeAndNil(FData); - inherited Destroy; -end; - -function TRadarProvider.GetColor(AID: Integer): Word; -begin - Result := 0; - if (AID >= 0) and (AID < $10000) then - begin - FData.Position := SizeOf(Word) * AID; - FData.Read(Result, SizeOf(Word)); - end; -end; - -procedure TRadarProvider.SetColor(AID: Integer; AColor: Word); -begin - if (not FReadOnly) and (AID >= 0) and (AID < $10000) then - begin - FData.Position := SizeOf(Word) * AID; - FData.Write(AColor, SizeOf(Word)); - end; -end; - -end. +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2009 Andreas Schneider + *) +unit URadarProvider; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Classes, UBufferedStreams; + +type + + { TRadarProvider } + + TRadarProvider = class + constructor Create; overload; virtual; + constructor Create(AData: TStream; AReadOnly: Boolean = False); overload; virtual; + constructor Create(AData: string; AReadOnly: Boolean = False); overload; virtual; + destructor Destroy; override; + protected + FData: TBufferedReader; + FReadOnly: Boolean; + public + function GetColor(AID: Integer): Word; + procedure SetColor(AID: Integer; AColor: Word); + end; + +implementation + +{ TRaderProvider } + +constructor TRadarProvider.Create; +begin + inherited Create; +end; + +constructor TRadarProvider.Create(AData: TStream; AReadOnly: Boolean); +begin + Create; + FData := TBufferedReader.Create(AData, False); + FReadOnly := AReadOnly; +end; + +constructor TRadarProvider.Create(AData: string; AReadOnly: Boolean); +var + mode: Word; +begin + Create; + if AReadOnly then + mode := fmOpenRead or fmShareDenyWrite + else + mode := fmOpenReadWrite or fmShareDenyWrite; + FData := TBufferedReader.Create(TFileStream.Create(AData, mode), True); + FReadOnly := AReadOnly; +end; + +destructor TRadarProvider.Destroy; +begin + FreeAndNil(FData); + inherited Destroy; +end; + +function TRadarProvider.GetColor(AID: Integer): Word; +begin + Result := 0; + if (AID >= 0) and (AID < $10000) then + begin + FData.Position := SizeOf(Word) * AID; + FData.Read(Result, SizeOf(Word)); + end; +end; + +procedure TRadarProvider.SetColor(AID: Integer; AColor: Word); +begin + if (not FReadOnly) and (AID >= 0) and (AID < $10000) then + begin + FData.Position := SizeOf(Word) * AID; + FData.Write(AColor, SizeOf(Word)); + end; +end; + +end. diff --git a/MulProvider/UTileDataProvider.pas b/MulProvider/UTileDataProvider.pas index 00cafce..99f8f50 100644 --- a/MulProvider/UTileDataProvider.pas +++ b/MulProvider/UTileDataProvider.pas @@ -1,171 +1,171 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2009 Andreas Schneider - *) -unit UTileDataProvider; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes, UMulProvider, UMulBlock, UTiledata; - -type - TLandTileDataArray = array[$0..$3FFF] of TLandTileData; - TStaticTileDataArray = array of TStaticTileData; - - { TTiledataProvider } - - TTiledataProvider = class(TMulProvider) - constructor Create(AData: TStream; AReadOnly: Boolean = False); overload; override; - constructor Create(AData: string; AReadOnly: Boolean = False); overload; override; - destructor Destroy; override; - protected - FLandTiles: TLandTileDataArray; - FStaticTiles: TStaticTileDataArray; - FStaticCount: Cardinal; - procedure InitArray; - function CalculateOffset(AID: Integer): Integer; override; - function GetData(AID, AOffset: Integer): TMulBlock; override; - procedure SetData(AID, AOffset: Integer; ABlock: TMulBlock); override; - function GetTileData(AID: Integer): TTiledata; - public - function GetBlock(AID: Integer): TMulBlock; override; - property LandTiles: TLandTileDataArray read FLandTiles; - property StaticTiles: TStaticTileDataArray read FStaticTiles; - property TileData[AID: Integer]: TTiledata read GetTileData; //all tiles, no cloning - property StaticCount: Cardinal read FStaticCount; - end; - -implementation - -uses - Logging; - -{ TTiledataProvider } - -function TTiledataProvider.CalculateOffset(AID: Integer): Integer; -begin - Result := GetTileDataOffset(AID); -end; - -constructor TTiledataProvider.Create(AData: TStream; AReadOnly: Boolean = False); -begin - inherited; - InitArray; -end; - -constructor TTiledataProvider.Create(AData: string; AReadOnly: Boolean = False); -begin - inherited; - InitArray; -end; - -destructor TTiledataProvider.Destroy; -var - i: Integer; -begin - for i := $0 to $3FFF do - FreeAndNil(FLandTiles[i]); - for i := 0 to FStaticCount - 1 do - FreeAndNil(FStaticTiles[i]); - - inherited Destroy; -end; - -function TTiledataProvider.GetBlock(AID: Integer): TMulBlock; -begin - Result := GetData(AID, 0); -end; - -function TTiledataProvider.GetData(AID, AOffset: Integer): TMulBlock; -begin - if AID < $4000 then - Result := TMulBlock(FLandTiles[AID].Clone) - else - Result := TMulBlock(FStaticTiles[AID - $4000].Clone); - Result.ID := AID; - Result.OnChanged := @OnChanged; - Result.OnFinished := @OnFinished; -end; - -procedure TTiledataProvider.InitArray; -var - i: Integer; -begin - FData.Position := 0; - Logger.Send([lcInfo], 'Loading $4000 LandTiledata Entries'); - for i := $0 to $3FFF do - begin - if i mod 32 = 0 then - FData.Seek(4, soFromCurrent); - FLandTiles[i] := TLandTileData.Create(FData); - end; - - FStaticCount := ((FData.Size - FData.Position) div StaticTileGroupSize) * 32; - Logger.Send([lcInfo], 'Loading $%x StaticTiledata Entries', [FStaticCount]); - SetLength(FStaticTiles, FStaticCount); - - for i := 0 to FStaticCount - 1 do - begin - if i mod 32 = 0 then - FData.Seek(4, soFromCurrent); - FStaticTiles[i] := TStaticTileData.Create(FData); - end; -end; - -procedure TTiledataProvider.SetData(AID, AOffset: Integer; - ABlock: TMulBlock); -begin - if AID >= $4000 + FStaticCount then - Exit; - - if AID < $4000 then - begin - FreeAndNil(FLandTiles[AID]); - FLandTiles[AID] := TLandTileData(ABlock.Clone); - end else - begin - FreeAndNil(FStaticTiles[AID - $4000]); - FStaticTiles[AID - $4000] := TStaticTileData(ABlock.Clone); - end; - - if not FReadOnly then - begin - FData.Position := AOffset; - ABlock.Write(FData); - end; -end; - -function TTiledataProvider.GetTileData(AID: Integer): TTiledata; -begin - if AID < $4000 then - Result := FLandTiles[AID] - else - Result := FStaticTiles[AID - $4000]; -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2009 Andreas Schneider + *) +unit UTileDataProvider; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Classes, UMulProvider, UMulBlock, UTiledata; + +type + TLandTileDataArray = array[$0..$3FFF] of TLandTileData; + TStaticTileDataArray = array of TStaticTileData; + + { TTiledataProvider } + + TTiledataProvider = class(TMulProvider) + constructor Create(AData: TStream; AReadOnly: Boolean = False); overload; override; + constructor Create(AData: string; AReadOnly: Boolean = False); overload; override; + destructor Destroy; override; + protected + FLandTiles: TLandTileDataArray; + FStaticTiles: TStaticTileDataArray; + FStaticCount: Cardinal; + procedure InitArray; + function CalculateOffset(AID: Integer): Integer; override; + function GetData(AID, AOffset: Integer): TMulBlock; override; + procedure SetData(AID, AOffset: Integer; ABlock: TMulBlock); override; + function GetTileData(AID: Integer): TTiledata; + public + function GetBlock(AID: Integer): TMulBlock; override; + property LandTiles: TLandTileDataArray read FLandTiles; + property StaticTiles: TStaticTileDataArray read FStaticTiles; + property TileData[AID: Integer]: TTiledata read GetTileData; //all tiles, no cloning + property StaticCount: Cardinal read FStaticCount; + end; + +implementation + +uses + Logging; + +{ TTiledataProvider } + +function TTiledataProvider.CalculateOffset(AID: Integer): Integer; +begin + Result := GetTileDataOffset(AID); +end; + +constructor TTiledataProvider.Create(AData: TStream; AReadOnly: Boolean = False); +begin + inherited; + InitArray; +end; + +constructor TTiledataProvider.Create(AData: string; AReadOnly: Boolean = False); +begin + inherited; + InitArray; +end; + +destructor TTiledataProvider.Destroy; +var + i: Integer; +begin + for i := $0 to $3FFF do + FreeAndNil(FLandTiles[i]); + for i := 0 to FStaticCount - 1 do + FreeAndNil(FStaticTiles[i]); + + inherited Destroy; +end; + +function TTiledataProvider.GetBlock(AID: Integer): TMulBlock; +begin + Result := GetData(AID, 0); +end; + +function TTiledataProvider.GetData(AID, AOffset: Integer): TMulBlock; +begin + if AID < $4000 then + Result := TMulBlock(FLandTiles[AID].Clone) + else + Result := TMulBlock(FStaticTiles[AID - $4000].Clone); + Result.ID := AID; + Result.OnChanged := @OnChanged; + Result.OnFinished := @OnFinished; +end; + +procedure TTiledataProvider.InitArray; +var + i: Integer; +begin + FData.Position := 0; + Logger.Send([lcInfo], 'Loading $4000 LandTiledata Entries'); + for i := $0 to $3FFF do + begin + if i mod 32 = 0 then + FData.Seek(4, soFromCurrent); + FLandTiles[i] := TLandTileData.Create(FData); + end; + + FStaticCount := ((FData.Size - FData.Position) div StaticTileGroupSize) * 32; + Logger.Send([lcInfo], 'Loading $%x StaticTiledata Entries', [FStaticCount]); + SetLength(FStaticTiles, FStaticCount); + + for i := 0 to FStaticCount - 1 do + begin + if i mod 32 = 0 then + FData.Seek(4, soFromCurrent); + FStaticTiles[i] := TStaticTileData.Create(FData); + end; +end; + +procedure TTiledataProvider.SetData(AID, AOffset: Integer; + ABlock: TMulBlock); +begin + if AID >= $4000 + FStaticCount then + Exit; + + if AID < $4000 then + begin + FreeAndNil(FLandTiles[AID]); + FLandTiles[AID] := TLandTileData(ABlock.Clone); + end else + begin + FreeAndNil(FStaticTiles[AID - $4000]); + FStaticTiles[AID - $4000] := TStaticTileData(ABlock.Clone); + end; + + if not FReadOnly then + begin + FData.Position := AOffset; + ABlock.Write(FData); + end; +end; + +function TTiledataProvider.GetTileData(AID: Integer): TTiledata; +begin + if AID < $4000 then + Result := FLandTiles[AID] + else + Result := FStaticTiles[AID - $4000]; +end; + +end. + diff --git a/ResourceBuilder.pas b/ResourceBuilder.pas index 790c9ca..3ada35b 100644 --- a/ResourceBuilder.pas +++ b/ResourceBuilder.pas @@ -1,69 +1,69 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2007 Andreas Schneider - *) -program ResourceBuilder; - -{$mode objfpc}{$H+} - -uses - SysUtils, Classes; - -var - fileList: TStringList; - infile, outfile: TFileStream; - i, count: Integer; - size: Cardinal; - lookupTable: array of Cardinal; - -begin - if ParamCount <> 2 then - begin - writeln('Usage: ResourceBuilder '); - halt; - end; - - fileList := TStringList.Create; - fileList.LoadFromFile(ParamStr(1)); - outfile := TFileStream.Create(ParamStr(2), fmCreate); - count := fileList.Count; - outfile.Write(count, SizeOf(Integer)); - SetLength(lookupTable, count); - outfile.Write(lookupTable[0], count * SizeOf(Cardinal)); - for i := 0 to count - 1 do - begin - lookupTable[i] := outfile.Position; - writeln(i, ': ', fileList.Strings[i]); - infile := TFileStream.Create(fileList.Strings[i], fmOpenRead); - infile.Position := 0; - size := infile.Size; - outfile.Write(size, SizeOf(Cardinal)); - outfile.CopyFrom(infile, infile.Size); - infile.Free; - end; - outfile.Position := SizeOf(Integer); - outfile.Write(lookupTable[0], count * SizeOf(Cardinal)); - outfile.Free; - fileList.Free; -end. +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2007 Andreas Schneider + *) +program ResourceBuilder; + +{$mode objfpc}{$H+} + +uses + SysUtils, Classes; + +var + fileList: TStringList; + infile, outfile: TFileStream; + i, count: Integer; + size: Cardinal; + lookupTable: array of Cardinal; + +begin + if ParamCount <> 2 then + begin + writeln('Usage: ResourceBuilder '); + halt; + end; + + fileList := TStringList.Create; + fileList.LoadFromFile(ParamStr(1)); + outfile := TFileStream.Create(ParamStr(2), fmCreate); + count := fileList.Count; + outfile.Write(count, SizeOf(Integer)); + SetLength(lookupTable, count); + outfile.Write(lookupTable[0], count * SizeOf(Cardinal)); + for i := 0 to count - 1 do + begin + lookupTable[i] := outfile.Position; + writeln(i, ': ', fileList.Strings[i]); + infile := TFileStream.Create(fileList.Strings[i], fmOpenRead); + infile.Position := 0; + size := infile.Size; + outfile.Write(size, SizeOf(Cardinal)); + outfile.CopyFrom(infile, infile.Size); + infile.Free; + end; + outfile.Position := SizeOf(Integer); + outfile.Write(lookupTable[0], count * SizeOf(Cardinal)); + outfile.Free; + fileList.Free; +end. diff --git a/Server/UNetState.pas b/Server/UNetState.pas index dc74409..4ab95ed 100644 --- a/Server/UNetState.pas +++ b/Server/UNetState.pas @@ -1,89 +1,89 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2007 Andreas Schneider - *) -unit UNetState; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, lNet, UEnhancedMemoryStream, UAccount, ULinkedList; - -type - - { TNetState } - - TNetState = class(TObject) - constructor Create(ASocket: TLSocket); - destructor Destroy; override; - protected - FSocket: TLSocket; - FSendQueue: TEnhancedMemoryStream; - FReceiveQueue: TEnhancedMemoryStream; - FAccount: TAccount; - FSubscriptions: TList; - FLastAction: TDateTime; - public - property Socket: TLSocket read FSocket; - property SendQueue: TEnhancedMemoryStream read FSendQueue; - property ReceiveQueue: TEnhancedMemoryStream read FReceiveQueue; - property Account: TAccount read FAccount write FAccount; - property Subscriptions: TList read FSubscriptions; - property LastAction: TDateTime read FLastAction write FLastAction; - end; - -implementation - -{ TNetState } - -constructor TNetState.Create(ASocket: TLSocket); -begin - inherited Create; - FSocket := ASocket; - FSendQueue := TEnhancedMemoryStream.Create; - FReceiveQueue := TEnhancedMemoryStream.Create; - FAccount := nil; - FSubscriptions := TList.Create; - FLastAction := Now; -end; - -destructor TNetState.Destroy; -var - i: Integer; -begin - if FSendQueue <> nil then FreeAndNil(FSendQueue); - if FReceiveQueue <> nil then FreeAndNil(FReceiveQueue); - if FSubscriptions <> nil then - begin - for i := 0 to FSubscriptions.Count - 1 do - TLinkedList(FSubscriptions.Items[i]).Delete(Self); - FreeAndNil(FSubscriptions); - end; - inherited Destroy; -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2007 Andreas Schneider + *) +unit UNetState; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, lNet, UEnhancedMemoryStream, UAccount, ULinkedList; + +type + + { TNetState } + + TNetState = class(TObject) + constructor Create(ASocket: TLSocket); + destructor Destroy; override; + protected + FSocket: TLSocket; + FSendQueue: TEnhancedMemoryStream; + FReceiveQueue: TEnhancedMemoryStream; + FAccount: TAccount; + FSubscriptions: TList; + FLastAction: TDateTime; + public + property Socket: TLSocket read FSocket; + property SendQueue: TEnhancedMemoryStream read FSendQueue; + property ReceiveQueue: TEnhancedMemoryStream read FReceiveQueue; + property Account: TAccount read FAccount write FAccount; + property Subscriptions: TList read FSubscriptions; + property LastAction: TDateTime read FLastAction write FLastAction; + end; + +implementation + +{ TNetState } + +constructor TNetState.Create(ASocket: TLSocket); +begin + inherited Create; + FSocket := ASocket; + FSendQueue := TEnhancedMemoryStream.Create; + FReceiveQueue := TEnhancedMemoryStream.Create; + FAccount := nil; + FSubscriptions := TList.Create; + FLastAction := Now; +end; + +destructor TNetState.Destroy; +var + i: Integer; +begin + if FSendQueue <> nil then FreeAndNil(FSendQueue); + if FReceiveQueue <> nil then FreeAndNil(FReceiveQueue); + if FSubscriptions <> nil then + begin + for i := 0 to FSubscriptions.Count - 1 do + TLinkedList(FSubscriptions.Items[i]).Delete(Self); + FreeAndNil(FSubscriptions); + end; + inherited Destroy; +end; + +end. + diff --git a/Server/UPacketHandlers.pas b/Server/UPacketHandlers.pas index 917c56c..e27f85c 100644 --- a/Server/UPacketHandlers.pas +++ b/Server/UPacketHandlers.pas @@ -1,218 +1,218 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2007 Andreas Schneider - *) -unit UPacketHandlers; - -interface - -uses - Classes, SysUtils, dzlib, UConfig, UNetState, UEnhancedMemoryStream, UEnums, - ULinkedList, URegions; - -type - TPacketProcessor = procedure(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); - TPacketProcessorMethod = procedure(ABuffer: TEnhancedMemoryStream; ANetState: TNetState) of object; - - { TPacketHandler } - - TPacketHandler = class(TObject) - constructor Create(ALength: Cardinal; APacketProcessor: TPacketProcessor); overload; - constructor Create(ALength: Cardinal; APacketProcessorMethod: TPacketProcessorMethod); overload; - procedure Process(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); - protected - FLength: Cardinal; - FPacketProcessor: TPacketProcessor; - FPacketProcessorMethod: TPacketProcessorMethod; - published - property PacketLength: Cardinal read FLength; - end; - -var - PacketHandlers: array[0..$FF] of TPacketHandler; - -function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel): Boolean; overload; -function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel; AX, AY: Cardinal): Boolean; overload; -procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler); - -implementation - -uses - UCEDServer, UPackets, UConnectionHandling, UAdminHandling, UClientHandling; - -function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel): Boolean; -begin - Result := (ANetState.Account <> nil) and (ANetState.Account.AccessLevel >= ALevel); -end; - -function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel; AX, AY: Cardinal): Boolean; -var - i,j: Word; - region: TRegion; - rect: TRect; -begin - if not ValidateAccess(ANetState, ALevel) then Exit(False); - if (ANetState.Account.Regions.Count = 0) or - (ANetState.Account.AccessLevel >= alAdministrator) then Exit(True); //no restrictions - - Result := False; - for i := 0 to ANetState.Account.Regions.Count - 1 do - begin - region := Config.Regions.Find(ANetState.Account.Regions[i]); - if region <> nil then - begin - for j := 0 to region.Areas.Count - 1 do - begin - rect := region.Areas.Rects[j]; - if (AX >= rect.Left) and - (AX < rect.Right) and - (AY >= rect.Top) and - (AY < rect.Bottom) then - Exit(True); - end; - end; - end; -end; - -procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler); -begin - if Assigned(PacketHandlers[AID]) then FreeAndNil(PacketHandlers[AID]); - PacketHandlers[AID] := APacketHandler; -end; - -{ TPacketHandler } - -constructor TPacketHandler.Create(ALength: Cardinal; APacketProcessor: TPacketProcessor); -begin - inherited Create; - FLength := ALength; - FPacketProcessor := APacketProcessor; - FPacketProcessorMethod := nil; -end; - -constructor TPacketHandler.Create(ALength: Cardinal; - APacketProcessorMethod: TPacketProcessorMethod); -begin - inherited Create; - FLength := ALength; - FPacketProcessor := nil; - FPacketProcessorMethod := APacketProcessorMethod; -end; - -procedure TPacketHandler.Process(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); -begin - if Assigned(FPacketProcessor) then - FPacketProcessor(ABuffer, ANetState) - else if Assigned(FPacketProcessorMethod) then - FPacketProcessorMethod(ABuffer, ANetState); -end; - -procedure OnCompressedPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); -var - uncompStream: TEnhancedMemoryStream; - uncompBuffer: TDecompressionStream; - targetSize: Cardinal; - packetID: Byte; -begin - targetSize := ABuffer.ReadCardinal; - uncompBuffer := TDecompressionStream.Create(ABuffer); - uncompStream := TEnhancedMemoryStream.Create; - try - uncompStream.CopyFrom(uncompBuffer, targetSize); - uncompStream.Position := 0; - packetID := uncompStream.ReadByte; - if PacketHandlers[packetID] <> nil then - begin - if PacketHandlers[PacketID].PacketLength = 0 then - uncompStream.Position := uncompStream.Position + 4; - uncompStream.Lock(uncompStream.Position, uncompStream.Size - uncompStream.Position); - PacketHandlers[PacketID].Process(uncompStream, ANetState); - uncompStream.Unlock; - end else - begin - Writeln(TimeStamp, 'Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress); - ANetState.ReceiveQueue.Clear; - CEDServerInstance.Disconnect(ANetState.Socket); - end; - finally - if uncompBuffer <> nil then uncompBuffer.Free; - if uncompStream <> nil then uncompStream.Free; - end; -end; - -procedure OnRequestBlocksPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); -var - coords: TBlockCoordsArray; -begin - if not ValidateAccess(ANetState, alView) then Exit; - SetLength(coords, (ABuffer.Size - ABuffer.Position) div SizeOf(TBlockCoords)); - ABuffer.Read(coords[0], Length(coords) * SizeOf(TBlockCoords)); - CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(TBlockPacket.Create(coords, ANetState))); -end; - -procedure OnFreeBlockPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); -var - x, y: Word; - blockSubscriptions: TLinkedList; -begin - if not ValidateAccess(ANetState, alView) then Exit; - x := ABuffer.ReadWord; - y := ABuffer.ReadWord; - blockSubscriptions := CEDServerInstance.Landscape.BlockSubscriptions[X, Y]; - if blockSubscriptions <> nil then - begin - blockSubscriptions.Delete(ANetState); - ANetState.Subscriptions.Remove(blockSubscriptions); - end; -end; - -procedure OnNoOpPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); -begin - //no operation -end; - -{$WARNINGS OFF} -var - i: Integer; - -initialization - for i := 0 to $FF do - PacketHandlers[i] := nil; - PacketHandlers[$01] := TPacketHandler.Create(0, @OnCompressedPacket); - PacketHandlers[$02] := TPacketHandler.Create(0, @OnConnectionHandlerPacket); - PacketHandlers[$03] := TPacketHandler.Create(0, @OnAdminHandlerPacket); - PacketHandlers[$04] := TPacketHandler.Create(0, @OnRequestBlocksPacket); - PacketHandlers[$05] := TPacketHandler.Create(5, @OnFreeBlockPacket); - //$06-$0B handled by landscape - PacketHandlers[$0C] := TPacketHandler.Create(0, @OnClientHandlerPacket); - //$0D handled by radarmap - //$0E handled by landscape - PacketHandlers[$FF] := TPacketHandler.Create(1, @OnNoOpPacket); -finalization - for i := 0 to $FF do - if PacketHandlers[i] <> nil then - PacketHandlers[i].Free; -{$WARNINGS ON} -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2007 Andreas Schneider + *) +unit UPacketHandlers; + +interface + +uses + Classes, SysUtils, dzlib, UConfig, UNetState, UEnhancedMemoryStream, UEnums, + ULinkedList, URegions; + +type + TPacketProcessor = procedure(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); + TPacketProcessorMethod = procedure(ABuffer: TEnhancedMemoryStream; ANetState: TNetState) of object; + + { TPacketHandler } + + TPacketHandler = class(TObject) + constructor Create(ALength: Cardinal; APacketProcessor: TPacketProcessor); overload; + constructor Create(ALength: Cardinal; APacketProcessorMethod: TPacketProcessorMethod); overload; + procedure Process(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); + protected + FLength: Cardinal; + FPacketProcessor: TPacketProcessor; + FPacketProcessorMethod: TPacketProcessorMethod; + published + property PacketLength: Cardinal read FLength; + end; + +var + PacketHandlers: array[0..$FF] of TPacketHandler; + +function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel): Boolean; overload; +function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel; AX, AY: Cardinal): Boolean; overload; +procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler); + +implementation + +uses + UCEDServer, UPackets, UConnectionHandling, UAdminHandling, UClientHandling; + +function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel): Boolean; +begin + Result := (ANetState.Account <> nil) and (ANetState.Account.AccessLevel >= ALevel); +end; + +function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel; AX, AY: Cardinal): Boolean; +var + i,j: Word; + region: TRegion; + rect: TRect; +begin + if not ValidateAccess(ANetState, ALevel) then Exit(False); + if (ANetState.Account.Regions.Count = 0) or + (ANetState.Account.AccessLevel >= alAdministrator) then Exit(True); //no restrictions + + Result := False; + for i := 0 to ANetState.Account.Regions.Count - 1 do + begin + region := Config.Regions.Find(ANetState.Account.Regions[i]); + if region <> nil then + begin + for j := 0 to region.Areas.Count - 1 do + begin + rect := region.Areas.Rects[j]; + if (AX >= rect.Left) and + (AX < rect.Right) and + (AY >= rect.Top) and + (AY < rect.Bottom) then + Exit(True); + end; + end; + end; +end; + +procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler); +begin + if Assigned(PacketHandlers[AID]) then FreeAndNil(PacketHandlers[AID]); + PacketHandlers[AID] := APacketHandler; +end; + +{ TPacketHandler } + +constructor TPacketHandler.Create(ALength: Cardinal; APacketProcessor: TPacketProcessor); +begin + inherited Create; + FLength := ALength; + FPacketProcessor := APacketProcessor; + FPacketProcessorMethod := nil; +end; + +constructor TPacketHandler.Create(ALength: Cardinal; + APacketProcessorMethod: TPacketProcessorMethod); +begin + inherited Create; + FLength := ALength; + FPacketProcessor := nil; + FPacketProcessorMethod := APacketProcessorMethod; +end; + +procedure TPacketHandler.Process(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); +begin + if Assigned(FPacketProcessor) then + FPacketProcessor(ABuffer, ANetState) + else if Assigned(FPacketProcessorMethod) then + FPacketProcessorMethod(ABuffer, ANetState); +end; + +procedure OnCompressedPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); +var + uncompStream: TEnhancedMemoryStream; + uncompBuffer: TDecompressionStream; + targetSize: Cardinal; + packetID: Byte; +begin + targetSize := ABuffer.ReadCardinal; + uncompBuffer := TDecompressionStream.Create(ABuffer); + uncompStream := TEnhancedMemoryStream.Create; + try + uncompStream.CopyFrom(uncompBuffer, targetSize); + uncompStream.Position := 0; + packetID := uncompStream.ReadByte; + if PacketHandlers[packetID] <> nil then + begin + if PacketHandlers[PacketID].PacketLength = 0 then + uncompStream.Position := uncompStream.Position + 4; + uncompStream.Lock(uncompStream.Position, uncompStream.Size - uncompStream.Position); + PacketHandlers[PacketID].Process(uncompStream, ANetState); + uncompStream.Unlock; + end else + begin + Writeln(TimeStamp, 'Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress); + ANetState.ReceiveQueue.Clear; + CEDServerInstance.Disconnect(ANetState.Socket); + end; + finally + if uncompBuffer <> nil then uncompBuffer.Free; + if uncompStream <> nil then uncompStream.Free; + end; +end; + +procedure OnRequestBlocksPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); +var + coords: TBlockCoordsArray; +begin + if not ValidateAccess(ANetState, alView) then Exit; + SetLength(coords, (ABuffer.Size - ABuffer.Position) div SizeOf(TBlockCoords)); + ABuffer.Read(coords[0], Length(coords) * SizeOf(TBlockCoords)); + CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(TBlockPacket.Create(coords, ANetState))); +end; + +procedure OnFreeBlockPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); +var + x, y: Word; + blockSubscriptions: TLinkedList; +begin + if not ValidateAccess(ANetState, alView) then Exit; + x := ABuffer.ReadWord; + y := ABuffer.ReadWord; + blockSubscriptions := CEDServerInstance.Landscape.BlockSubscriptions[X, Y]; + if blockSubscriptions <> nil then + begin + blockSubscriptions.Delete(ANetState); + ANetState.Subscriptions.Remove(blockSubscriptions); + end; +end; + +procedure OnNoOpPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); +begin + //no operation +end; + +{$WARNINGS OFF} +var + i: Integer; + +initialization + for i := 0 to $FF do + PacketHandlers[i] := nil; + PacketHandlers[$01] := TPacketHandler.Create(0, @OnCompressedPacket); + PacketHandlers[$02] := TPacketHandler.Create(0, @OnConnectionHandlerPacket); + PacketHandlers[$03] := TPacketHandler.Create(0, @OnAdminHandlerPacket); + PacketHandlers[$04] := TPacketHandler.Create(0, @OnRequestBlocksPacket); + PacketHandlers[$05] := TPacketHandler.Create(5, @OnFreeBlockPacket); + //$06-$0B handled by landscape + PacketHandlers[$0C] := TPacketHandler.Create(0, @OnClientHandlerPacket); + //$0D handled by radarmap + //$0E handled by landscape + PacketHandlers[$FF] := TPacketHandler.Create(1, @OnNoOpPacket); +finalization + for i := 0 to $FF do + if PacketHandlers[i] <> nil then + PacketHandlers[i].Free; +{$WARNINGS ON} +end. + diff --git a/Server/UPackets.pas b/Server/UPackets.pas index 3601355..48f401a 100644 --- a/Server/UPackets.pas +++ b/Server/UPackets.pas @@ -1,226 +1,226 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2007 Andreas Schneider - *) -unit UPackets; - -interface - -uses - Classes, dzlib, UEnhancedMemoryStream, UPacket, UMap, UStatics, ULinkedList, - UNetState; - -type - TBlockCoords = packed record - X: Word; - Y: Word; - end; - TBlockCoordsArray = array of TBlockCoords; - - { TCompressedPacket } - - TCompressedPacket = class(TPacket) - constructor Create(APacket: TPacket); - end; - - { TSendBlocksPacket } - - TBlockPacket = class(TPacket) - constructor Create(ACoords: TBlockCoordsArray; ANetState: TNetState); - end; - - { TDrawMapPacket } - - TDrawMapPacket = class(TPacket) - constructor Create(AMapCell: TMapCell); - end; - - { TInsertStaticPacket } - - TInsertStaticPacket = class(TPacket) - constructor Create(AStaticItem: TStaticItem); - end; - - { TDeleteStaticPacket } - - TDeleteStaticPacket = class(TPacket) - constructor Create(AStaticItem: TStaticItem); - end; - - { TElevateStaticPacket } - - TElevateStaticPacket = class(TPacket) - constructor Create(AStaticItem: TStaticItem; ANewZ: ShortInt); - end; - - { TMoveStaticPacket } - - TMoveStaticPacket = class(TPacket) - constructor Create(AStaticItem: TStaticItem; ANewX, ANewY: Word); - end; - - { THueStaticPacket } - - THueStaticPacket = class(TPacket) - constructor Create(AStaticItem: TStaticItem; ANewHue: Word); - end; - -implementation - -uses - UCEDServer; - -{ TCompressedPacket } - -constructor TCompressedPacket.Create(APacket: TPacket); -var - compBuffer: TEnhancedMemoryStream; - compStream: TCompressionStream; - sourceStream: TEnhancedMemoryStream; -begin - inherited Create($01, 0); - sourceStream := APacket.Stream; - compBuffer := TEnhancedMemoryStream.Create; - compStream := TCompressionStream.Create(clMax, compBuffer); - compStream.CopyFrom(sourceStream, 0); - compStream.Free; - FStream.WriteCardinal(sourceStream.Size); - FStream.CopyFrom(compBuffer, 0); - compBuffer.Free; - APacket.Free; -end; - -{ TBlockPacket } - -constructor TBlockPacket.Create(ACoords: TBlockCoordsArray; ANetState: TNetState); -var - i: Integer; - mapBlock: TMapBlock; - staticsBlock: TStaticBlock; - subscriptions: TLinkedList; -begin - inherited Create($04, 0); - for i := Low(ACoords) to High(ACoords) do - begin - mapBlock := CEDServerInstance.Landscape.GetMapBlock(ACoords[i].X, ACoords[i].Y); - if mapBlock = nil then Continue; - mapBlock.GetSize; - staticsBlock := CEDServerInstance.Landscape.GetStaticBlock(ACoords[i].X, ACoords[i].Y); - if staticsBlock = nil then Continue; - staticsBlock.GetSize; - - FStream.Write(ACoords[i], SizeOf(TBlockCoords)); - mapBlock.Write(FStream); - FStream.WriteWord(staticsBlock.Items.Count); - staticsBlock.Write(FStream); - - if ANetState <> nil then - begin - subscriptions := CEDServerInstance.Landscape.BlockSubscriptions[ACoords[i].X, ACoords[i].Y]; - subscriptions.Delete(ANetState); - subscriptions.Add(Integer(ANetState), ANetState); - if ANetState.Subscriptions.IndexOf(subscriptions) = -1 then - ANetState.Subscriptions.Add(subscriptions); - end; - end; -end; - -{ TDrawMapPacket } - -constructor TDrawMapPacket.Create(AMapCell: TMapCell); -begin - inherited Create($06, 8); - FStream.WriteWord(AMapCell.X); - FStream.WriteWord(AMapCell.Y); - FStream.WriteShortInt(AMapCell.Altitude); - FStream.WriteWord(AMapCell.TileID); -end; - -{ TInsertStaticPacket } - -constructor TInsertStaticPacket.Create(AStaticItem: TStaticItem); -begin - inherited Create($07, 10); - FStream.WriteWord(AStaticItem.X); - FStream.WriteWord(AStaticItem.Y); - FStream.WriteShortInt(AStaticItem.Z); - FStream.WriteWord(AStaticItem.TileID); - FStream.WriteWord(AStaticItem.Hue); -end; - -{ TDeleteStaticPacket } - -constructor TDeleteStaticPacket.Create(AStaticItem: TStaticItem); -begin - inherited Create($08, 10); - FStream.WriteWord(AStaticItem.X); - FStream.WriteWord(AStaticItem.Y); - FStream.WriteShortInt(AStaticItem.Z); - FStream.WriteWord(AStaticItem.TileID); - FStream.WriteWord(AStaticItem.Hue); -end; - -{ TElevateStaticPacket } - -constructor TElevateStaticPacket.Create(AStaticItem: TStaticItem; ANewZ: ShortInt); -begin - inherited Create($09, 11); - FStream.WriteWord(AStaticItem.X); - FStream.WriteWord(AStaticItem.Y); - FStream.WriteShortInt(AStaticItem.Z); - FStream.WriteWord(AStaticItem.TileID); - FStream.WriteWord(AStaticItem.Hue); - FStream.WriteShortInt(ANewZ); -end; - -{ TMoveStaticPacket } - -constructor TMoveStaticPacket.Create(AStaticItem: TStaticItem; ANewX, - ANewY: Word); -begin - inherited Create($0A, 14); - FStream.WriteWord(AStaticItem.X); - FStream.WriteWord(AStaticItem.Y); - FStream.WriteShortInt(AStaticItem.Z); - FStream.WriteWord(AStaticItem.TileID); - FStream.WriteWord(AStaticItem.Hue); - FStream.WriteWord(ANewX); - FStream.WriteWord(ANewY); -end; - -{ THueStaticPacket } - -constructor THueStaticPacket.Create(AStaticItem: TStaticItem; ANewHue: Word); -begin - inherited Create($0B, 12); - FStream.WriteWord(AStaticItem.X); - FStream.WriteWord(AStaticItem.Y); - FStream.WriteShortInt(AStaticItem.Z); - FStream.WriteWord(AStaticItem.TileID); - FStream.WriteWord(AStaticItem.Hue); - FStream.WriteWord(ANewHue); -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2007 Andreas Schneider + *) +unit UPackets; + +interface + +uses + Classes, dzlib, UEnhancedMemoryStream, UPacket, UMap, UStatics, ULinkedList, + UNetState; + +type + TBlockCoords = packed record + X: Word; + Y: Word; + end; + TBlockCoordsArray = array of TBlockCoords; + + { TCompressedPacket } + + TCompressedPacket = class(TPacket) + constructor Create(APacket: TPacket); + end; + + { TSendBlocksPacket } + + TBlockPacket = class(TPacket) + constructor Create(ACoords: TBlockCoordsArray; ANetState: TNetState); + end; + + { TDrawMapPacket } + + TDrawMapPacket = class(TPacket) + constructor Create(AMapCell: TMapCell); + end; + + { TInsertStaticPacket } + + TInsertStaticPacket = class(TPacket) + constructor Create(AStaticItem: TStaticItem); + end; + + { TDeleteStaticPacket } + + TDeleteStaticPacket = class(TPacket) + constructor Create(AStaticItem: TStaticItem); + end; + + { TElevateStaticPacket } + + TElevateStaticPacket = class(TPacket) + constructor Create(AStaticItem: TStaticItem; ANewZ: ShortInt); + end; + + { TMoveStaticPacket } + + TMoveStaticPacket = class(TPacket) + constructor Create(AStaticItem: TStaticItem; ANewX, ANewY: Word); + end; + + { THueStaticPacket } + + THueStaticPacket = class(TPacket) + constructor Create(AStaticItem: TStaticItem; ANewHue: Word); + end; + +implementation + +uses + UCEDServer; + +{ TCompressedPacket } + +constructor TCompressedPacket.Create(APacket: TPacket); +var + compBuffer: TEnhancedMemoryStream; + compStream: TCompressionStream; + sourceStream: TEnhancedMemoryStream; +begin + inherited Create($01, 0); + sourceStream := APacket.Stream; + compBuffer := TEnhancedMemoryStream.Create; + compStream := TCompressionStream.Create(clMax, compBuffer); + compStream.CopyFrom(sourceStream, 0); + compStream.Free; + FStream.WriteCardinal(sourceStream.Size); + FStream.CopyFrom(compBuffer, 0); + compBuffer.Free; + APacket.Free; +end; + +{ TBlockPacket } + +constructor TBlockPacket.Create(ACoords: TBlockCoordsArray; ANetState: TNetState); +var + i: Integer; + mapBlock: TMapBlock; + staticsBlock: TStaticBlock; + subscriptions: TLinkedList; +begin + inherited Create($04, 0); + for i := Low(ACoords) to High(ACoords) do + begin + mapBlock := CEDServerInstance.Landscape.GetMapBlock(ACoords[i].X, ACoords[i].Y); + if mapBlock = nil then Continue; + mapBlock.GetSize; + staticsBlock := CEDServerInstance.Landscape.GetStaticBlock(ACoords[i].X, ACoords[i].Y); + if staticsBlock = nil then Continue; + staticsBlock.GetSize; + + FStream.Write(ACoords[i], SizeOf(TBlockCoords)); + mapBlock.Write(FStream); + FStream.WriteWord(staticsBlock.Items.Count); + staticsBlock.Write(FStream); + + if ANetState <> nil then + begin + subscriptions := CEDServerInstance.Landscape.BlockSubscriptions[ACoords[i].X, ACoords[i].Y]; + subscriptions.Delete(ANetState); + subscriptions.Add(Integer(ANetState), ANetState); + if ANetState.Subscriptions.IndexOf(subscriptions) = -1 then + ANetState.Subscriptions.Add(subscriptions); + end; + end; +end; + +{ TDrawMapPacket } + +constructor TDrawMapPacket.Create(AMapCell: TMapCell); +begin + inherited Create($06, 8); + FStream.WriteWord(AMapCell.X); + FStream.WriteWord(AMapCell.Y); + FStream.WriteShortInt(AMapCell.Altitude); + FStream.WriteWord(AMapCell.TileID); +end; + +{ TInsertStaticPacket } + +constructor TInsertStaticPacket.Create(AStaticItem: TStaticItem); +begin + inherited Create($07, 10); + FStream.WriteWord(AStaticItem.X); + FStream.WriteWord(AStaticItem.Y); + FStream.WriteShortInt(AStaticItem.Z); + FStream.WriteWord(AStaticItem.TileID); + FStream.WriteWord(AStaticItem.Hue); +end; + +{ TDeleteStaticPacket } + +constructor TDeleteStaticPacket.Create(AStaticItem: TStaticItem); +begin + inherited Create($08, 10); + FStream.WriteWord(AStaticItem.X); + FStream.WriteWord(AStaticItem.Y); + FStream.WriteShortInt(AStaticItem.Z); + FStream.WriteWord(AStaticItem.TileID); + FStream.WriteWord(AStaticItem.Hue); +end; + +{ TElevateStaticPacket } + +constructor TElevateStaticPacket.Create(AStaticItem: TStaticItem; ANewZ: ShortInt); +begin + inherited Create($09, 11); + FStream.WriteWord(AStaticItem.X); + FStream.WriteWord(AStaticItem.Y); + FStream.WriteShortInt(AStaticItem.Z); + FStream.WriteWord(AStaticItem.TileID); + FStream.WriteWord(AStaticItem.Hue); + FStream.WriteShortInt(ANewZ); +end; + +{ TMoveStaticPacket } + +constructor TMoveStaticPacket.Create(AStaticItem: TStaticItem; ANewX, + ANewY: Word); +begin + inherited Create($0A, 14); + FStream.WriteWord(AStaticItem.X); + FStream.WriteWord(AStaticItem.Y); + FStream.WriteShortInt(AStaticItem.Z); + FStream.WriteWord(AStaticItem.TileID); + FStream.WriteWord(AStaticItem.Hue); + FStream.WriteWord(ANewX); + FStream.WriteWord(ANewY); +end; + +{ THueStaticPacket } + +constructor THueStaticPacket.Create(AStaticItem: TStaticItem; ANewHue: Word); +begin + inherited Create($0B, 12); + FStream.WriteWord(AStaticItem.X); + FStream.WriteWord(AStaticItem.Y); + FStream.WriteShortInt(AStaticItem.Z); + FStream.WriteWord(AStaticItem.TileID); + FStream.WriteWord(AStaticItem.Hue); + FStream.WriteWord(ANewHue); +end; + +end. + diff --git a/UBufferedStreams.pas b/UBufferedStreams.pas index 42875f0..7799b4f 100644 --- a/UBufferedStreams.pas +++ b/UBufferedStreams.pas @@ -1,144 +1,144 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2007 Andreas Schneider - *) -unit UBufferedStreams; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes, UEnhancedMemoryStream; - -type - - { TBufferedStream } - - TBufferedStream = class(TEnhancedMemoryStream) - constructor Create(ABaseStream: TStream; AOwnsBaseStream: Boolean = false); virtual; - destructor Destroy; override; - protected - FBaseStream: TStream; - FOwnsBaseStream: Boolean; - public - procedure Refresh; virtual; - procedure Flush; virtual; - function GetSize: Int64; override; - end; - TBufferedReader = class(TBufferedStream) - constructor Create(ABaseStream: TStream; AOwnsBaseStream: Boolean = false); override; - destructor Destroy; override; - protected - FReadBuffer: TEnhancedMemoryStream; - public - function Write(const Buffer; Count: Longint): Longint; override; - function Read(var Buffer; Count: Longint): Longint; override; - function Seek(Offset: Longint; Origin: Word): Longint; override; - procedure Refresh; override; - end; - -implementation - -{ TBufferedStream } - -constructor TBufferedStream.Create(ABaseStream: TStream; - AOwnsBaseStream: Boolean); -begin - inherited Create; - FBaseStream := ABaseStream; - FOwnsBaseStream := AOwnsBaseStream; - Refresh; -end; - -destructor TBufferedStream.Destroy; -begin - if FOwnsBaseStream and Assigned(FBaseStream) then - FreeAndNil(FBaseStream); - inherited; -end; - -procedure TBufferedStream.Flush; -begin - FBaseStream.Size := Size; - FBaseStream.Position := 0; - FBaseStream.CopyFrom(Self, 0); -end; - -function TBufferedStream.GetSize: Int64; -begin - Result := FBaseStream.Size; -end; - -procedure TBufferedStream.Refresh; -begin - Size := FBaseStream.Size; - Position := 0; - CopyFrom(FBaseStream, 0); -end; - -{ TBufferedReader } - -constructor TBufferedReader.Create(ABaseStream: TStream; - AOwnsBaseStream: Boolean); -begin - FReadBuffer := TEnhancedMemoryStream.Create; - inherited; -end; - -destructor TBufferedReader.Destroy; -begin - if Assigned(FReadBuffer) then FreeAndNil(FReadBuffer); - inherited; -end; - -function TBufferedReader.Read(var Buffer; Count: Integer): Longint; -begin - Result := FReadBuffer.Read(Buffer, Count); -end; - -procedure TBufferedReader.Refresh; -begin - FReadBuffer.Size := FBaseStream.Size; - FReadBuffer.Position := 0; - FReadBuffer.CopyFrom(FBaseStream, 0); - FReadBuffer.Position := 0; - FBaseStream.Position := 0; -end; - -function TBufferedReader.Seek(Offset: Integer; Origin: Word): Longint; -begin - FBaseStream.Seek(Offset, Origin); - Result := FReadBuffer.Seek(Offset, Origin); -end; - -function TBufferedReader.Write(const Buffer; Count: Integer): Longint; -begin - FBaseStream.Position := FReadBuffer.Position; - FBaseStream.Write(Buffer, Count); - Result := FReadBuffer.Write(Buffer, Count); -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2007 Andreas Schneider + *) +unit UBufferedStreams; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Classes, UEnhancedMemoryStream; + +type + + { TBufferedStream } + + TBufferedStream = class(TEnhancedMemoryStream) + constructor Create(ABaseStream: TStream; AOwnsBaseStream: Boolean = false); virtual; + destructor Destroy; override; + protected + FBaseStream: TStream; + FOwnsBaseStream: Boolean; + public + procedure Refresh; virtual; + procedure Flush; virtual; + function GetSize: Int64; override; + end; + TBufferedReader = class(TBufferedStream) + constructor Create(ABaseStream: TStream; AOwnsBaseStream: Boolean = false); override; + destructor Destroy; override; + protected + FReadBuffer: TEnhancedMemoryStream; + public + function Write(const Buffer; Count: Longint): Longint; override; + function Read(var Buffer; Count: Longint): Longint; override; + function Seek(Offset: Longint; Origin: Word): Longint; override; + procedure Refresh; override; + end; + +implementation + +{ TBufferedStream } + +constructor TBufferedStream.Create(ABaseStream: TStream; + AOwnsBaseStream: Boolean); +begin + inherited Create; + FBaseStream := ABaseStream; + FOwnsBaseStream := AOwnsBaseStream; + Refresh; +end; + +destructor TBufferedStream.Destroy; +begin + if FOwnsBaseStream and Assigned(FBaseStream) then + FreeAndNil(FBaseStream); + inherited; +end; + +procedure TBufferedStream.Flush; +begin + FBaseStream.Size := Size; + FBaseStream.Position := 0; + FBaseStream.CopyFrom(Self, 0); +end; + +function TBufferedStream.GetSize: Int64; +begin + Result := FBaseStream.Size; +end; + +procedure TBufferedStream.Refresh; +begin + Size := FBaseStream.Size; + Position := 0; + CopyFrom(FBaseStream, 0); +end; + +{ TBufferedReader } + +constructor TBufferedReader.Create(ABaseStream: TStream; + AOwnsBaseStream: Boolean); +begin + FReadBuffer := TEnhancedMemoryStream.Create; + inherited; +end; + +destructor TBufferedReader.Destroy; +begin + if Assigned(FReadBuffer) then FreeAndNil(FReadBuffer); + inherited; +end; + +function TBufferedReader.Read(var Buffer; Count: Integer): Longint; +begin + Result := FReadBuffer.Read(Buffer, Count); +end; + +procedure TBufferedReader.Refresh; +begin + FReadBuffer.Size := FBaseStream.Size; + FReadBuffer.Position := 0; + FReadBuffer.CopyFrom(FBaseStream, 0); + FReadBuffer.Position := 0; + FBaseStream.Position := 0; +end; + +function TBufferedReader.Seek(Offset: Integer; Origin: Word): Longint; +begin + FBaseStream.Seek(Offset, Origin); + Result := FReadBuffer.Seek(Offset, Origin); +end; + +function TBufferedReader.Write(const Buffer; Count: Integer): Longint; +begin + FBaseStream.Position := FReadBuffer.Position; + FBaseStream.Write(Buffer, Count); + Result := FReadBuffer.Write(Buffer, Count); +end; + +end. + diff --git a/UEnhancedMemoryStream.pas b/UEnhancedMemoryStream.pas index 195f39d..bb9a49d 100644 --- a/UEnhancedMemoryStream.pas +++ b/UEnhancedMemoryStream.pas @@ -1,254 +1,254 @@ - -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2007 Andreas Schneider - *) -unit UEnhancedMemoryStream; - -{$mode delphi}{$H+} - -interface - -uses - Classes, UStreamHelper; - -type - - { TEnhancedMemoryStream } - - TEnhancedMemoryStream = class(TFifoStream) - public - function ReadBoolean: Boolean; - function ReadByte: Byte; - function ReadCardinal: Cardinal; - function ReadInteger: Integer; - function ReadInt64: Int64; - function ReadShortInt: ShortInt; - function ReadSmallInt: SmallInt; - function ReadWord: Word; - function ReadStringNull: string; - function ReadStringFixed(ALength: Integer): string; - function ReadStringBigUniNull: WideString; - procedure WriteBoolean(AValue: Boolean); - procedure WriteByte(AValue: Byte); - procedure WriteCardinal(AValue: Cardinal); - procedure WriteInteger(AValue: Integer); - procedure WriteInt64(AValue: Int64); - procedure WriteShortInt(AValue: ShortInt); - procedure WriteSmallInt(AValue: SmallInt); - procedure WriteWord(AValue: Word); - procedure WriteStringNull(AValue: string); - procedure WriteStringFixed(AValue: string; ALength: Integer); - procedure WriteStringBigUniNull(AValue: WideString); - procedure WriteStringLittleUniNull(AValue: WideString); - end; - -implementation - -type - PByteArray = ^TByteArray; - TByteArray = array[0..MaxInt - 1] of Byte; - -function SwapWideChar(Char: WideChar): WideChar; -begin - Result := WideChar((Word(Char) shl 8) or ((Word(Char) shr 8) and $FF)); -end; - -{ TEnhancedMemoryStream } - -function TEnhancedMemoryStream.ReadBoolean: Boolean; -begin - Read(Result, SizeOf(Boolean)); -end; - -function TEnhancedMemoryStream.ReadByte: Byte; -begin - Read(Result, SizeOf(Byte)); -end; - -function TEnhancedMemoryStream.ReadCardinal: Cardinal; -begin - Read(Result, SizeOf(Cardinal)); -end; - -function TEnhancedMemoryStream.ReadInt64: Int64; -begin - Read(Result, SizeOf(Int64)); -end; - -function TEnhancedMemoryStream.ReadShortInt: ShortInt; -begin - Read(Result, SizeOf(ShortInt)); -end; - -function TEnhancedMemoryStream.ReadInteger: Integer; -begin - Read(Result, SizeOf(Integer)); -end; - -function TEnhancedMemoryStream.ReadSmallInt: SmallInt; -begin - Read(Result, SizeOf(SmallInt)); -end; - -function TEnhancedMemoryStream.ReadStringBigUniNull: WideString; -var - buffer: PWideChar; - length: Integer; -begin - Result := ''; - buffer := Pointer(LongInt(Memory) + Position); - length := 0; - while (buffer[length] <> #0) and (length < (Size - Position)) do - begin - if (SwapWideChar(buffer[length]) = #10) and (SwapWideChar(buffer[length - 1]) <> #13) then - Result := Result + #13; - Result := Result + SwapWideChar(buffer[length]); - if (SwapWideChar(buffer[length]) = #13) and (SwapWideChar(buffer[length + 1]) <> #10) then - Result := Result + #10; - inc(length); - end; - Position := Position + (Length + 1) * 2; -end; - -function TEnhancedMemoryStream.ReadStringFixed(ALength: Integer): string; -var - buffer: PChar; - length: Integer; -begin - Result := ''; - buffer := Pointer(LongInt(FMemory) + FPosition); - length := 0; - while (length < ALength) and (length < (FSize - (FPosition - FLockOffset))) do - begin - if (buffer[length] = #10) and (buffer[length - 1] <> #13) then - Result := Result + #13; - Result := Result + buffer[length]; - if (buffer[length] = #13) and (buffer[length + 1] <> #10) then - Result := Result + #10; - inc(length); - end; - FPosition := FPosition + length + 1; -end; - -function TEnhancedMemoryStream.ReadStringNull: string; -var - buffer: PByteArray; - length: Integer; -begin - Result := ''; - buffer := Pointer(LongInt(FMemory) + FPosition); - length := 0; - while (buffer^[length] <> 0) and (length < (FSize - (FPosition - FLockOffset))) do - begin - if (buffer^[length] = 10) and (buffer^[length - 1] <> 13) then - Result := Result + #13; - Result := Result + Char(buffer^[length]); - if (buffer^[length] = 13) and (buffer^[length + 1] <> 10) then - Result := Result + #10; - inc(length); - end; - FPosition := FPosition + length + 1; -end; - -function TEnhancedMemoryStream.ReadWord: Word; -begin - Read(Result, SizeOf(Word)); -end; - -procedure TEnhancedMemoryStream.WriteBoolean(AValue: Boolean); -begin - Write(AValue, SizeOf(Boolean)); -end; - -procedure TEnhancedMemoryStream.WriteByte(AValue: Byte); -begin - Write(AValue, SizeOf(Byte)); -end; - -procedure TEnhancedMemoryStream.WriteCardinal(AValue: Cardinal); -begin - Write(AValue, SizeOf(Cardinal)); -end; - -procedure TEnhancedMemoryStream.WriteInt64(AValue: Int64); -begin - Write(AValue, SizeOf(Int64)); -end; - -procedure TEnhancedMemoryStream.WriteShortInt(AValue: ShortInt); -begin - Write(AValue, SizeOf(ShortInt)); -end; - -procedure TEnhancedMemoryStream.WriteInteger(AValue: Integer); -begin - Write(AValue, SizeOf(Integer)); -end; - -procedure TEnhancedMemoryStream.WriteSmallInt(AValue: SmallInt); -begin - Write(AValue, SizeOf(SmallInt)); -end; - -procedure TEnhancedMemoryStream.WriteStringBigUniNull(AValue: WideString); -var - i: Integer; -begin - for i := 1 to Length(AValue) do - WriteWord(Word(SwapWideChar(AValue[i]))); - WriteWord(0); -end; - -procedure TEnhancedMemoryStream.WriteStringFixed(AValue: string; - ALength: Integer); -var - i: Integer; -begin - for i := Length(AValue) to ALength do - AValue := AValue + #0; - Write(PChar(AValue)^, ALength); -end; - -procedure TEnhancedMemoryStream.WriteStringLittleUniNull( - AValue: WideString); -var - i: Integer; -begin - for i := 1 to Length(AValue) do - WriteWord(Word(AValue[i])); - WriteWord(0); -end; - -procedure TEnhancedMemoryStream.WriteStringNull(AValue: string); -begin - write(PChar(AValue)^, Length(AValue) + 1); -end; - -procedure TEnhancedMemoryStream.WriteWord(AValue: Word); -begin - Write(AValue, SizeOf(Word)); -end; - -end. + +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2007 Andreas Schneider + *) +unit UEnhancedMemoryStream; + +{$mode delphi}{$H+} + +interface + +uses + Classes, UStreamHelper; + +type + + { TEnhancedMemoryStream } + + TEnhancedMemoryStream = class(TFifoStream) + public + function ReadBoolean: Boolean; + function ReadByte: Byte; + function ReadCardinal: Cardinal; + function ReadInteger: Integer; + function ReadInt64: Int64; + function ReadShortInt: ShortInt; + function ReadSmallInt: SmallInt; + function ReadWord: Word; + function ReadStringNull: string; + function ReadStringFixed(ALength: Integer): string; + function ReadStringBigUniNull: WideString; + procedure WriteBoolean(AValue: Boolean); + procedure WriteByte(AValue: Byte); + procedure WriteCardinal(AValue: Cardinal); + procedure WriteInteger(AValue: Integer); + procedure WriteInt64(AValue: Int64); + procedure WriteShortInt(AValue: ShortInt); + procedure WriteSmallInt(AValue: SmallInt); + procedure WriteWord(AValue: Word); + procedure WriteStringNull(AValue: string); + procedure WriteStringFixed(AValue: string; ALength: Integer); + procedure WriteStringBigUniNull(AValue: WideString); + procedure WriteStringLittleUniNull(AValue: WideString); + end; + +implementation + +type + PByteArray = ^TByteArray; + TByteArray = array[0..MaxInt - 1] of Byte; + +function SwapWideChar(Char: WideChar): WideChar; +begin + Result := WideChar((Word(Char) shl 8) or ((Word(Char) shr 8) and $FF)); +end; + +{ TEnhancedMemoryStream } + +function TEnhancedMemoryStream.ReadBoolean: Boolean; +begin + Read(Result, SizeOf(Boolean)); +end; + +function TEnhancedMemoryStream.ReadByte: Byte; +begin + Read(Result, SizeOf(Byte)); +end; + +function TEnhancedMemoryStream.ReadCardinal: Cardinal; +begin + Read(Result, SizeOf(Cardinal)); +end; + +function TEnhancedMemoryStream.ReadInt64: Int64; +begin + Read(Result, SizeOf(Int64)); +end; + +function TEnhancedMemoryStream.ReadShortInt: ShortInt; +begin + Read(Result, SizeOf(ShortInt)); +end; + +function TEnhancedMemoryStream.ReadInteger: Integer; +begin + Read(Result, SizeOf(Integer)); +end; + +function TEnhancedMemoryStream.ReadSmallInt: SmallInt; +begin + Read(Result, SizeOf(SmallInt)); +end; + +function TEnhancedMemoryStream.ReadStringBigUniNull: WideString; +var + buffer: PWideChar; + length: Integer; +begin + Result := ''; + buffer := Pointer(LongInt(Memory) + Position); + length := 0; + while (buffer[length] <> #0) and (length < (Size - Position)) do + begin + if (SwapWideChar(buffer[length]) = #10) and (SwapWideChar(buffer[length - 1]) <> #13) then + Result := Result + #13; + Result := Result + SwapWideChar(buffer[length]); + if (SwapWideChar(buffer[length]) = #13) and (SwapWideChar(buffer[length + 1]) <> #10) then + Result := Result + #10; + inc(length); + end; + Position := Position + (Length + 1) * 2; +end; + +function TEnhancedMemoryStream.ReadStringFixed(ALength: Integer): string; +var + buffer: PChar; + length: Integer; +begin + Result := ''; + buffer := Pointer(LongInt(FMemory) + FPosition); + length := 0; + while (length < ALength) and (length < (FSize - (FPosition - FLockOffset))) do + begin + if (buffer[length] = #10) and (buffer[length - 1] <> #13) then + Result := Result + #13; + Result := Result + buffer[length]; + if (buffer[length] = #13) and (buffer[length + 1] <> #10) then + Result := Result + #10; + inc(length); + end; + FPosition := FPosition + length + 1; +end; + +function TEnhancedMemoryStream.ReadStringNull: string; +var + buffer: PByteArray; + length: Integer; +begin + Result := ''; + buffer := Pointer(LongInt(FMemory) + FPosition); + length := 0; + while (buffer^[length] <> 0) and (length < (FSize - (FPosition - FLockOffset))) do + begin + if (buffer^[length] = 10) and (buffer^[length - 1] <> 13) then + Result := Result + #13; + Result := Result + Char(buffer^[length]); + if (buffer^[length] = 13) and (buffer^[length + 1] <> 10) then + Result := Result + #10; + inc(length); + end; + FPosition := FPosition + length + 1; +end; + +function TEnhancedMemoryStream.ReadWord: Word; +begin + Read(Result, SizeOf(Word)); +end; + +procedure TEnhancedMemoryStream.WriteBoolean(AValue: Boolean); +begin + Write(AValue, SizeOf(Boolean)); +end; + +procedure TEnhancedMemoryStream.WriteByte(AValue: Byte); +begin + Write(AValue, SizeOf(Byte)); +end; + +procedure TEnhancedMemoryStream.WriteCardinal(AValue: Cardinal); +begin + Write(AValue, SizeOf(Cardinal)); +end; + +procedure TEnhancedMemoryStream.WriteInt64(AValue: Int64); +begin + Write(AValue, SizeOf(Int64)); +end; + +procedure TEnhancedMemoryStream.WriteShortInt(AValue: ShortInt); +begin + Write(AValue, SizeOf(ShortInt)); +end; + +procedure TEnhancedMemoryStream.WriteInteger(AValue: Integer); +begin + Write(AValue, SizeOf(Integer)); +end; + +procedure TEnhancedMemoryStream.WriteSmallInt(AValue: SmallInt); +begin + Write(AValue, SizeOf(SmallInt)); +end; + +procedure TEnhancedMemoryStream.WriteStringBigUniNull(AValue: WideString); +var + i: Integer; +begin + for i := 1 to Length(AValue) do + WriteWord(Word(SwapWideChar(AValue[i]))); + WriteWord(0); +end; + +procedure TEnhancedMemoryStream.WriteStringFixed(AValue: string; + ALength: Integer); +var + i: Integer; +begin + for i := Length(AValue) to ALength do + AValue := AValue + #0; + Write(PChar(AValue)^, ALength); +end; + +procedure TEnhancedMemoryStream.WriteStringLittleUniNull( + AValue: WideString); +var + i: Integer; +begin + for i := 1 to Length(AValue) do + WriteWord(Word(AValue[i])); + WriteWord(0); +end; + +procedure TEnhancedMemoryStream.WriteStringNull(AValue: string); +begin + write(PChar(AValue)^, Length(AValue) + 1); +end; + +procedure TEnhancedMemoryStream.WriteWord(AValue: Word); +begin + Write(AValue, SizeOf(Word)); +end; + +end. diff --git a/ULinkedList.pas b/ULinkedList.pas index f45a8cf..8258bc4 100644 --- a/ULinkedList.pas +++ b/ULinkedList.pas @@ -1,167 +1,167 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2007 Andreas Schneider - *) -unit ULinkedList; - -interface - -uses - SysUtils; - -type - PLinkedItem = ^TLinkedItem; - TLinkedItem = record - ID: Integer; - Data: Pointer; - Next: PLinkedItem; - end; - TLinkedList = class(TObject) - constructor Create; virtual; - destructor Destroy; override; - protected - FFirst: PLinkedItem; - FLast: PLinkedItem; - public - procedure Clear; virtual; - function Iterate(var ALinkedItem: PLinkedItem): Boolean; virtual; - function Add(AID: Integer; AData: Pointer): PLinkedItem; virtual; - procedure Delete(AData: Pointer); overload; virtual; - procedure Delete(AID: Integer); overload; virtual; - function Get(AID: Integer): Pointer; virtual; - property Last: PLinkedItem read FLast; - end; - -implementation - -{ TBlockList } - -function TLinkedList.Add(AID: Integer; AData: Pointer): PLinkedItem; -var - current: PLinkedItem; -begin - New(current); - current^.ID := AID; - current^.Data := AData; - current^.Next := nil; - if FFirst = nil then FFirst := current; - if FLast <> nil then FLast^.Next := current; - FLast := current; - Result := current; -end; - -procedure TLinkedList.Clear; -var - current, next: PLinkedItem; -begin - current := FFirst; - while current <> nil do - begin - next := current^.Next; - Dispose(current); - current := next; - end; - FFirst := nil; - FLast := nil; -end; - -constructor TLinkedList.Create; -begin - inherited Create; - FFirst := nil; - FLast := nil; -end; - -procedure TLinkedList.Delete(AData: Pointer); -var - currentItem, lastItem, nextItem: PLinkedItem; -begin - lastItem := nil; - currentItem := FFirst; - while currentItem <> nil do - begin - if currentItem^.Data = AData then - begin - if FFirst = currentItem then FFirst := currentItem^.Next; - if FLast = currentItem then FLast := lastItem; - if lastItem <> nil then lastItem^.Next := currentItem^.Next; - Dispose(currentItem); - nextItem := nil; - end else - nextItem := currentItem^.Next; - lastItem := currentItem; - currentItem := nextItem; - end; -end; - -procedure TLinkedList.Delete(AID: Integer); -var - currentItem, lastItem, nextItem: PLinkedItem; -begin - lastItem := nil; - currentItem := FFirst; - while currentItem <> nil do - begin - if currentItem^.ID = AID then - begin - if FFirst = currentItem then FFirst := currentItem^.Next; - if FLast = currentItem then FLast := lastItem; - if lastItem <> nil then lastItem^.Next := currentItem^.Next; - Dispose(currentItem); - nextItem := nil; - end else - nextItem := currentItem^.Next; - lastItem := currentItem; - currentItem := nextItem; - end; -end; - -destructor TLinkedList.Destroy; -begin - Clear; - inherited Destroy; -end; - -function TLinkedList.Get(AID: Integer): Pointer; -var - item: PLinkedItem; -begin - Result := nil; - item := nil; - while Iterate(item) and (Result = nil) do - if item^.ID = AID then - Result := item^.Data; -end; - -function TLinkedList.Iterate(var ALinkedItem: PLinkedItem): Boolean; -begin - if ALinkedItem = nil then - ALinkedItem := FFirst - else - ALinkedItem := ALinkedItem^.Next; - Result := ALinkedItem <> nil; -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2007 Andreas Schneider + *) +unit ULinkedList; + +interface + +uses + SysUtils; + +type + PLinkedItem = ^TLinkedItem; + TLinkedItem = record + ID: Integer; + Data: Pointer; + Next: PLinkedItem; + end; + TLinkedList = class(TObject) + constructor Create; virtual; + destructor Destroy; override; + protected + FFirst: PLinkedItem; + FLast: PLinkedItem; + public + procedure Clear; virtual; + function Iterate(var ALinkedItem: PLinkedItem): Boolean; virtual; + function Add(AID: Integer; AData: Pointer): PLinkedItem; virtual; + procedure Delete(AData: Pointer); overload; virtual; + procedure Delete(AID: Integer); overload; virtual; + function Get(AID: Integer): Pointer; virtual; + property Last: PLinkedItem read FLast; + end; + +implementation + +{ TBlockList } + +function TLinkedList.Add(AID: Integer; AData: Pointer): PLinkedItem; +var + current: PLinkedItem; +begin + New(current); + current^.ID := AID; + current^.Data := AData; + current^.Next := nil; + if FFirst = nil then FFirst := current; + if FLast <> nil then FLast^.Next := current; + FLast := current; + Result := current; +end; + +procedure TLinkedList.Clear; +var + current, next: PLinkedItem; +begin + current := FFirst; + while current <> nil do + begin + next := current^.Next; + Dispose(current); + current := next; + end; + FFirst := nil; + FLast := nil; +end; + +constructor TLinkedList.Create; +begin + inherited Create; + FFirst := nil; + FLast := nil; +end; + +procedure TLinkedList.Delete(AData: Pointer); +var + currentItem, lastItem, nextItem: PLinkedItem; +begin + lastItem := nil; + currentItem := FFirst; + while currentItem <> nil do + begin + if currentItem^.Data = AData then + begin + if FFirst = currentItem then FFirst := currentItem^.Next; + if FLast = currentItem then FLast := lastItem; + if lastItem <> nil then lastItem^.Next := currentItem^.Next; + Dispose(currentItem); + nextItem := nil; + end else + nextItem := currentItem^.Next; + lastItem := currentItem; + currentItem := nextItem; + end; +end; + +procedure TLinkedList.Delete(AID: Integer); +var + currentItem, lastItem, nextItem: PLinkedItem; +begin + lastItem := nil; + currentItem := FFirst; + while currentItem <> nil do + begin + if currentItem^.ID = AID then + begin + if FFirst = currentItem then FFirst := currentItem^.Next; + if FLast = currentItem then FLast := lastItem; + if lastItem <> nil then lastItem^.Next := currentItem^.Next; + Dispose(currentItem); + nextItem := nil; + end else + nextItem := currentItem^.Next; + lastItem := currentItem; + currentItem := nextItem; + end; +end; + +destructor TLinkedList.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TLinkedList.Get(AID: Integer): Pointer; +var + item: PLinkedItem; +begin + Result := nil; + item := nil; + while Iterate(item) and (Result = nil) do + if item^.ID = AID then + Result := item^.Data; +end; + +function TLinkedList.Iterate(var ALinkedItem: PLinkedItem): Boolean; +begin + if ALinkedItem = nil then + ALinkedItem := FFirst + else + ALinkedItem := ALinkedItem^.Next; + Result := ALinkedItem <> nil; +end; + +end. + diff --git a/UOLib/UArt.pas b/UOLib/UArt.pas index ef44514..359437b 100644 --- a/UOLib/UArt.pas +++ b/UOLib/UArt.pas @@ -1,325 +1,325 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2009 Andreas Schneider - *) -unit UArt; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, Imaging, ImagingTypes, ImagingCanvases, ImagingClasses, - UMulBlock, UGenericIndex, UHue; - -type - TArtType = (atLand, atStatic, atLandFlat); - TArt = class(TMulBlock) - constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType); overload; - constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AHue: THue; APartialHue: Boolean); overload; - constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean); overload; - destructor Destroy; override; - function Clone: TArt; override; - function GetSize: Integer; override; - procedure Write(AData: TStream); override; - procedure RefreshBuffer; - protected - FArtType: TArtType; - FHeader: LongInt; - FGraphic: TSingleImage; - FBuffer: TStream; - public - property ArtType: TArtType read FArtType write FArtType; - property Header: LongInt read FHeader write FHeader; - property Graphic: TSingleImage read FGraphic; - property Buffer: TStream read FBuffer; - end; - -implementation - -type - PWordArray = ^TWordArray; - TWordArray = array[0..16383] of Word; - -constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType); -begin - Create(AData, AIndex, AArtType, 0, nil, False); -end; - -constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AHue: THue; APartialHue: Boolean); -begin - Create(AData, AIndex, AArtType, 0, AHue, APartialHue); -end; - -constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean); -var - i, x, y, start: Integer; - iCurrentHeight, iCurrentWidth: Integer; - width, height: SmallInt; - lookup: array of integer; - color, run, offset: Word; - block: TMemoryStream; - P: PWordArray; - r, g, b: Byte; - -begin - FBuffer := TMemoryStream.Create; - FArtType := AArtType; - AArtColor := AArtColor or $8000; //set alpha bit on background - if Assigned(AData) and (AIndex.Lookup > -1) then - begin - AData.Position := AIndex.Lookup; - block := TMemoryStream.Create; - block.CopyFrom(AData, AIndex.Size); - block.Position := 0; - - if AArtType = atLand then - begin - FGraphic:= TSingleImage.CreateFromParams(44, 44, ifA1R5G5B5); - FillWord(FGraphic.Bits^, 44 * 44, AArtColor); - for y := 0 to 21 do - begin - P := FGraphic.Bits + y * 44 * 2; - block.Read(P^[22 - (y + 1)], (y + 1) * 4); - end; - for y := 0 to 21 do - begin - P := FGraphic.Bits + (22 + y) * 44 * 2; - block.Read(P^[y], (22 - y) * 4); - end; - for i := 0 to 44 * 44 - 1 do - PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit - end else if AArtType = atLandFlat then - begin - FGraphic:= TSingleImage.CreateFromParams(44, 44, ifA1R5G5B5); - for i := 1 to 22 do - begin - for x := 0 to i * 2 - 1 do - begin - y := i * 2 - x - 1; - block.Read(color, SizeOf(Word)); - PWordArray(FGraphic.Bits + y * 44 * 2)^[x] := color; - if y > 0 then - PWordArray(FGraphic.Bits + (y - 1) * 44 * 2)^[x] := color; - end; - end; - for i := 22 to 43 do - begin - for y := 0 to (44 - i) * 2 - 1 do - begin - x := 42 - (43 - i) * 2 + y; - block.Read(color, SizeOf(Word)); - PWordArray(FGraphic.Bits + (43 - y) * 44 * 2)^[x] := color; - if y > 0 then - PWordArray(FGraphic.Bits + (44 - y) * 44 * 2)^[x] := color; - end; - end; - for i := 0 to 44 * 44 - 1 do - PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit - end else if AArtType = atStatic then - begin - block.Read(FHeader, SizeOf(LongInt)); - block.Read(width, SizeOf(SmallInt)); - block.Read(height, SizeOf(SmallInt)); - FGraphic:= TSingleImage.CreateFromParams(width, height, ifA1R5G5B5); - FillWord(FGraphic.Bits^, width * height, AArtColor); - SetLength(lookup, height); - start := block.Position + (height * 2); - for i := 0 to height - 1 do - begin - block.Read(offset, SizeOf(Word)); - lookup[i] := start + (offset * 2); - end; - for iCurrentHeight := 0 to height - 1 do - begin - block.Position := lookup[iCurrentHeight]; - iCurrentWidth := 0; - P := FGraphic.Bits + iCurrentHeight * width * 2; - while (block.Read(offset, SizeOf(Word)) = SizeOf(Word)) and - (block.Read(run, SizeOf(Word)) = SizeOf(Word)) and - (offset + run <> 0) do - begin - inc(iCurrentWidth, offset); - for i := 0 to run - 1 do - begin - block.Read(color, SizeOf(Word)); - P^[iCurrentWidth + i] := color; - end; - inc(iCurrentWidth, run); - end; - end; - - if AHue <> nil then - begin - for i := 0 to width * height - 1 do - begin - color := PWordArray(FGraphic.Bits)^[i]; - if color <> AArtColor then - begin - r := (color and $7C00) shr 10; - if APartialHue then - begin - g := (color and $3E0) shr 5; - b := color and $1F; - if (r = g) and (g = b) then - color := AHue.ColorTable[r]; - end else - color := AHue.ColorTable[r]; - end; - PWordArray(FGraphic.Bits)^[i] := color; - end; - end; - - for i := 0 to width * height - 1 do - PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit - end else - FGraphic:= TSingleImage.Create; - if Assigned(block) then block.Free; - end else - begin - FHeader := 1; - FGraphic := TSingleImage.Create; - end; - FGraphic.Format := ifA8R8G8B8; -end; - -destructor TArt.Destroy; -begin - if assigned(FGraphic) then FGraphic.Free; - if assigned(FBuffer) then FBuffer.Free; - inherited; -end; - -function TArt.Clone: TArt; -begin - Result := TArt.Create(nil, nil, FArtType); - Result.FHeader := FHeader; - Result.FGraphic.Assign(FGraphic); -end; - -procedure TArt.Write(AData: TStream); -begin - FBuffer.Position := 0; - AData.CopyFrom(FBuffer, FBuffer.Size); -end; - -function TArt.GetSize: Integer; -begin - RefreshBuffer; - Result := FBuffer.Size -end; - -procedure TArt.RefreshBuffer; -var - argbGraphic: TSingleImage; - i, x, y, lineWidth, start: Integer; - iCurrentHeight, iCurrentWidth: Integer; - width, height: SmallInt; - color, run, offset: Word; - lookup: array of SmallInt; -begin - argbGraphic := TSingleImage.CreateFromImage(FGraphic); - argbGraphic.Format := ifA1R5G5B5; - for i := 0 to argbGraphic.Width * argbGraphic.Height - 1 do - PWordArray(argbGraphic.Bits)^[i] := PWordArray(argbGraphic.Bits)^[i] xor $8000; //invert alpha bit - FBuffer.Size := 0; - if FArtType = atLand then - begin - if (argbGraphic.Height <> 44) or (argbGraphic.Width <> 44) then Exit; - x := 21; - y := 0; - lineWidth := 2; - for i := 1 to 22 do - begin - Dec(x); - FBuffer.Write(PWordArray(argbGraphic.Bits + y * 44 * 2)^[x + i], lineWidth); - Inc(y); - Inc(lineWidth, 2); - end; - for i := 1 to 22 do - begin - Dec(lineWidth, 2); - FBuffer.Write(PWordArray(argbGraphic.Bits + y * 44 * 2)^[x + i], lineWidth); - Inc(x); - Inc(y); - end; - end else if FArtType = atStatic then - begin - if (argbGraphic.Height = 0) or (argbGraphic.Width = 0) then Exit; - width := argbGraphic.Width; - height := argbGraphic.Height; - FBuffer.Write(FHeader, SizeOf(LongInt)); - FBuffer.Write(width, SizeOf(SmallInt)); - FBuffer.Write(height, SizeOf(SmallInt)); - SetLength(lookup, height); - for i := 0 to height - 1 do - FBuffer.Write(lookup[i], SizeOf(SmallInt)); //placeholders for the lookup table - start := FBuffer.Position; - for iCurrentHeight := 0 to height - 1 do - begin - lookup[iCurrentHeight] := SmallInt((FBuffer.Position - start) div 2); //remember the lookup offset for the current line - offset := 0; - run := 0; - for iCurrentWidth := 0 to width - 1 do //process every pixel on the current line - begin - color := PWordArray(FGraphic.Bits + iCurrentHeight * width * 2)^[iCurrentWidth]; - if (color and $8000 = 0) and (run = 0) then //new visible pixel found - begin - FBuffer.Write(offset, SizeOf(Word)); - FBuffer.Write(offset, SizeOf(Word)); //just a placeholder for the "run length" - run := 1; - FBuffer.Write(color, SizeOf(Word)); - end else if (color and $8000 = 0) and (run > 0) then //another visible pixel found - begin - inc(run); - FBuffer.Write(color, SizeOf(Word)); - end else if (color and $8000 = $8000) and (run > 0) then //after some visible pixels this one is invisible, so stop the current run - begin - FBuffer.Seek(Integer(-((run + 1) * 2)), soFromCurrent); //jump back ... - FBuffer.Write(run, SizeOf(Word)); //... to write the actual "run length" ... - FBuffer.Seek(Integer(run * 2), soFromCurrent); //... and jump forth again to proceed - run := 0; - offset := 1; - end else - inc(offset); - end; - if run > 0 then //no more pixels but the "run" didn't end yet ;-) - begin - FBuffer.Seek(Integer(-((run + 1) * 2)), soFromCurrent); - FBuffer.Write(run, SizeOf(Word)); - FBuffer.Seek(Integer(run * 2), soFromCurrent); - run := 0; - end; - FBuffer.Write(run, SizeOf(Word)); //just write "0" - FBuffer.Write(run, SizeOf(Word)); //... two times, to indicate the end of that line - end; - FBuffer.Position := start - (height * 2); //now update the lookup table with our new values - for i := 0 to height - 1 do - FBuffer.Write(lookup[i], SizeOf(SmallInt)); - end; - argbGraphic.Free; -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2009 Andreas Schneider + *) +unit UArt; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, Imaging, ImagingTypes, ImagingCanvases, ImagingClasses, + UMulBlock, UGenericIndex, UHue; + +type + TArtType = (atLand, atStatic, atLandFlat); + TArt = class(TMulBlock) + constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType); overload; + constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AHue: THue; APartialHue: Boolean); overload; + constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean); overload; + destructor Destroy; override; + function Clone: TArt; override; + function GetSize: Integer; override; + procedure Write(AData: TStream); override; + procedure RefreshBuffer; + protected + FArtType: TArtType; + FHeader: LongInt; + FGraphic: TSingleImage; + FBuffer: TStream; + public + property ArtType: TArtType read FArtType write FArtType; + property Header: LongInt read FHeader write FHeader; + property Graphic: TSingleImage read FGraphic; + property Buffer: TStream read FBuffer; + end; + +implementation + +type + PWordArray = ^TWordArray; + TWordArray = array[0..16383] of Word; + +constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType); +begin + Create(AData, AIndex, AArtType, 0, nil, False); +end; + +constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AHue: THue; APartialHue: Boolean); +begin + Create(AData, AIndex, AArtType, 0, AHue, APartialHue); +end; + +constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean); +var + i, x, y, start: Integer; + iCurrentHeight, iCurrentWidth: Integer; + width, height: SmallInt; + lookup: array of integer; + color, run, offset: Word; + block: TMemoryStream; + P: PWordArray; + r, g, b: Byte; + +begin + FBuffer := TMemoryStream.Create; + FArtType := AArtType; + AArtColor := AArtColor or $8000; //set alpha bit on background + if Assigned(AData) and (AIndex.Lookup > -1) then + begin + AData.Position := AIndex.Lookup; + block := TMemoryStream.Create; + block.CopyFrom(AData, AIndex.Size); + block.Position := 0; + + if AArtType = atLand then + begin + FGraphic:= TSingleImage.CreateFromParams(44, 44, ifA1R5G5B5); + FillWord(FGraphic.Bits^, 44 * 44, AArtColor); + for y := 0 to 21 do + begin + P := FGraphic.Bits + y * 44 * 2; + block.Read(P^[22 - (y + 1)], (y + 1) * 4); + end; + for y := 0 to 21 do + begin + P := FGraphic.Bits + (22 + y) * 44 * 2; + block.Read(P^[y], (22 - y) * 4); + end; + for i := 0 to 44 * 44 - 1 do + PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit + end else if AArtType = atLandFlat then + begin + FGraphic:= TSingleImage.CreateFromParams(44, 44, ifA1R5G5B5); + for i := 1 to 22 do + begin + for x := 0 to i * 2 - 1 do + begin + y := i * 2 - x - 1; + block.Read(color, SizeOf(Word)); + PWordArray(FGraphic.Bits + y * 44 * 2)^[x] := color; + if y > 0 then + PWordArray(FGraphic.Bits + (y - 1) * 44 * 2)^[x] := color; + end; + end; + for i := 22 to 43 do + begin + for y := 0 to (44 - i) * 2 - 1 do + begin + x := 42 - (43 - i) * 2 + y; + block.Read(color, SizeOf(Word)); + PWordArray(FGraphic.Bits + (43 - y) * 44 * 2)^[x] := color; + if y > 0 then + PWordArray(FGraphic.Bits + (44 - y) * 44 * 2)^[x] := color; + end; + end; + for i := 0 to 44 * 44 - 1 do + PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit + end else if AArtType = atStatic then + begin + block.Read(FHeader, SizeOf(LongInt)); + block.Read(width, SizeOf(SmallInt)); + block.Read(height, SizeOf(SmallInt)); + FGraphic:= TSingleImage.CreateFromParams(width, height, ifA1R5G5B5); + FillWord(FGraphic.Bits^, width * height, AArtColor); + SetLength(lookup, height); + start := block.Position + (height * 2); + for i := 0 to height - 1 do + begin + block.Read(offset, SizeOf(Word)); + lookup[i] := start + (offset * 2); + end; + for iCurrentHeight := 0 to height - 1 do + begin + block.Position := lookup[iCurrentHeight]; + iCurrentWidth := 0; + P := FGraphic.Bits + iCurrentHeight * width * 2; + while (block.Read(offset, SizeOf(Word)) = SizeOf(Word)) and + (block.Read(run, SizeOf(Word)) = SizeOf(Word)) and + (offset + run <> 0) do + begin + inc(iCurrentWidth, offset); + for i := 0 to run - 1 do + begin + block.Read(color, SizeOf(Word)); + P^[iCurrentWidth + i] := color; + end; + inc(iCurrentWidth, run); + end; + end; + + if AHue <> nil then + begin + for i := 0 to width * height - 1 do + begin + color := PWordArray(FGraphic.Bits)^[i]; + if color <> AArtColor then + begin + r := (color and $7C00) shr 10; + if APartialHue then + begin + g := (color and $3E0) shr 5; + b := color and $1F; + if (r = g) and (g = b) then + color := AHue.ColorTable[r]; + end else + color := AHue.ColorTable[r]; + end; + PWordArray(FGraphic.Bits)^[i] := color; + end; + end; + + for i := 0 to width * height - 1 do + PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit + end else + FGraphic:= TSingleImage.Create; + if Assigned(block) then block.Free; + end else + begin + FHeader := 1; + FGraphic := TSingleImage.Create; + end; + FGraphic.Format := ifA8R8G8B8; +end; + +destructor TArt.Destroy; +begin + if assigned(FGraphic) then FGraphic.Free; + if assigned(FBuffer) then FBuffer.Free; + inherited; +end; + +function TArt.Clone: TArt; +begin + Result := TArt.Create(nil, nil, FArtType); + Result.FHeader := FHeader; + Result.FGraphic.Assign(FGraphic); +end; + +procedure TArt.Write(AData: TStream); +begin + FBuffer.Position := 0; + AData.CopyFrom(FBuffer, FBuffer.Size); +end; + +function TArt.GetSize: Integer; +begin + RefreshBuffer; + Result := FBuffer.Size +end; + +procedure TArt.RefreshBuffer; +var + argbGraphic: TSingleImage; + i, x, y, lineWidth, start: Integer; + iCurrentHeight, iCurrentWidth: Integer; + width, height: SmallInt; + color, run, offset: Word; + lookup: array of SmallInt; +begin + argbGraphic := TSingleImage.CreateFromImage(FGraphic); + argbGraphic.Format := ifA1R5G5B5; + for i := 0 to argbGraphic.Width * argbGraphic.Height - 1 do + PWordArray(argbGraphic.Bits)^[i] := PWordArray(argbGraphic.Bits)^[i] xor $8000; //invert alpha bit + FBuffer.Size := 0; + if FArtType = atLand then + begin + if (argbGraphic.Height <> 44) or (argbGraphic.Width <> 44) then Exit; + x := 21; + y := 0; + lineWidth := 2; + for i := 1 to 22 do + begin + Dec(x); + FBuffer.Write(PWordArray(argbGraphic.Bits + y * 44 * 2)^[x + i], lineWidth); + Inc(y); + Inc(lineWidth, 2); + end; + for i := 1 to 22 do + begin + Dec(lineWidth, 2); + FBuffer.Write(PWordArray(argbGraphic.Bits + y * 44 * 2)^[x + i], lineWidth); + Inc(x); + Inc(y); + end; + end else if FArtType = atStatic then + begin + if (argbGraphic.Height = 0) or (argbGraphic.Width = 0) then Exit; + width := argbGraphic.Width; + height := argbGraphic.Height; + FBuffer.Write(FHeader, SizeOf(LongInt)); + FBuffer.Write(width, SizeOf(SmallInt)); + FBuffer.Write(height, SizeOf(SmallInt)); + SetLength(lookup, height); + for i := 0 to height - 1 do + FBuffer.Write(lookup[i], SizeOf(SmallInt)); //placeholders for the lookup table + start := FBuffer.Position; + for iCurrentHeight := 0 to height - 1 do + begin + lookup[iCurrentHeight] := SmallInt((FBuffer.Position - start) div 2); //remember the lookup offset for the current line + offset := 0; + run := 0; + for iCurrentWidth := 0 to width - 1 do //process every pixel on the current line + begin + color := PWordArray(FGraphic.Bits + iCurrentHeight * width * 2)^[iCurrentWidth]; + if (color and $8000 = 0) and (run = 0) then //new visible pixel found + begin + FBuffer.Write(offset, SizeOf(Word)); + FBuffer.Write(offset, SizeOf(Word)); //just a placeholder for the "run length" + run := 1; + FBuffer.Write(color, SizeOf(Word)); + end else if (color and $8000 = 0) and (run > 0) then //another visible pixel found + begin + inc(run); + FBuffer.Write(color, SizeOf(Word)); + end else if (color and $8000 = $8000) and (run > 0) then //after some visible pixels this one is invisible, so stop the current run + begin + FBuffer.Seek(Integer(-((run + 1) * 2)), soFromCurrent); //jump back ... + FBuffer.Write(run, SizeOf(Word)); //... to write the actual "run length" ... + FBuffer.Seek(Integer(run * 2), soFromCurrent); //... and jump forth again to proceed + run := 0; + offset := 1; + end else + inc(offset); + end; + if run > 0 then //no more pixels but the "run" didn't end yet ;-) + begin + FBuffer.Seek(Integer(-((run + 1) * 2)), soFromCurrent); + FBuffer.Write(run, SizeOf(Word)); + FBuffer.Seek(Integer(run * 2), soFromCurrent); + run := 0; + end; + FBuffer.Write(run, SizeOf(Word)); //just write "0" + FBuffer.Write(run, SizeOf(Word)); //... two times, to indicate the end of that line + end; + FBuffer.Position := start - (height * 2); //now update the lookup table with our new values + for i := 0 to height - 1 do + FBuffer.Write(lookup[i], SizeOf(SmallInt)); + end; + argbGraphic.Free; +end; + +end. + diff --git a/UOLib/UGenericIndex.pas b/UOLib/UGenericIndex.pas index 703c850..2dbb2ff 100644 --- a/UOLib/UGenericIndex.pas +++ b/UOLib/UGenericIndex.pas @@ -1,83 +1,83 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2007 Andreas Schneider - *) -unit UGenericIndex; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, UMulBlock; - -type - TGenericIndex = class(TMulBlock) - constructor Create(Data: TStream); - function Clone: TGenericIndex; override; - function GetSize: Integer; override; - procedure Write(Data: TStream); override; - protected - FLookup: LongInt; - FSize: LongInt; - FVarious: LongInt; - published - property Lookup: LongInt read FLookup write FLookup; - property Size: LongInt read FSize write FSize; - property Various: LongInt read FVarious write FVarious; - end; - -implementation - -constructor TGenericIndex.Create(Data: TStream); -begin - if assigned(Data) then - begin - Data.Read(FLookup, SizeOf(LongInt)); - Data.Read(FSize, SizeOf(LongInt)); - Data.Read(FVarious, SizeOf(LongInt)); - end; -end; - -function TGenericIndex.Clone: TGenericIndex; -begin - Result := TGenericIndex.Create(nil); - Result.FLookup := FLookup; - Result.FSize := FSize; - Result.FVarious := FVarious; -end; - -procedure TGenericIndex.Write(Data: TStream); -begin - Data.Write(FLookup, SizeOf(LongInt)); - Data.Write(FSize, SizeOf(LongInt)); - Data.Write(FVarious, SizeOf(LongInt)); -end; - -function TGenericIndex.GetSize: Integer; -begin - Result := 12; -end; - -end. +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2007 Andreas Schneider + *) +unit UGenericIndex; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, UMulBlock; + +type + TGenericIndex = class(TMulBlock) + constructor Create(Data: TStream); + function Clone: TGenericIndex; override; + function GetSize: Integer; override; + procedure Write(Data: TStream); override; + protected + FLookup: LongInt; + FSize: LongInt; + FVarious: LongInt; + published + property Lookup: LongInt read FLookup write FLookup; + property Size: LongInt read FSize write FSize; + property Various: LongInt read FVarious write FVarious; + end; + +implementation + +constructor TGenericIndex.Create(Data: TStream); +begin + if assigned(Data) then + begin + Data.Read(FLookup, SizeOf(LongInt)); + Data.Read(FSize, SizeOf(LongInt)); + Data.Read(FVarious, SizeOf(LongInt)); + end; +end; + +function TGenericIndex.Clone: TGenericIndex; +begin + Result := TGenericIndex.Create(nil); + Result.FLookup := FLookup; + Result.FSize := FSize; + Result.FVarious := FVarious; +end; + +procedure TGenericIndex.Write(Data: TStream); +begin + Data.Write(FLookup, SizeOf(LongInt)); + Data.Write(FSize, SizeOf(LongInt)); + Data.Write(FVarious, SizeOf(LongInt)); +end; + +function TGenericIndex.GetSize: Integer; +begin + Result := 12; +end; + +end. diff --git a/UOLib/UGraphicHelper.pas b/UOLib/UGraphicHelper.pas index 676a898..e16ffea 100644 --- a/UOLib/UGraphicHelper.pas +++ b/UOLib/UGraphicHelper.pas @@ -1,85 +1,85 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2007 Andreas Schneider - *) -unit UGraphicHelper; - -{$mode objfpc}{$H+} - -interface - -function ARGB2RGB(Value: Word): Integer; -function RGB2ARGB(Value: Integer): Word; - -//New functions for Vampyre Imaging Lib -function DecodeUOColor(Value: Word): Integer; -function EncodeUOColor(Value: Integer): Word; - -implementation - -function ARGB2RGB(Value: Word): Integer; -var - R, G, B: Byte; -begin - R := ((Value shr 10) and $1F) * 8; - G := ((Value shr 5) and $1F) * 8; - B := (Value and $1F) * 8; - - Result := R + G shl 8 + B shl 16; -end; - -function RGB2ARGB(Value: Integer): Word; -var - R, G, B: Byte; -begin - R := (Value and $FF) div 8; - G := ((Value shr 8) and $FF) div 8; - B := ((Value shr 16) and $FF) div 8; - - Result := (R shl 10) + (G shl 5) + B; -end; - -function DecodeUOColor(Value: Word): Integer; -var - R, G, B: Byte; -begin - R := ((Value shr 10) and $1F) * 8; - G := ((Value shr 5) and $1F) * 8; - B := (Value and $1F) * 8; - - Result := B + G shl 8 + R shl 16; -end; - -function EncodeUOColor(Value: Integer): Word; -var - R, G, B: Byte; -begin - B := (Value and $FF) div 8; - G := ((Value shr 8) and $FF) div 8; - R := ((Value shr 16) and $FF) div 8; - - Result := (R shl 10) + (G shl 5) + B; -end; - -end. +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2007 Andreas Schneider + *) +unit UGraphicHelper; + +{$mode objfpc}{$H+} + +interface + +function ARGB2RGB(Value: Word): Integer; +function RGB2ARGB(Value: Integer): Word; + +//New functions for Vampyre Imaging Lib +function DecodeUOColor(Value: Word): Integer; +function EncodeUOColor(Value: Integer): Word; + +implementation + +function ARGB2RGB(Value: Word): Integer; +var + R, G, B: Byte; +begin + R := ((Value shr 10) and $1F) * 8; + G := ((Value shr 5) and $1F) * 8; + B := (Value and $1F) * 8; + + Result := R + G shl 8 + B shl 16; +end; + +function RGB2ARGB(Value: Integer): Word; +var + R, G, B: Byte; +begin + R := (Value and $FF) div 8; + G := ((Value shr 8) and $FF) div 8; + B := ((Value shr 16) and $FF) div 8; + + Result := (R shl 10) + (G shl 5) + B; +end; + +function DecodeUOColor(Value: Word): Integer; +var + R, G, B: Byte; +begin + R := ((Value shr 10) and $1F) * 8; + G := ((Value shr 5) and $1F) * 8; + B := (Value and $1F) * 8; + + Result := B + G shl 8 + R shl 16; +end; + +function EncodeUOColor(Value: Integer): Word; +var + R, G, B: Byte; +begin + B := (Value and $FF) div 8; + G := ((Value shr 8) and $FF) div 8; + R := ((Value shr 16) and $FF) div 8; + + Result := (R shl 10) + (G shl 5) + B; +end; + +end. diff --git a/UOLib/UGump.pas b/UOLib/UGump.pas index b7725d5..5916366 100644 --- a/UOLib/UGump.pas +++ b/UOLib/UGump.pas @@ -1,233 +1,233 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2007 Andreas Schneider - *) -unit UGump; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, Imaging, ImagingTypes, ImagingClasses, UMulBlock, UGenericIndex; - -type - TGumpIndex = class(TGenericIndex) - protected - function GetWidth: SmallInt; - function GetHeight: SmallInt; - procedure SetWidth(AValue: SmallInt); - procedure SetHeight(AValue: SmallInt); - published - property Width: SmallInt read GetWidth write SetWidth; - property Height: SmallInt read GetHeight write SetHeight; - end; - TGump = class(TMulBlock) - constructor Create(AData: TStream; AIndex: TGumpIndex); overload; - constructor Create(AWidth, AHeight: Integer); overload; - destructor Destroy; override; - function Clone: TGump; override; - function GetSize: Integer; override; - procedure Write(AData: TStream); override; - procedure RefreshBuffer; - protected - FGraphic: TSingleImage; - FBuffer: TStream; - published - property Graphic: TSingleImage read FGraphic; - end; - -implementation - -type - PWordArray = ^TWordArray; - TWordArray = array[0..16383] of Word; - -{ TGumpIndex } - -function TGumpIndex.GetHeight: SmallInt; -var - sizeInfo: LongInt; - sizeInfoW: array[0..1] of SmallInt absolute sizeInfo; -begin - sizeInfo := FVarious; - Result := sizeInfoW[0]; -end; - -function TGumpIndex.GetWidth: SmallInt; -var - sizeInfo: LongInt; - sizeInfoW: array[0..1] of SmallInt absolute sizeInfo; -begin - sizeInfo := FVarious; - Result := sizeInfoW[1]; -end; - -procedure TGumpIndex.SetHeight(AValue: SmallInt); -var - sizeInfo: LongInt; - sizeInfoW: array[0..1] of SmallInt absolute sizeInfo; -begin - sizeInfo := FVarious; - sizeInfoW[0] := AValue; - FVarious := sizeInfo; -end; - -procedure TGumpIndex.SetWidth(AValue: SmallInt); -var - sizeInfo: LongInt; - sizeInfoW: array[0..1] of SmallInt absolute sizeInfo; -begin - sizeInfo := FVarious; - sizeInfoW[1] := AValue; - FVarious := sizeInfo; -end; - -{ TGump } - -constructor TGump.Create(AData: TStream; AIndex: TGumpIndex); -var - iCurrentHeight, iCurrentWidth, i: Integer; - RowLookup: array of integer; - Offset: Integer; - Value, Run: Word; - block: TMemoryStream; -begin - inherited Create; - FGraphic := TSingleImage.CreateFromParams(AIndex.Width, AIndex.Height, ifA1R5G5B5); - FBuffer := TMemoryStream.Create; - SetLength(RowLookup, AIndex.Height); - if assigned(AData) then - begin - AData.Position := AIndex.Lookup; - block := TMemoryStream.Create; - block.CopyFrom(AData, AIndex.Size); - block.Position := 0; - for i := 0 to AIndex.Height - 1 do - begin - block.Read(Offset, SizeOf(Integer)); - RowLookup[i] := Offset * 4; - end; - for iCurrentHeight := 0 to AIndex.Height - 1 do - begin - block.Position := RowLookup[iCurrentHeight]; - iCurrentWidth := 0; - while iCurrentWidth < AIndex.Width do - begin - block.Read(Value, SizeOf(Word)); - block.Read(Run, SizeOf(Word)); - if Value > 0 then Value := Value or $8000; //Set alpha bit of non-black colors - for i := 0 to Run - 1 do - PWordArray(FGraphic.Bits + iCurrentHeight * AIndex.Width * 2)^[iCurrentWidth + i] := Value; - inc(iCurrentWidth, Run); - end; - end; - block.Free; - end; - FGraphic.Format := ifA8R8G8B8; -end; - -constructor TGump.Create(AWidth, AHeight: Integer); -begin - {TODO : WARNING! Width and Height got switched since MulEditor!} - inherited Create; - FGraphic := TSingleImage.CreateFromParams(AWidth, AHeight, ifA8R8G8B8); - FBuffer := TMemoryStream.Create; -end; - -destructor TGump.Destroy; -begin - if assigned(FGraphic) then FGraphic.Free; - if assigned(FBuffer) then FBuffer.Free; - inherited Destroy; -end; - -function TGump.Clone: TGump; -begin - Result := TGump.Create(FGraphic.Width, FGraphic.Height); - Result.FGraphic.Assign(FGraphic); -end; - -procedure TGump.Write(AData: TStream); -begin - FBuffer.Position := 0; - AData.CopyFrom(FBuffer, FBuffer.Size); -end; - -function TGump.GetSize: Integer; -begin - RefreshBuffer; - Result := FBuffer.Size; -end; - -procedure TGump.RefreshBuffer; -var - argbGraphic: TSingleImage; - colorBuffer: PWordArray; - runBuffer: array of Word; - offsetBuffer: array of Integer; - currentColor, currentRun: Integer; - iCurrentHeight, i: Integer; -begin - argbGraphic := TSingleImage.CreateFromImage(FGraphic); - argbGraphic.Format := ifA1R5G5B5; - SetLength(runBuffer, argbGraphic.Width); - SetLength(offsetBuffer, argbGraphic.Height); - FBuffer.Size := argbGraphic.Height * SizeOf(Integer); - FBuffer.Position := FBuffer.Size; - for iCurrentHeight := 0 to argbGraphic.Height - 1 do - begin - colorBuffer := argbGraphic.Bits + iCurrentHeight * argbGraphic.Width * 2; - for i := 0 to argbGraphic.Width - 1 do - begin - runBuffer[i] := 1; - colorBuffer^[i] := colorBuffer^[i] and not $8000; //eleminate alpha bit - end; - currentRun := 0; - currentColor := colorBuffer^[0]; - for i := 1 to argbGraphic.Width - 1 do - begin - if colorBuffer^[i] = currentColor then - Inc(runBuffer[currentRun]) - else - Inc(currentRun); - currentColor := colorBuffer^[i]; - end; - - offsetBuffer[iCurrentHeight] := FBuffer.Position div 4; - currentColor := 0; - for i := 0 to currentRun do - begin - FBuffer.Write(colorBuffer^[currentColor], SizeOf(Word)); - FBuffer.Write(runBuffer[i], SizeOf(Word)); - Inc(currentColor, runBuffer[i]); - end; - end; - FBuffer.Position := 0; - for i := 0 to argbGraphic.Height - 1 do FBuffer.Write(offsetBuffer[i], SizeOf(Integer)); - argbGraphic.Free; -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2007 Andreas Schneider + *) +unit UGump; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, Imaging, ImagingTypes, ImagingClasses, UMulBlock, UGenericIndex; + +type + TGumpIndex = class(TGenericIndex) + protected + function GetWidth: SmallInt; + function GetHeight: SmallInt; + procedure SetWidth(AValue: SmallInt); + procedure SetHeight(AValue: SmallInt); + published + property Width: SmallInt read GetWidth write SetWidth; + property Height: SmallInt read GetHeight write SetHeight; + end; + TGump = class(TMulBlock) + constructor Create(AData: TStream; AIndex: TGumpIndex); overload; + constructor Create(AWidth, AHeight: Integer); overload; + destructor Destroy; override; + function Clone: TGump; override; + function GetSize: Integer; override; + procedure Write(AData: TStream); override; + procedure RefreshBuffer; + protected + FGraphic: TSingleImage; + FBuffer: TStream; + published + property Graphic: TSingleImage read FGraphic; + end; + +implementation + +type + PWordArray = ^TWordArray; + TWordArray = array[0..16383] of Word; + +{ TGumpIndex } + +function TGumpIndex.GetHeight: SmallInt; +var + sizeInfo: LongInt; + sizeInfoW: array[0..1] of SmallInt absolute sizeInfo; +begin + sizeInfo := FVarious; + Result := sizeInfoW[0]; +end; + +function TGumpIndex.GetWidth: SmallInt; +var + sizeInfo: LongInt; + sizeInfoW: array[0..1] of SmallInt absolute sizeInfo; +begin + sizeInfo := FVarious; + Result := sizeInfoW[1]; +end; + +procedure TGumpIndex.SetHeight(AValue: SmallInt); +var + sizeInfo: LongInt; + sizeInfoW: array[0..1] of SmallInt absolute sizeInfo; +begin + sizeInfo := FVarious; + sizeInfoW[0] := AValue; + FVarious := sizeInfo; +end; + +procedure TGumpIndex.SetWidth(AValue: SmallInt); +var + sizeInfo: LongInt; + sizeInfoW: array[0..1] of SmallInt absolute sizeInfo; +begin + sizeInfo := FVarious; + sizeInfoW[1] := AValue; + FVarious := sizeInfo; +end; + +{ TGump } + +constructor TGump.Create(AData: TStream; AIndex: TGumpIndex); +var + iCurrentHeight, iCurrentWidth, i: Integer; + RowLookup: array of integer; + Offset: Integer; + Value, Run: Word; + block: TMemoryStream; +begin + inherited Create; + FGraphic := TSingleImage.CreateFromParams(AIndex.Width, AIndex.Height, ifA1R5G5B5); + FBuffer := TMemoryStream.Create; + SetLength(RowLookup, AIndex.Height); + if assigned(AData) then + begin + AData.Position := AIndex.Lookup; + block := TMemoryStream.Create; + block.CopyFrom(AData, AIndex.Size); + block.Position := 0; + for i := 0 to AIndex.Height - 1 do + begin + block.Read(Offset, SizeOf(Integer)); + RowLookup[i] := Offset * 4; + end; + for iCurrentHeight := 0 to AIndex.Height - 1 do + begin + block.Position := RowLookup[iCurrentHeight]; + iCurrentWidth := 0; + while iCurrentWidth < AIndex.Width do + begin + block.Read(Value, SizeOf(Word)); + block.Read(Run, SizeOf(Word)); + if Value > 0 then Value := Value or $8000; //Set alpha bit of non-black colors + for i := 0 to Run - 1 do + PWordArray(FGraphic.Bits + iCurrentHeight * AIndex.Width * 2)^[iCurrentWidth + i] := Value; + inc(iCurrentWidth, Run); + end; + end; + block.Free; + end; + FGraphic.Format := ifA8R8G8B8; +end; + +constructor TGump.Create(AWidth, AHeight: Integer); +begin + {TODO : WARNING! Width and Height got switched since MulEditor!} + inherited Create; + FGraphic := TSingleImage.CreateFromParams(AWidth, AHeight, ifA8R8G8B8); + FBuffer := TMemoryStream.Create; +end; + +destructor TGump.Destroy; +begin + if assigned(FGraphic) then FGraphic.Free; + if assigned(FBuffer) then FBuffer.Free; + inherited Destroy; +end; + +function TGump.Clone: TGump; +begin + Result := TGump.Create(FGraphic.Width, FGraphic.Height); + Result.FGraphic.Assign(FGraphic); +end; + +procedure TGump.Write(AData: TStream); +begin + FBuffer.Position := 0; + AData.CopyFrom(FBuffer, FBuffer.Size); +end; + +function TGump.GetSize: Integer; +begin + RefreshBuffer; + Result := FBuffer.Size; +end; + +procedure TGump.RefreshBuffer; +var + argbGraphic: TSingleImage; + colorBuffer: PWordArray; + runBuffer: array of Word; + offsetBuffer: array of Integer; + currentColor, currentRun: Integer; + iCurrentHeight, i: Integer; +begin + argbGraphic := TSingleImage.CreateFromImage(FGraphic); + argbGraphic.Format := ifA1R5G5B5; + SetLength(runBuffer, argbGraphic.Width); + SetLength(offsetBuffer, argbGraphic.Height); + FBuffer.Size := argbGraphic.Height * SizeOf(Integer); + FBuffer.Position := FBuffer.Size; + for iCurrentHeight := 0 to argbGraphic.Height - 1 do + begin + colorBuffer := argbGraphic.Bits + iCurrentHeight * argbGraphic.Width * 2; + for i := 0 to argbGraphic.Width - 1 do + begin + runBuffer[i] := 1; + colorBuffer^[i] := colorBuffer^[i] and not $8000; //eleminate alpha bit + end; + currentRun := 0; + currentColor := colorBuffer^[0]; + for i := 1 to argbGraphic.Width - 1 do + begin + if colorBuffer^[i] = currentColor then + Inc(runBuffer[currentRun]) + else + Inc(currentRun); + currentColor := colorBuffer^[i]; + end; + + offsetBuffer[iCurrentHeight] := FBuffer.Position div 4; + currentColor := 0; + for i := 0 to currentRun do + begin + FBuffer.Write(colorBuffer^[currentColor], SizeOf(Word)); + FBuffer.Write(runBuffer[i], SizeOf(Word)); + Inc(currentColor, runBuffer[i]); + end; + end; + FBuffer.Position := 0; + for i := 0 to argbGraphic.Height - 1 do FBuffer.Write(offsetBuffer[i], SizeOf(Integer)); + argbGraphic.Free; +end; + +end. + diff --git a/UOLib/UHue.pas b/UOLib/UHue.pas index 2cd8e44..4404a1e 100644 --- a/UOLib/UHue.pas +++ b/UOLib/UHue.pas @@ -1,219 +1,219 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2009 Andreas Schneider - *) -unit UHue; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes, Graphics, UMulBlock; - -type - - TColorTable = array[0..31] of Word; - - { THue } - - THue = class(TMulBlock) - constructor Create(AData: TStream); - function Clone: THue; override; - function GetSize: Integer; override; - procedure Write(AData: TStream); override; - protected - FColorTable: TColorTable; - FTableStart: Word; - FTableEnd: Word; - FName: string; - procedure SetName(AValue: string); - function GetName: string; - public - property ColorTable: TColorTable read FColorTable write FColorTable; - property TableStart: Word read FTableStart write FTableStart; - property TableEnd: Word read FTableEnd write FTableEnd; - property Name: string read GetName write SetName; - end; - - THueEntries = array[0..7] of THue; - - { THueGroup } - - THueGroup = class(TMulBlock) - constructor Create(AData: TStream); - destructor Destroy; override; - function Clone: THueGroup; override; - function GetSize: Integer; override; - procedure Write(AData: TStream); override; - protected - FHeader: LongWord; - FHueEntries: THueEntries; - function GetHueEntry(AIndex: Integer): THue; - procedure SetHueEntry(AIndex: Integer; AValue: THue); - public - property Header: LongWord read FHeader write FHeader; - property HueEntries[Index: Integer]: THue read GetHueEntry write SetHueEntry; - end; - -implementation - -{ THue } - -function THue.Clone: THue; -var - i: Integer; -begin - Result := THue.Create(nil); - for i := 0 to 31 do - Result.FColorTable[i] := FColorTable[i]; - Result.FTableStart := FTableStart; - Result.FTableEnd := FTableEnd; - Result.FName := FName; -end; - -constructor THue.Create(AData: TStream); -var - i: Integer; - buffer: TMemoryStream; - color: Word; -begin - SetLength(FName, 20); - if AData <> nil then - begin - buffer := TMemoryStream.Create; - buffer.CopyFrom(AData, 88); - buffer.Position := 0; - for i := 0 to 31 do - begin - buffer.Read(color, SizeOf(Word)); - FColorTable[i] := color; - end; - buffer.Read(FTableStart, SizeOf(Word)); - buffer.Read(FTableEnd, SizeOf(Word)); - buffer.Read(PChar(FName)^, 20); - buffer.Free; - end; -end; - -function THue.GetName: string; -begin - Result := Trim(FName); -end; - -function THue.GetSize: Integer; -begin - Result := 88; -end; - -procedure THue.SetName(AValue: string); -begin - FName := AValue; - SetLength(FName, 20); -end; - -procedure THue.Write(AData: TStream); -var - i: Integer; - color: Word; -begin - SetLength(FName, 20); - for i := 0 to 31 do - begin - color := FColorTable[i]; - AData.Write(color, SizeOf(Word)); - end; - AData.Write(FTableStart, SizeOf(Word)); - AData.Write(FTableEnd, SizeOf(Word)); - AData.Write(PChar(FName)^, 20); -end; - -{ THueGroup } - -function THueGroup.Clone: THueGroup; -var - i: Integer; -begin - Result := THueGroup.Create(nil); - Result.FHeader := FHeader; - for i := 0 to 7 do - Result.SetHueEntry(i, FHueEntries[i].Clone); -end; - -constructor THueGroup.Create(AData: TStream); -var - i: Integer; - buffer: TMemoryStream; -begin - if AData <> nil then - begin - buffer := TMemoryStream.Create; - buffer.CopyFrom(AData, 708); - buffer.Position := 0; - buffer.Read(FHeader, SizeOf(LongWord)); - end else - buffer := nil; - - for i := 0 to 7 do - FHueEntries[i] := THue.Create(buffer); - - buffer.Free; -end; - -destructor THueGroup.Destroy; -var - i: Integer; -begin - for i := 0 to 7 do - FreeAndNil(FHueEntries[i]); - inherited Destroy; -end; - -function THueGroup.GetHueEntry(AIndex: Integer): THue; -begin - Result := FHueEntries[AIndex]; -end; - -function THueGroup.GetSize: Integer; -begin - Result := 708; -end; - -procedure THueGroup.SetHueEntry(AIndex: Integer; AValue: THue); -begin - FreeAndNil(FHueEntries[AIndex]); - FHueEntries[AIndex] := AValue; -end; - -procedure THueGroup.Write(AData: TStream); -var - i: Integer; -begin - AData.Write(FHeader, SizeOf(LongWord)); - for i := 0 to 7 do - FHueEntries[i].Write(AData); -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2009 Andreas Schneider + *) +unit UHue; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Classes, Graphics, UMulBlock; + +type + + TColorTable = array[0..31] of Word; + + { THue } + + THue = class(TMulBlock) + constructor Create(AData: TStream); + function Clone: THue; override; + function GetSize: Integer; override; + procedure Write(AData: TStream); override; + protected + FColorTable: TColorTable; + FTableStart: Word; + FTableEnd: Word; + FName: string; + procedure SetName(AValue: string); + function GetName: string; + public + property ColorTable: TColorTable read FColorTable write FColorTable; + property TableStart: Word read FTableStart write FTableStart; + property TableEnd: Word read FTableEnd write FTableEnd; + property Name: string read GetName write SetName; + end; + + THueEntries = array[0..7] of THue; + + { THueGroup } + + THueGroup = class(TMulBlock) + constructor Create(AData: TStream); + destructor Destroy; override; + function Clone: THueGroup; override; + function GetSize: Integer; override; + procedure Write(AData: TStream); override; + protected + FHeader: LongWord; + FHueEntries: THueEntries; + function GetHueEntry(AIndex: Integer): THue; + procedure SetHueEntry(AIndex: Integer; AValue: THue); + public + property Header: LongWord read FHeader write FHeader; + property HueEntries[Index: Integer]: THue read GetHueEntry write SetHueEntry; + end; + +implementation + +{ THue } + +function THue.Clone: THue; +var + i: Integer; +begin + Result := THue.Create(nil); + for i := 0 to 31 do + Result.FColorTable[i] := FColorTable[i]; + Result.FTableStart := FTableStart; + Result.FTableEnd := FTableEnd; + Result.FName := FName; +end; + +constructor THue.Create(AData: TStream); +var + i: Integer; + buffer: TMemoryStream; + color: Word; +begin + SetLength(FName, 20); + if AData <> nil then + begin + buffer := TMemoryStream.Create; + buffer.CopyFrom(AData, 88); + buffer.Position := 0; + for i := 0 to 31 do + begin + buffer.Read(color, SizeOf(Word)); + FColorTable[i] := color; + end; + buffer.Read(FTableStart, SizeOf(Word)); + buffer.Read(FTableEnd, SizeOf(Word)); + buffer.Read(PChar(FName)^, 20); + buffer.Free; + end; +end; + +function THue.GetName: string; +begin + Result := Trim(FName); +end; + +function THue.GetSize: Integer; +begin + Result := 88; +end; + +procedure THue.SetName(AValue: string); +begin + FName := AValue; + SetLength(FName, 20); +end; + +procedure THue.Write(AData: TStream); +var + i: Integer; + color: Word; +begin + SetLength(FName, 20); + for i := 0 to 31 do + begin + color := FColorTable[i]; + AData.Write(color, SizeOf(Word)); + end; + AData.Write(FTableStart, SizeOf(Word)); + AData.Write(FTableEnd, SizeOf(Word)); + AData.Write(PChar(FName)^, 20); +end; + +{ THueGroup } + +function THueGroup.Clone: THueGroup; +var + i: Integer; +begin + Result := THueGroup.Create(nil); + Result.FHeader := FHeader; + for i := 0 to 7 do + Result.SetHueEntry(i, FHueEntries[i].Clone); +end; + +constructor THueGroup.Create(AData: TStream); +var + i: Integer; + buffer: TMemoryStream; +begin + if AData <> nil then + begin + buffer := TMemoryStream.Create; + buffer.CopyFrom(AData, 708); + buffer.Position := 0; + buffer.Read(FHeader, SizeOf(LongWord)); + end else + buffer := nil; + + for i := 0 to 7 do + FHueEntries[i] := THue.Create(buffer); + + buffer.Free; +end; + +destructor THueGroup.Destroy; +var + i: Integer; +begin + for i := 0 to 7 do + FreeAndNil(FHueEntries[i]); + inherited Destroy; +end; + +function THueGroup.GetHueEntry(AIndex: Integer): THue; +begin + Result := FHueEntries[AIndex]; +end; + +function THueGroup.GetSize: Integer; +begin + Result := 708; +end; + +procedure THueGroup.SetHueEntry(AIndex: Integer; AValue: THue); +begin + FreeAndNil(FHueEntries[AIndex]); + FHueEntries[AIndex] := AValue; +end; + +procedure THueGroup.Write(AData: TStream); +var + i: Integer; +begin + AData.Write(FHeader, SizeOf(LongWord)); + for i := 0 to 7 do + FHueEntries[i].Write(AData); +end; + +end. + diff --git a/UOLib/ULight.pas b/UOLib/ULight.pas index b4f41c4..dc14357 100644 --- a/UOLib/ULight.pas +++ b/UOLib/ULight.pas @@ -1,121 +1,121 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2009 Andreas Schneider - *) -unit ULight; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, Imaging, ImagingClasses, ImagingTypes, UMulBlock, - UGenericIndex; - -type - - { TLight } - - TLight = class(TMulBlock) - constructor Create(AData: TStream; AIndex: TGenericIndex); - destructor Destroy; override; - function Clone: TLight; override; - function GetSize: Integer; override; - procedure Write(AData: TStream); override; - protected - FGraphic: TSingleImage; - public - property Graphic: TSingleImage read FGraphic; - end; - -implementation - -{ TLight } - -constructor TLight.Create(AData: TStream; AIndex: TGenericIndex); -var - buffer: TMemoryStream; - Width, Height: Word; - color: Byte; - color32: TColor32Rec; - x, y: Integer; -begin - if (AIndex <> nil) and (AIndex.Lookup > -1) and (AIndex.Size > 0) then - begin - Width := word(AIndex.Various shr 16); - Height := AIndex.Various and $FFFF; - FGraphic := TSingleImage.CreateFromParams(Width, Height, ifA8R8G8B8); - - if AData <> nil then - begin - AData.Position := AIndex.Lookup; - buffer := TMemoryStream.Create; - buffer.CopyFrom(AData, AIndex.Size); - buffer.Position := 0; - for y := 0 to Height - 1 do - for x := 0 to Width - 1 do - begin - buffer.Read(color, SizeOf(byte)); - color32.R := color * 8; - color32.G := color32.R; - color32.B := color32.R; - if color > 0 then - color32.A := 255 - else - color32.A := 0; - PColor32(FGraphic.PixelPointers[x, y])^ := color32.Color; - end; - buffer.Free; - end; - end; - - if FGraphic = nil then - FGraphic := TSingleImage.CreateFromParams(0, 0, ifA8R8G8B8); -end; - -destructor TLight.Destroy; -begin - FreeAndNil(FGraphic); - inherited Destroy; -end; - -function TLight.Clone: TLight; -begin - Result := TLight.Create(nil, nil); - Result.Graphic.Assign(FGraphic); -end; - -function TLight.GetSize: Integer; -begin - Result := 0; - raise Exception.Create('Not implemented: TLight.GetSize'); -end; - -procedure TLight.Write(AData: TStream); -begin - raise Exception.Create('Not implemented: TLight.Write'); -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2009 Andreas Schneider + *) +unit ULight; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Imaging, ImagingClasses, ImagingTypes, UMulBlock, + UGenericIndex; + +type + + { TLight } + + TLight = class(TMulBlock) + constructor Create(AData: TStream; AIndex: TGenericIndex); + destructor Destroy; override; + function Clone: TLight; override; + function GetSize: Integer; override; + procedure Write(AData: TStream); override; + protected + FGraphic: TSingleImage; + public + property Graphic: TSingleImage read FGraphic; + end; + +implementation + +{ TLight } + +constructor TLight.Create(AData: TStream; AIndex: TGenericIndex); +var + buffer: TMemoryStream; + Width, Height: Word; + color: Byte; + color32: TColor32Rec; + x, y: Integer; +begin + if (AIndex <> nil) and (AIndex.Lookup > -1) and (AIndex.Size > 0) then + begin + Width := word(AIndex.Various shr 16); + Height := AIndex.Various and $FFFF; + FGraphic := TSingleImage.CreateFromParams(Width, Height, ifA8R8G8B8); + + if AData <> nil then + begin + AData.Position := AIndex.Lookup; + buffer := TMemoryStream.Create; + buffer.CopyFrom(AData, AIndex.Size); + buffer.Position := 0; + for y := 0 to Height - 1 do + for x := 0 to Width - 1 do + begin + buffer.Read(color, SizeOf(byte)); + color32.R := color * 8; + color32.G := color32.R; + color32.B := color32.R; + if color > 0 then + color32.A := 255 + else + color32.A := 0; + PColor32(FGraphic.PixelPointers[x, y])^ := color32.Color; + end; + buffer.Free; + end; + end; + + if FGraphic = nil then + FGraphic := TSingleImage.CreateFromParams(0, 0, ifA8R8G8B8); +end; + +destructor TLight.Destroy; +begin + FreeAndNil(FGraphic); + inherited Destroy; +end; + +function TLight.Clone: TLight; +begin + Result := TLight.Create(nil, nil); + Result.Graphic.Assign(FGraphic); +end; + +function TLight.GetSize: Integer; +begin + Result := 0; + raise Exception.Create('Not implemented: TLight.GetSize'); +end; + +procedure TLight.Write(AData: TStream); +begin + raise Exception.Create('Not implemented: TLight.Write'); +end; + +end. + diff --git a/UOLib/ULocalization.pas b/UOLib/ULocalization.pas index 3bfb7f5..4946e51 100644 --- a/UOLib/ULocalization.pas +++ b/UOLib/ULocalization.pas @@ -1,92 +1,92 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2007 Andreas Schneider - *) -unit ULocalization; - -interface - -uses - Classes; - -type - TLocalizationEntry = class(TObject) - constructor Create; - constructor Deserialize(Data: TStream); - procedure Serialize(Data: TStream); - function GetSize: Integer; - private - FNumber: Integer; - FUnknown: Byte; - FText: string; - published - property Number: Integer read FNumber write FNumber; - property Unknown: Byte read FUnknown write FUnknown; - property Text: string read FText write FText; - end; - -implementation - -constructor TLocalizationEntry.Create; -begin - FNumber := 0; - FUnknown := 0; - FText := ''; -end; - -constructor TLocalizationEntry.Deserialize(Data: TStream); -var - length: SmallInt; -begin - if assigned(Data) then - begin - Data.Read(FNumber, SizeOf(Integer)); - Data.Read(FUnknown, SizeOf(Byte)); - Data.Read(length, SizeOf(SmallInt)); - SetLength(FText, length); - Data.Read(PChar(FText)^, length); - FText := UTF8Decode(FText); - end; -end; - -procedure TLocalizationEntry.Serialize(Data: TStream); -var - iLength: SmallInt; - text: string; -begin - Data.Write(FNumber, SizeOf(Integer)); - Data.Write(FUnknown, SizeOf(Byte)); - text := UTF8Encode(FText); - iLength := Length(text); - Data.Write(iLength, SizeOf(SmallInt)); - Data.Write(PChar(text)^, iLength); -end; - -function TLocalizationEntry.GetSize: Integer; -begin - Result := SizeOf(Integer) + SizeOf(Byte) + SizeOf(SmallInt) + Length(FText); -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2007 Andreas Schneider + *) +unit ULocalization; + +interface + +uses + Classes; + +type + TLocalizationEntry = class(TObject) + constructor Create; + constructor Deserialize(Data: TStream); + procedure Serialize(Data: TStream); + function GetSize: Integer; + private + FNumber: Integer; + FUnknown: Byte; + FText: string; + published + property Number: Integer read FNumber write FNumber; + property Unknown: Byte read FUnknown write FUnknown; + property Text: string read FText write FText; + end; + +implementation + +constructor TLocalizationEntry.Create; +begin + FNumber := 0; + FUnknown := 0; + FText := ''; +end; + +constructor TLocalizationEntry.Deserialize(Data: TStream); +var + length: SmallInt; +begin + if assigned(Data) then + begin + Data.Read(FNumber, SizeOf(Integer)); + Data.Read(FUnknown, SizeOf(Byte)); + Data.Read(length, SizeOf(SmallInt)); + SetLength(FText, length); + Data.Read(PChar(FText)^, length); + FText := UTF8Decode(FText); + end; +end; + +procedure TLocalizationEntry.Serialize(Data: TStream); +var + iLength: SmallInt; + text: string; +begin + Data.Write(FNumber, SizeOf(Integer)); + Data.Write(FUnknown, SizeOf(Byte)); + text := UTF8Encode(FText); + iLength := Length(text); + Data.Write(iLength, SizeOf(SmallInt)); + Data.Write(PChar(text)^, iLength); +end; + +function TLocalizationEntry.GetSize: Integer; +begin + Result := SizeOf(Integer) + SizeOf(Byte) + SizeOf(SmallInt) + Length(FText); +end; + +end. + diff --git a/UOLib/UMulBlock.pas b/UOLib/UMulBlock.pas index a6009c7..399fc42 100644 --- a/UOLib/UMulBlock.pas +++ b/UOLib/UMulBlock.pas @@ -1,171 +1,171 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2009 Andreas Schneider - *) -unit UMulBlock; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes; - -type - TMulBlock = class; - TMulBlockChanged = procedure(ABlock: TMulBlock) of object; - - { TMulBlockEventHandler } - - TMulBlockEventHandler = class - constructor Create; - destructor Destroy; override; - protected - FEvents: TList; - public - procedure RegisterEvent(AEvent: TMulBlockChanged); - procedure UnregisterEvent(AEvent: TMulBlockChanged); - procedure FireEvents(ABlock: TMulBlock); - end; - - { TMulBlock } - - TMulBlock = class - constructor Create; - destructor Destroy; override; - protected - FID: Integer; - FOnChanged: TMulBlockChanged; - FOnFinished: TMulBlockChanged; - FOnDestroy: TMulBlockEventHandler; - public - class procedure Change(ABlock: TMulBlock); virtual; - class procedure Finish(var ABlock: TMulBlock); virtual; - function Clone: TMulBlock; virtual; abstract; - function GetSize: Integer; virtual; abstract; - procedure Write(AData: TStream); virtual; abstract; - property ID: Integer read FID write FID; - property OnChanged: TMulBlockChanged read FOnChanged write FOnChanged; - property OnFinished: TMulBlockChanged read FOnFinished write FOnFinished; - property OnDestroy: TMulBlockEventHandler read FOnDestroy; - end; - -implementation - -type - PMethod = ^TMethod; - -{ TMulBlockEventHandler } - -constructor TMulBlockEventHandler.Create; -begin - inherited Create; - FEvents := TList.Create; -end; - -destructor TMulBlockEventHandler.Destroy; -var - i: Integer; -begin - if FEvents <> nil then - begin - for i := 0 to FEvents.Count - 1 do - Dispose(PMethod(FEvents.Items[i])); - FreeAndNil(FEvents); - end; - inherited Destroy; -end; - -procedure TMulBlockEventHandler.RegisterEvent(AEvent: TMulBlockChanged); -var - eventInfo: PMethod; -begin - //UnregisterEvent(AEvent); - New(eventInfo); - eventInfo^.Code := TMethod(AEvent).Code; - eventInfo^.Data := TMethod(AEvent).Data; - FEvents.Add(eventInfo); -end; - -procedure TMulBlockEventHandler.UnregisterEvent(AEvent: TMulBlockChanged); -var - i: Integer; - - function RemoveEntry: Boolean; - begin - Dispose(PMethod(FEvents.Items[i])); - FEvents.Delete(i); - Result := True; - end; - -begin - i := 0; - while (i < FEvents.Count) and ((TMethod(AEvent).Code <> TMethod(FEvents.Items[i]^).Code) or (TMethod(AEvent).Data <> TMethod(FEvents.Items[i]^).Data) or not RemoveEntry) do - Inc(i); -end; - -procedure TMulBlockEventHandler.FireEvents(ABlock: TMulBlock); -var - i: Integer; -begin - for i := 0 to FEvents.Count - 1 do - TMulBlockChanged(FEvents.Items[i]^)(ABlock); -end; - -{ TMulBlock } - -constructor TMulBlock.Create; -begin - inherited Create; - FOnDestroy := TMulBlockEventHandler.Create; -end; - -destructor TMulBlock.Destroy; -begin - if FOnDestroy <> nil then - begin - FOnDestroy.FireEvents(Self); - FreeAndNil(FOnDestroy); - end; - inherited Destroy; -end; - -class procedure TMulBlock.Change(ABlock: TMulBlock); -begin - if ABlock <> nil then - begin - if ABlock.OnChanged <> nil then ABlock.OnChanged(ABlock); - end; -end; - -class procedure TMulBlock.Finish(var ABlock: TMulBlock); -begin - if ABlock <> nil then - begin - if ABlock.OnFinished <> nil then ABlock.OnFinished(ABlock) else ABlock.Free; - ABlock := nil; - end; -end; - -end. +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2009 Andreas Schneider + *) +unit UMulBlock; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Classes; + +type + TMulBlock = class; + TMulBlockChanged = procedure(ABlock: TMulBlock) of object; + + { TMulBlockEventHandler } + + TMulBlockEventHandler = class + constructor Create; + destructor Destroy; override; + protected + FEvents: TList; + public + procedure RegisterEvent(AEvent: TMulBlockChanged); + procedure UnregisterEvent(AEvent: TMulBlockChanged); + procedure FireEvents(ABlock: TMulBlock); + end; + + { TMulBlock } + + TMulBlock = class + constructor Create; + destructor Destroy; override; + protected + FID: Integer; + FOnChanged: TMulBlockChanged; + FOnFinished: TMulBlockChanged; + FOnDestroy: TMulBlockEventHandler; + public + class procedure Change(ABlock: TMulBlock); virtual; + class procedure Finish(var ABlock: TMulBlock); virtual; + function Clone: TMulBlock; virtual; abstract; + function GetSize: Integer; virtual; abstract; + procedure Write(AData: TStream); virtual; abstract; + property ID: Integer read FID write FID; + property OnChanged: TMulBlockChanged read FOnChanged write FOnChanged; + property OnFinished: TMulBlockChanged read FOnFinished write FOnFinished; + property OnDestroy: TMulBlockEventHandler read FOnDestroy; + end; + +implementation + +type + PMethod = ^TMethod; + +{ TMulBlockEventHandler } + +constructor TMulBlockEventHandler.Create; +begin + inherited Create; + FEvents := TList.Create; +end; + +destructor TMulBlockEventHandler.Destroy; +var + i: Integer; +begin + if FEvents <> nil then + begin + for i := 0 to FEvents.Count - 1 do + Dispose(PMethod(FEvents.Items[i])); + FreeAndNil(FEvents); + end; + inherited Destroy; +end; + +procedure TMulBlockEventHandler.RegisterEvent(AEvent: TMulBlockChanged); +var + eventInfo: PMethod; +begin + //UnregisterEvent(AEvent); + New(eventInfo); + eventInfo^.Code := TMethod(AEvent).Code; + eventInfo^.Data := TMethod(AEvent).Data; + FEvents.Add(eventInfo); +end; + +procedure TMulBlockEventHandler.UnregisterEvent(AEvent: TMulBlockChanged); +var + i: Integer; + + function RemoveEntry: Boolean; + begin + Dispose(PMethod(FEvents.Items[i])); + FEvents.Delete(i); + Result := True; + end; + +begin + i := 0; + while (i < FEvents.Count) and ((TMethod(AEvent).Code <> TMethod(FEvents.Items[i]^).Code) or (TMethod(AEvent).Data <> TMethod(FEvents.Items[i]^).Data) or not RemoveEntry) do + Inc(i); +end; + +procedure TMulBlockEventHandler.FireEvents(ABlock: TMulBlock); +var + i: Integer; +begin + for i := 0 to FEvents.Count - 1 do + TMulBlockChanged(FEvents.Items[i]^)(ABlock); +end; + +{ TMulBlock } + +constructor TMulBlock.Create; +begin + inherited Create; + FOnDestroy := TMulBlockEventHandler.Create; +end; + +destructor TMulBlock.Destroy; +begin + if FOnDestroy <> nil then + begin + FOnDestroy.FireEvents(Self); + FreeAndNil(FOnDestroy); + end; + inherited Destroy; +end; + +class procedure TMulBlock.Change(ABlock: TMulBlock); +begin + if ABlock <> nil then + begin + if ABlock.OnChanged <> nil then ABlock.OnChanged(ABlock); + end; +end; + +class procedure TMulBlock.Finish(var ABlock: TMulBlock); +begin + if ABlock <> nil then + begin + if ABlock.OnFinished <> nil then ABlock.OnFinished(ABlock) else ABlock.Free; + ABlock := nil; + end; +end; + +end. diff --git a/UOLib/UMultiMap.pas b/UOLib/UMultiMap.pas index 6a76632..3998e76 100644 --- a/UOLib/UMultiMap.pas +++ b/UOLib/UMultiMap.pas @@ -1,157 +1,157 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2007 Andreas Schneider - *) -unit UMultiMap; - -interface - -uses - Classes, Graphics, UProgress; - -type - TMultiMap = class(TObject) - constructor Create(Data: TStream; OnProgress: TOnProgressEvent = nil); overload; - constructor Create(Height, Width: Integer; OnProgress: TOnProgressEvent = nil); overload; - destructor Destroy; override; - procedure Write(Data: TStream); - protected - FGraphic: TBitmap; - FOnProgress: TOnProgressEvent; - public - property Graphic: TBitmap read FGraphic; - property OnProgress: TOnProgressEvent read FOnProgress write FOnProgress; - end; - -implementation - -{ TMultiMap } - -constructor TMultiMap.Create(Data: TStream; OnProgress: TOnProgressEvent = nil); -var - height, width: Integer; - x, y, run: Integer; - pixelData: Byte; - color: TColor; -begin - if Assigned(Data) then - begin - Data.Read(width, SizeOf(Integer)); - Data.Read(height, SizeOf(Integer)); - Create(height, width, OnProgress); - if Assigned(FGraphic) then - begin - if Assigned(FOnProgress) then FOnProgress(height, 0); - x := 0; - y := 0; - while y < height do - begin - while (x < width) and (y < height) do - begin - Data.Read(pixelData, SizeOf(Byte)); - if (pixelData and $80) = $80 then color := clBlack else color := clWhite; - for run := 1 to (pixelData and $7F) do - begin - FGraphic.Canvas.Pixels[x,y] := color; - Inc(x); - if x = width then - begin - x := 0; - inc(y); - if Assigned(FOnProgress) then FOnProgress(height, y); - if y = height then Break; - end; - end; //for - end; //while x & y - Inc(y); - if Assigned(FOnProgress) then FOnProgress(height, y); - end; //while y - if Assigned(FOnProgress) then FOnProgress(0, 0); - end; //if assigned - end else - Create(0, 0, OnProgress); -end; - -constructor TMultiMap.Create(Height, Width: Integer; OnProgress: TOnProgressEvent = nil); -begin - FGraphic := TBitmap.Create; - FGraphic.Height := Height; - FGraphic.Width := Width; - FGraphic.PixelFormat := pf1bit; - FGraphic.HandleType := bmDIB; - FOnProgress := OnProgress; -end; - -destructor TMultiMap.Destroy; -begin - if Assigned(FGraphic) then FGraphic.Free; - inherited; -end; - -procedure TMultiMap.Write(Data: TStream); -var - height, width, x, y: Integer; - run: Byte; - state, newState: Boolean; - - procedure DoWrite; - var - pixelData: Byte; - begin - pixelData := run; - if state then pixelData := pixelData or $80; - Data.Write(pixelData, SizeOf(Byte)); - end; - -begin - height := FGraphic.Height; - width := FGraphic.Width; - Data.Write(width, SizeOf(Integer)); - Data.Write(height, SizeOf(Integer)); - run := 0; - state := not (FGraphic.Canvas.Pixels[0,0] = clWhite); - if Assigned(FOnProgress) then FOnProgress(0, 0); - for y := 0 to height - 1 do - begin - for x := 0 to width - 1 do - begin - newState := not (FGraphic.Canvas.Pixels[x,y] = clWhite); - if (state = newState) and (run < $7F) then - begin - inc(run); - end else - begin - DoWrite; - state := newState; - run := 1; - end; - end; - if Assigned(FOnProgress) then FOnProgress(height, y); - end; - if run > 0 then DoWrite; - if Assigned(FOnProgress) then FOnProgress(0, 0); -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2007 Andreas Schneider + *) +unit UMultiMap; + +interface + +uses + Classes, Graphics, UProgress; + +type + TMultiMap = class(TObject) + constructor Create(Data: TStream; OnProgress: TOnProgressEvent = nil); overload; + constructor Create(Height, Width: Integer; OnProgress: TOnProgressEvent = nil); overload; + destructor Destroy; override; + procedure Write(Data: TStream); + protected + FGraphic: TBitmap; + FOnProgress: TOnProgressEvent; + public + property Graphic: TBitmap read FGraphic; + property OnProgress: TOnProgressEvent read FOnProgress write FOnProgress; + end; + +implementation + +{ TMultiMap } + +constructor TMultiMap.Create(Data: TStream; OnProgress: TOnProgressEvent = nil); +var + height, width: Integer; + x, y, run: Integer; + pixelData: Byte; + color: TColor; +begin + if Assigned(Data) then + begin + Data.Read(width, SizeOf(Integer)); + Data.Read(height, SizeOf(Integer)); + Create(height, width, OnProgress); + if Assigned(FGraphic) then + begin + if Assigned(FOnProgress) then FOnProgress(height, 0); + x := 0; + y := 0; + while y < height do + begin + while (x < width) and (y < height) do + begin + Data.Read(pixelData, SizeOf(Byte)); + if (pixelData and $80) = $80 then color := clBlack else color := clWhite; + for run := 1 to (pixelData and $7F) do + begin + FGraphic.Canvas.Pixels[x,y] := color; + Inc(x); + if x = width then + begin + x := 0; + inc(y); + if Assigned(FOnProgress) then FOnProgress(height, y); + if y = height then Break; + end; + end; //for + end; //while x & y + Inc(y); + if Assigned(FOnProgress) then FOnProgress(height, y); + end; //while y + if Assigned(FOnProgress) then FOnProgress(0, 0); + end; //if assigned + end else + Create(0, 0, OnProgress); +end; + +constructor TMultiMap.Create(Height, Width: Integer; OnProgress: TOnProgressEvent = nil); +begin + FGraphic := TBitmap.Create; + FGraphic.Height := Height; + FGraphic.Width := Width; + FGraphic.PixelFormat := pf1bit; + FGraphic.HandleType := bmDIB; + FOnProgress := OnProgress; +end; + +destructor TMultiMap.Destroy; +begin + if Assigned(FGraphic) then FGraphic.Free; + inherited; +end; + +procedure TMultiMap.Write(Data: TStream); +var + height, width, x, y: Integer; + run: Byte; + state, newState: Boolean; + + procedure DoWrite; + var + pixelData: Byte; + begin + pixelData := run; + if state then pixelData := pixelData or $80; + Data.Write(pixelData, SizeOf(Byte)); + end; + +begin + height := FGraphic.Height; + width := FGraphic.Width; + Data.Write(width, SizeOf(Integer)); + Data.Write(height, SizeOf(Integer)); + run := 0; + state := not (FGraphic.Canvas.Pixels[0,0] = clWhite); + if Assigned(FOnProgress) then FOnProgress(0, 0); + for y := 0 to height - 1 do + begin + for x := 0 to width - 1 do + begin + newState := not (FGraphic.Canvas.Pixels[x,y] = clWhite); + if (state = newState) and (run < $7F) then + begin + inc(run); + end else + begin + DoWrite; + state := newState; + run := 1; + end; + end; + if Assigned(FOnProgress) then FOnProgress(height, y); + end; + if run > 0 then DoWrite; + if Assigned(FOnProgress) then FOnProgress(0, 0); +end; + +end. + diff --git a/UOLib/UTexture.pas b/UOLib/UTexture.pas index e1e0afb..f03650d 100644 --- a/UOLib/UTexture.pas +++ b/UOLib/UTexture.pas @@ -1,136 +1,136 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2007 Andreas Schneider - *) -unit UTexture; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, Imaging, ImagingTypes, ImagingClasses, UMulBlock, UGenericIndex; - -type - TTexture = class(TMulBlock) - constructor Create(AData: TStream; AIndex: TGenericIndex); overload; - constructor Create(AExtra: Integer); overload; - destructor Destroy; override; - function Clone: TTexture; override; - function GetSize: Integer; override; - procedure Write(AData: TStream); override; - procedure RefreshBuffer; - protected - FGraphic: TSingleImage; - FBuffer: TStream; - FExtra: Integer; - public - property Graphic: TSingleImage read FGraphic; - property Buffer: TStream read FBuffer; - property Extra: Integer read FExtra write FExtra; - end; - -implementation - -constructor TTexture.Create(AData: TStream; AIndex: TGenericIndex); -var - size: Integer; -begin - FExtra := AIndex.Various; - if FExtra = 0 then - size := 64 - else - size := 128; - FGraphic := TSingleImage.CreateFromParams(size, size, ifX1R5G5B5); - if assigned(AData) then - begin - AData.Position := AIndex.Lookup; - AData.Read(FGraphic.Bits^, size * size * 2); - end; - FGraphic.Format := ifX8R8G8B8; -end; - -constructor TTexture.Create(AExtra: Integer); -var - size: Integer; -begin - FExtra := AExtra; - if AExtra = 0 then - size := 64 - else - size := 128; - FGraphic := TSingleImage.CreateFromParams(size, size, ifX8R8G8B8); - FBuffer := TMemoryStream.Create; -end; - -destructor TTexture.Destroy; -begin - if FGraphic <> nil then FGraphic.Free; - if FBuffer <> nil then FBuffer.Free; - inherited; -end; - -function TTexture.Clone: TTexture; -begin - Result := TTexture.Create(FExtra); - Result.FGraphic.Assign(Self.Graphic); -end; - -procedure TTexture.Write(AData: TStream); -begin - FBuffer.Position := 0; - AData.CopyFrom(FBuffer, FBuffer.Size); -end; - -function TTexture.GetSize: Integer; -begin - RefreshBuffer; - Result := FBuffer.Size -end; - -procedure TTexture.RefreshBuffer; -var - argbGraphic: TSingleImage; -begin - argbGraphic := TSingleImage.CreateFromImage(FGraphic); - argbGraphic.Format := ifX1R5G5B5; - FBuffer.Size := 0; - if (argbGraphic.Height > 0) and (argbGraphic.Width > 0) then - begin - if (argbGraphic.Height < 128) or (argbGraphic.Width < 128) then - begin - FExtra := 0; - argbGraphic.Resize(64, 64, rfNearest); - end else - begin - FExtra := 1; - argbGraphic.Resize(128, 128, rfNearest); - end; - FBuffer.Write(argbGraphic.Bits^, argbGraphic.Height * argbGraphic.Width * 2); - end; - argbGraphic.Free; -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2007 Andreas Schneider + *) +unit UTexture; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, Imaging, ImagingTypes, ImagingClasses, UMulBlock, UGenericIndex; + +type + TTexture = class(TMulBlock) + constructor Create(AData: TStream; AIndex: TGenericIndex); overload; + constructor Create(AExtra: Integer); overload; + destructor Destroy; override; + function Clone: TTexture; override; + function GetSize: Integer; override; + procedure Write(AData: TStream); override; + procedure RefreshBuffer; + protected + FGraphic: TSingleImage; + FBuffer: TStream; + FExtra: Integer; + public + property Graphic: TSingleImage read FGraphic; + property Buffer: TStream read FBuffer; + property Extra: Integer read FExtra write FExtra; + end; + +implementation + +constructor TTexture.Create(AData: TStream; AIndex: TGenericIndex); +var + size: Integer; +begin + FExtra := AIndex.Various; + if FExtra = 0 then + size := 64 + else + size := 128; + FGraphic := TSingleImage.CreateFromParams(size, size, ifX1R5G5B5); + if assigned(AData) then + begin + AData.Position := AIndex.Lookup; + AData.Read(FGraphic.Bits^, size * size * 2); + end; + FGraphic.Format := ifX8R8G8B8; +end; + +constructor TTexture.Create(AExtra: Integer); +var + size: Integer; +begin + FExtra := AExtra; + if AExtra = 0 then + size := 64 + else + size := 128; + FGraphic := TSingleImage.CreateFromParams(size, size, ifX8R8G8B8); + FBuffer := TMemoryStream.Create; +end; + +destructor TTexture.Destroy; +begin + if FGraphic <> nil then FGraphic.Free; + if FBuffer <> nil then FBuffer.Free; + inherited; +end; + +function TTexture.Clone: TTexture; +begin + Result := TTexture.Create(FExtra); + Result.FGraphic.Assign(Self.Graphic); +end; + +procedure TTexture.Write(AData: TStream); +begin + FBuffer.Position := 0; + AData.CopyFrom(FBuffer, FBuffer.Size); +end; + +function TTexture.GetSize: Integer; +begin + RefreshBuffer; + Result := FBuffer.Size +end; + +procedure TTexture.RefreshBuffer; +var + argbGraphic: TSingleImage; +begin + argbGraphic := TSingleImage.CreateFromImage(FGraphic); + argbGraphic.Format := ifX1R5G5B5; + FBuffer.Size := 0; + if (argbGraphic.Height > 0) and (argbGraphic.Width > 0) then + begin + if (argbGraphic.Height < 128) or (argbGraphic.Width < 128) then + begin + FExtra := 0; + argbGraphic.Resize(64, 64, rfNearest); + end else + begin + FExtra := 1; + argbGraphic.Resize(128, 128, rfNearest); + end; + FBuffer.Write(argbGraphic.Bits^, argbGraphic.Height * argbGraphic.Width * 2); + end; + argbGraphic.Free; +end; + +end. + diff --git a/UOLib/UTiledata.pas b/UOLib/UTiledata.pas index f2ac3ef..5844cac 100644 --- a/UOLib/UTiledata.pas +++ b/UOLib/UTiledata.pas @@ -1,376 +1,376 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2009 Andreas Schneider - *) -unit UTiledata; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, UMulBlock; - -const - LandTileDataSize = 26; - LandTileGroupSize = 4 + 32 * LandTileDataSize; - StaticTileDataSize = 37; - StaticTileGroupSize = 4 + 32 * StaticTileDataSize; - -type - TTileDataFlag = (tdfBackground, tdfWeapon, tdfTransparent, tdfTranslucent, - tdfWall, tdfDamaging, tdfImpassable, tdfWet, tdfUnknown1, - tdfSurface, tdfBridge, tdfGeneric, tdfWindow, tdfNoShoot, - tdfArticleA, tdfArticleAn, tdfInternal, tdfFoliage, - tdfPartialHue, tdfUnknown2, tdfMap, tdfContainer, - tdfWearable, tdfLightSource, tdfAnimation, tdfNoDiagonal, - tdfArtUsed, tdfArmor, tdfRoof, tdfDoor, tdfStairBack, - tdfStairRight); - TTileDataFlags = set of TTileDataFlag; - - { TTiledata } - - TTiledata = class(TMulBlock) - protected - FFlags: TTileDataFlags; - FTileName: string; - public - property Flags: TTileDataFlags read FFlags write FFlags; - property TileName: string read FTileName write FTileName; - end; - - { TLandTiledata } - - TLandTiledata = class(TTiledata) - constructor Create(AData: TStream); - destructor Destroy; override; - function Clone: TLandTiledata; override; - function GetSize: Integer; override; - procedure Write(AData: TStream); override; - protected - FTextureID: Word; - public - property TextureID: Word read FTextureID write FTextureID; - end; - - { TStaticTiledata } - - TStaticTiledata = class(TTiledata) - constructor Create(AData: TStream); - destructor Destroy; override; - function Clone: TStaticTiledata; override; - function GetSize: Integer; override; - procedure Write(AData: TStream); override; - protected - FWeight: Byte; - FQuality: Byte; - FUnknown1: Word; - FUnknown2: Byte; - FQuantity: Byte; - FAnimID: Word; - FUnknown3: Byte; - FHue: Byte; - FUnknown4: Word; - FHeight: Byte; - public - property Weight: Byte read FWeight write FWeight; - property Quality: Byte read FQuality write FQuality; - property Unknown1: Word read FUnknown1 write FUnknown1; - property Unknown2: Byte read FUnknown2 write FUnknown2; - property Quantity: Byte read FQuantity write FQuantity; - property AnimID: Word read FAnimID write FAnimID; - property Unknown3: Byte read FUnknown3 write FUnknown3; - property Hue: Byte read FHue write FHue; - property Unknown4: Word read FUnknown4 write FUnknown4; - property Height: Byte read FHeight write FHeight; - end; - - { TLandTileGroup } - - TLandTileGroup = class(TMulBlock) - constructor Create(AData: TStream); - destructor Destroy; override; - function Clone: TLandTileGroup; override; - function GetSize: Integer; override; - procedure Write(AData: TStream); override; - protected - FUnknown: LongInt; - public - LandTileData: array[0..31] of TLandTiledata; - property Unknown: LongInt read FUnknown write FUnknown; - end; - - { TStaticTileGroup } - - TStaticTileGroup = class(TMulBlock) - constructor Create(AData: TStream); - destructor Destroy; override; - function Clone: TStaticTileGroup; override; - function GetSize: Integer; override; - procedure Write(AData: TStream); override; - protected - FUnknown: LongInt; - public - StaticTileData: array[0..31] of TStaticTiledata; - property Unknown: LongInt read FUnknown write FUnknown; - end; - -function GetTileDataOffset(ABlock: Integer): Integer; - -implementation - -function GetTileDataOffset(ABlock: Integer): Integer; -var - group, tile: Integer; -begin - if ABlock > $3FFF then - begin - ABlock := ABlock - $4000; - group := ABlock div 32; - tile := ABlock mod 32; - - Result := 512 * LandTileGroupSize + group * StaticTileGroupSize + 4 - + tile * StaticTileDataSize; - end else - begin - group := ABlock div 32; - tile := ABlock mod 32; - - Result := group * LandTileGroupSize + 4 + tile * LandTileDataSize; - end; -end; - -{ TLandTiledata } - -constructor TLandTiledata.Create(AData: TStream); -begin - SetLength(FTileName, 20); - if assigned(AData) then - begin - AData.Read(FFlags, SizeOf(LongWord)); - AData.Read(FTextureID, SizeOf(Word)); - AData.Read(PChar(FTileName)^, 20); - end; - FTileName := Trim(FTileName); -end; - -destructor TLandTiledata.Destroy; -begin - SetLength(FTileName, 0); - inherited; -end; - -function TLandTiledata.Clone: TLandTiledata; -begin - Result := TLandTiledata.Create(nil); - Result.FFlags := FFlags; - Result.FTextureID := FTextureID; - Result.FTileName := FTileName; -end; - -procedure TLandTiledata.Write(AData: TStream); -var - i: Integer; -begin - if Length(FTileName) < 20 then - for i := Length(FTileName) to 20 do - FTileName := FTileName + #0; - AData.Write(FFlags, SizeOf(LongWord)); - AData.Write(FTextureID, SizeOf(Word)); - AData.Write(PChar(FTileName)^, 20); -end; - -function TLandTiledata.GetSize: Integer; -begin - GetSize := LandTileDataSize; -end; - -{ TStaticTiledata} - -constructor TStaticTiledata.Create(AData: TStream); -begin - SetLength(FTileName, 20); - if AData <> nil then - begin - AData.Read(FFlags, SizeOf(LongWord)); - AData.Read(FWeight, SizeOf(Byte)); - AData.Read(FQuality, SizeOf(Byte)); - AData.Read(FUnknown1, SizeOf(Word)); - AData.Read(FUnknown2, SizeOf(Byte)); - AData.Read(FQuantity, SizeOf(Byte)); - AData.Read(FAnimID, SizeOf(Word)); - AData.Read(FUnknown3, SizeOf(Byte)); - AData.Read(FHue, SizeOf(Byte)); - AData.Read(FUnknown4, SizeOf(Word)); - AData.Read(FHeight, SizeOf(Byte)); - AData.Read(PChar(FTileName)^, 20); - end; - FTileName := Trim(FTileName); -end; - -destructor TStaticTiledata.Destroy; -begin - SetLength(FTileName, 0); - inherited; -end; - -function TStaticTiledata.Clone: TStaticTiledata; -begin - Result := TStaticTiledata.Create(nil); - Result.FFlags := FFlags; - Result.FWeight := FWeight; - Result.FQuality := FQuality; - Result.FUnknown1 := FUnknown1; - Result.FUnknown2 := FUnknown2; - Result.FQuantity := FQuantity; - Result.FAnimID := FAnimID; - Result.FUnknown3 := FUnknown3; - Result.FHue := FHue; - Result.FUnknown4 := FUnknown4; - Result.FHeight := FHeight; - Result.FTileName := FTileName; -end; - -procedure TStaticTiledata.Write(AData: TStream); -var - i: Integer; -begin - if Length(FTileName) < 20 then - for i := Length(FTileName) to 20 do - FTileName := FTileName + #0; - AData.Write(FFlags, SizeOf(LongWord)); - AData.Write(FWeight, SizeOf(Byte)); - AData.Write(FQuality, SizeOf(Byte)); - AData.Write(FUnknown1, SizeOf(Word)); - AData.Write(FUnknown2, SizeOf(Byte)); - AData.Write(FQuantity, SizeOf(Byte)); - AData.Write(FAnimID, SizeOf(Word)); - AData.Write(FUnknown3, SizeOf(Byte)); - AData.Write(FHue, SizeOf(Byte)); - AData.Write(FUnknown4, SizeOf(Word)); - AData.Write(FHeight, SizeOf(Byte)); - AData.Write(PChar(FTileName)^, 20); -end; - -function TStaticTiledata.GetSize: Integer; -begin - GetSize := StaticTileDataSize; -end; - -{ TLandTileGroup } - -constructor TLandTileGroup.Create(AData: TStream); -var - i: Integer; -begin - if assigned(AData) then - begin - AData.Read(FUnknown, SizeOf(LongInt)); - end; - for i := 0 to 31 do - LandTileData[i] := TLandTiledata.Create(AData); -end; - -destructor TLandTileGroup.Destroy; -var - i: Integer; -begin - for i := 0 to 31 do - LandTileData[i].Free; - inherited; -end; - -function TLandTileGroup.Clone: TLandTileGroup; -var - i: Integer; -begin - Result := TLandTileGroup.Create(nil); - Result.FUnknown := FUnknown; - for i := 0 to 31 do - Result.LandTileData[i] := LandTileData[i].Clone; -end; - -procedure TLandTileGroup.Write(AData: TStream); -var - i: Integer; -begin - AData.Write(FUnknown, SizeOf(LongInt)); - for i := 0 to 31 do - LandTileData[i].Write(AData); -end; - -function TLandTileGroup.GetSize: Integer; -begin - GetSize := LandTileGroupSize; -end; - -{ TStaticTileGroup } - -constructor TStaticTileGroup.Create(AData: TStream); -var - i: Integer; -begin - if assigned(AData) then - begin - AData.Read(FUnknown, SizeOf(LongInt)); - end; - for i := 0 to 31 do - StaticTileData[i] := TStaticTiledata.Create(AData); -end; - -destructor TStaticTileGroup.Destroy; -var - i: Integer; -begin - for i := 0 to 31 do - StaticTileData[i].Free; - inherited; -end; - -function TStaticTileGroup.Clone: TStaticTileGroup; -var - i: Integer; -begin - Result := TStaticTileGroup.Create(nil); - Result.FUnknown := FUnknown; - for i := 0 to 31 do - Result.StaticTileData[i] := StaticTileData[i].Clone; -end; - -procedure TStaticTileGroup.Write(AData: TStream); -var - i: Integer; -begin - AData.Write(FUnknown, SizeOf(LongInt)); - for i := 0 to 31 do - StaticTileData[i].Write(AData); -end; - -function TStaticTileGroup.GetSize: Integer; -begin - GetSize := StaticTileGroupSize; -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2009 Andreas Schneider + *) +unit UTiledata; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, UMulBlock; + +const + LandTileDataSize = 26; + LandTileGroupSize = 4 + 32 * LandTileDataSize; + StaticTileDataSize = 37; + StaticTileGroupSize = 4 + 32 * StaticTileDataSize; + +type + TTileDataFlag = (tdfBackground, tdfWeapon, tdfTransparent, tdfTranslucent, + tdfWall, tdfDamaging, tdfImpassable, tdfWet, tdfUnknown1, + tdfSurface, tdfBridge, tdfGeneric, tdfWindow, tdfNoShoot, + tdfArticleA, tdfArticleAn, tdfInternal, tdfFoliage, + tdfPartialHue, tdfUnknown2, tdfMap, tdfContainer, + tdfWearable, tdfLightSource, tdfAnimation, tdfNoDiagonal, + tdfArtUsed, tdfArmor, tdfRoof, tdfDoor, tdfStairBack, + tdfStairRight); + TTileDataFlags = set of TTileDataFlag; + + { TTiledata } + + TTiledata = class(TMulBlock) + protected + FFlags: TTileDataFlags; + FTileName: string; + public + property Flags: TTileDataFlags read FFlags write FFlags; + property TileName: string read FTileName write FTileName; + end; + + { TLandTiledata } + + TLandTiledata = class(TTiledata) + constructor Create(AData: TStream); + destructor Destroy; override; + function Clone: TLandTiledata; override; + function GetSize: Integer; override; + procedure Write(AData: TStream); override; + protected + FTextureID: Word; + public + property TextureID: Word read FTextureID write FTextureID; + end; + + { TStaticTiledata } + + TStaticTiledata = class(TTiledata) + constructor Create(AData: TStream); + destructor Destroy; override; + function Clone: TStaticTiledata; override; + function GetSize: Integer; override; + procedure Write(AData: TStream); override; + protected + FWeight: Byte; + FQuality: Byte; + FUnknown1: Word; + FUnknown2: Byte; + FQuantity: Byte; + FAnimID: Word; + FUnknown3: Byte; + FHue: Byte; + FUnknown4: Word; + FHeight: Byte; + public + property Weight: Byte read FWeight write FWeight; + property Quality: Byte read FQuality write FQuality; + property Unknown1: Word read FUnknown1 write FUnknown1; + property Unknown2: Byte read FUnknown2 write FUnknown2; + property Quantity: Byte read FQuantity write FQuantity; + property AnimID: Word read FAnimID write FAnimID; + property Unknown3: Byte read FUnknown3 write FUnknown3; + property Hue: Byte read FHue write FHue; + property Unknown4: Word read FUnknown4 write FUnknown4; + property Height: Byte read FHeight write FHeight; + end; + + { TLandTileGroup } + + TLandTileGroup = class(TMulBlock) + constructor Create(AData: TStream); + destructor Destroy; override; + function Clone: TLandTileGroup; override; + function GetSize: Integer; override; + procedure Write(AData: TStream); override; + protected + FUnknown: LongInt; + public + LandTileData: array[0..31] of TLandTiledata; + property Unknown: LongInt read FUnknown write FUnknown; + end; + + { TStaticTileGroup } + + TStaticTileGroup = class(TMulBlock) + constructor Create(AData: TStream); + destructor Destroy; override; + function Clone: TStaticTileGroup; override; + function GetSize: Integer; override; + procedure Write(AData: TStream); override; + protected + FUnknown: LongInt; + public + StaticTileData: array[0..31] of TStaticTiledata; + property Unknown: LongInt read FUnknown write FUnknown; + end; + +function GetTileDataOffset(ABlock: Integer): Integer; + +implementation + +function GetTileDataOffset(ABlock: Integer): Integer; +var + group, tile: Integer; +begin + if ABlock > $3FFF then + begin + ABlock := ABlock - $4000; + group := ABlock div 32; + tile := ABlock mod 32; + + Result := 512 * LandTileGroupSize + group * StaticTileGroupSize + 4 + + tile * StaticTileDataSize; + end else + begin + group := ABlock div 32; + tile := ABlock mod 32; + + Result := group * LandTileGroupSize + 4 + tile * LandTileDataSize; + end; +end; + +{ TLandTiledata } + +constructor TLandTiledata.Create(AData: TStream); +begin + SetLength(FTileName, 20); + if assigned(AData) then + begin + AData.Read(FFlags, SizeOf(LongWord)); + AData.Read(FTextureID, SizeOf(Word)); + AData.Read(PChar(FTileName)^, 20); + end; + FTileName := Trim(FTileName); +end; + +destructor TLandTiledata.Destroy; +begin + SetLength(FTileName, 0); + inherited; +end; + +function TLandTiledata.Clone: TLandTiledata; +begin + Result := TLandTiledata.Create(nil); + Result.FFlags := FFlags; + Result.FTextureID := FTextureID; + Result.FTileName := FTileName; +end; + +procedure TLandTiledata.Write(AData: TStream); +var + i: Integer; +begin + if Length(FTileName) < 20 then + for i := Length(FTileName) to 20 do + FTileName := FTileName + #0; + AData.Write(FFlags, SizeOf(LongWord)); + AData.Write(FTextureID, SizeOf(Word)); + AData.Write(PChar(FTileName)^, 20); +end; + +function TLandTiledata.GetSize: Integer; +begin + GetSize := LandTileDataSize; +end; + +{ TStaticTiledata} + +constructor TStaticTiledata.Create(AData: TStream); +begin + SetLength(FTileName, 20); + if AData <> nil then + begin + AData.Read(FFlags, SizeOf(LongWord)); + AData.Read(FWeight, SizeOf(Byte)); + AData.Read(FQuality, SizeOf(Byte)); + AData.Read(FUnknown1, SizeOf(Word)); + AData.Read(FUnknown2, SizeOf(Byte)); + AData.Read(FQuantity, SizeOf(Byte)); + AData.Read(FAnimID, SizeOf(Word)); + AData.Read(FUnknown3, SizeOf(Byte)); + AData.Read(FHue, SizeOf(Byte)); + AData.Read(FUnknown4, SizeOf(Word)); + AData.Read(FHeight, SizeOf(Byte)); + AData.Read(PChar(FTileName)^, 20); + end; + FTileName := Trim(FTileName); +end; + +destructor TStaticTiledata.Destroy; +begin + SetLength(FTileName, 0); + inherited; +end; + +function TStaticTiledata.Clone: TStaticTiledata; +begin + Result := TStaticTiledata.Create(nil); + Result.FFlags := FFlags; + Result.FWeight := FWeight; + Result.FQuality := FQuality; + Result.FUnknown1 := FUnknown1; + Result.FUnknown2 := FUnknown2; + Result.FQuantity := FQuantity; + Result.FAnimID := FAnimID; + Result.FUnknown3 := FUnknown3; + Result.FHue := FHue; + Result.FUnknown4 := FUnknown4; + Result.FHeight := FHeight; + Result.FTileName := FTileName; +end; + +procedure TStaticTiledata.Write(AData: TStream); +var + i: Integer; +begin + if Length(FTileName) < 20 then + for i := Length(FTileName) to 20 do + FTileName := FTileName + #0; + AData.Write(FFlags, SizeOf(LongWord)); + AData.Write(FWeight, SizeOf(Byte)); + AData.Write(FQuality, SizeOf(Byte)); + AData.Write(FUnknown1, SizeOf(Word)); + AData.Write(FUnknown2, SizeOf(Byte)); + AData.Write(FQuantity, SizeOf(Byte)); + AData.Write(FAnimID, SizeOf(Word)); + AData.Write(FUnknown3, SizeOf(Byte)); + AData.Write(FHue, SizeOf(Byte)); + AData.Write(FUnknown4, SizeOf(Word)); + AData.Write(FHeight, SizeOf(Byte)); + AData.Write(PChar(FTileName)^, 20); +end; + +function TStaticTiledata.GetSize: Integer; +begin + GetSize := StaticTileDataSize; +end; + +{ TLandTileGroup } + +constructor TLandTileGroup.Create(AData: TStream); +var + i: Integer; +begin + if assigned(AData) then + begin + AData.Read(FUnknown, SizeOf(LongInt)); + end; + for i := 0 to 31 do + LandTileData[i] := TLandTiledata.Create(AData); +end; + +destructor TLandTileGroup.Destroy; +var + i: Integer; +begin + for i := 0 to 31 do + LandTileData[i].Free; + inherited; +end; + +function TLandTileGroup.Clone: TLandTileGroup; +var + i: Integer; +begin + Result := TLandTileGroup.Create(nil); + Result.FUnknown := FUnknown; + for i := 0 to 31 do + Result.LandTileData[i] := LandTileData[i].Clone; +end; + +procedure TLandTileGroup.Write(AData: TStream); +var + i: Integer; +begin + AData.Write(FUnknown, SizeOf(LongInt)); + for i := 0 to 31 do + LandTileData[i].Write(AData); +end; + +function TLandTileGroup.GetSize: Integer; +begin + GetSize := LandTileGroupSize; +end; + +{ TStaticTileGroup } + +constructor TStaticTileGroup.Create(AData: TStream); +var + i: Integer; +begin + if assigned(AData) then + begin + AData.Read(FUnknown, SizeOf(LongInt)); + end; + for i := 0 to 31 do + StaticTileData[i] := TStaticTiledata.Create(AData); +end; + +destructor TStaticTileGroup.Destroy; +var + i: Integer; +begin + for i := 0 to 31 do + StaticTileData[i].Free; + inherited; +end; + +function TStaticTileGroup.Clone: TStaticTileGroup; +var + i: Integer; +begin + Result := TStaticTileGroup.Create(nil); + Result.FUnknown := FUnknown; + for i := 0 to 31 do + Result.StaticTileData[i] := StaticTileData[i].Clone; +end; + +procedure TStaticTileGroup.Write(AData: TStream); +var + i: Integer; +begin + AData.Write(FUnknown, SizeOf(LongInt)); + for i := 0 to 31 do + StaticTileData[i].Write(AData); +end; + +function TStaticTileGroup.GetSize: Integer; +begin + GetSize := StaticTileGroupSize; +end; + +end. + diff --git a/UOLib/UVerdata.pas b/UOLib/UVerdata.pas index bf8440b..196e223 100644 --- a/UOLib/UVerdata.pas +++ b/UOLib/UVerdata.pas @@ -1,92 +1,92 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2007 Andreas Schneider - *) -unit UVerdata; - -interface - -uses - Classes, UGenericIndex; - -type - TFileType = (map0 = $00, staidx0, statics0, artidx, art, animidx, anim, - soundidx, sound, texidx, texmaps, gumpidx, gumpart, multiidx, multi, - skillsidx, skills, tiledata = $1E, animdata); - TVerdataIndex = class(TGenericIndex) - constructor Create(Data: TStream); - function Clone: TVerdataIndex; override; - procedure Write(Data: TStream); override; - function GetSize: Integer; override; - protected - FFileID: TFileType; - FBlock: LongInt; - published - property FileID: TFileType read FFileID write FFileID; - property Block: LongInt read FBlock write FBlock; - end; - -implementation - -constructor TVerdataIndex.Create; -var - fileID: LongInt; - -begin - if assigned(Data) then - begin - Data.Read(fileID, SizeOf(LongInt)); - Data.Read(FBlock, SizeOf(LongInt)); - FFileID := TFileType(fileID); - end; - inherited; -end; - -function TVerdataIndex.Clone: TVerdataIndex; -begin - Result := TVerdataIndex.Create(nil); - Result.FFileID := FFileID; - Result.FBlock := FBlock; - Result.FLookup := FLookup; - Result.FSize := FSize; - Result.FVarious := FVarious; -end; - -procedure TVerdataIndex.Write; -var - fileID: LongInt; -begin - fileID := LongInt(FFileID); - Data.Write(fileID, SizeOf(LongInt)); - Data.Write(FBlock, SizeOf(LongInt)); - inherited; -end; - -function TVerdataIndex.GetSize: Integer; -begin - Result := inherited GetSize + 8; -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2007 Andreas Schneider + *) +unit UVerdata; + +interface + +uses + Classes, UGenericIndex; + +type + TFileType = (map0 = $00, staidx0, statics0, artidx, art, animidx, anim, + soundidx, sound, texidx, texmaps, gumpidx, gumpart, multiidx, multi, + skillsidx, skills, tiledata = $1E, animdata); + TVerdataIndex = class(TGenericIndex) + constructor Create(Data: TStream); + function Clone: TVerdataIndex; override; + procedure Write(Data: TStream); override; + function GetSize: Integer; override; + protected + FFileID: TFileType; + FBlock: LongInt; + published + property FileID: TFileType read FFileID write FFileID; + property Block: LongInt read FBlock write FBlock; + end; + +implementation + +constructor TVerdataIndex.Create; +var + fileID: LongInt; + +begin + if assigned(Data) then + begin + Data.Read(fileID, SizeOf(LongInt)); + Data.Read(FBlock, SizeOf(LongInt)); + FFileID := TFileType(fileID); + end; + inherited; +end; + +function TVerdataIndex.Clone: TVerdataIndex; +begin + Result := TVerdataIndex.Create(nil); + Result.FFileID := FFileID; + Result.FBlock := FBlock; + Result.FLookup := FLookup; + Result.FSize := FSize; + Result.FVarious := FVarious; +end; + +procedure TVerdataIndex.Write; +var + fileID: LongInt; +begin + fileID := LongInt(FFileID); + Data.Write(fileID, SizeOf(LongInt)); + Data.Write(FBlock, SizeOf(LongInt)); + inherited; +end; + +function TVerdataIndex.GetSize: Integer; +begin + Result := inherited GetSize + 8; +end; + +end. + diff --git a/UPacket.pas b/UPacket.pas index ccc2841..f2a032c 100644 --- a/UPacket.pas +++ b/UPacket.pas @@ -1,78 +1,78 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2007 Andreas Schneider - *) -unit UPacket; - -interface - -uses - Classes, UEnhancedMemoryStream; - -type - TPacket = class(TObject) - constructor Create(APacketID: Byte; ALength: Cardinal); - destructor Destroy; override; - protected - FStream: TEnhancedMemoryStream; - FPacketID: Byte; - FLength: Cardinal; - function GetStream: TEnhancedMemoryStream; - published - property Stream: TEnhancedMemoryStream read GetStream; - property PacketID: Byte read FPacketID; - property PacketLength: Cardinal read FLength; - end; - -implementation - -constructor TPacket.Create(APacketID: Byte; ALength: Cardinal); -begin - FStream := TEnhancedMemoryStream.Create; - FPacketID := APacketID; - FLength := ALength; - FStream.WriteByte(FPacketID); - if FLength = 0 then - FStream.WriteCardinal(0); -end; - -destructor TPacket.Destroy; -begin - FStream.Free; - inherited; -end; - -function TPacket.GetStream: TEnhancedMemoryStream; -begin - if FLength = 0 then - begin - FStream.Position := 1; - FStream.WriteCardinal(FStream.Size); - end; - FStream.Position := 0; - Result := FStream; -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2007 Andreas Schneider + *) +unit UPacket; + +interface + +uses + Classes, UEnhancedMemoryStream; + +type + TPacket = class(TObject) + constructor Create(APacketID: Byte; ALength: Cardinal); + destructor Destroy; override; + protected + FStream: TEnhancedMemoryStream; + FPacketID: Byte; + FLength: Cardinal; + function GetStream: TEnhancedMemoryStream; + published + property Stream: TEnhancedMemoryStream read GetStream; + property PacketID: Byte read FPacketID; + property PacketLength: Cardinal read FLength; + end; + +implementation + +constructor TPacket.Create(APacketID: Byte; ALength: Cardinal); +begin + FStream := TEnhancedMemoryStream.Create; + FPacketID := APacketID; + FLength := ALength; + FStream.WriteByte(FPacketID); + if FLength = 0 then + FStream.WriteCardinal(0); +end; + +destructor TPacket.Destroy; +begin + FStream.Free; + inherited; +end; + +function TPacket.GetStream: TEnhancedMemoryStream; +begin + if FLength = 0 then + begin + FStream.Position := 1; + FStream.WriteCardinal(FStream.Size); + end; + FStream.Position := 0; + Result := FStream; +end; + +end. + diff --git a/bin/nodraw.txt b/bin/nodraw.txt index c3f73d0..892b576 100644 --- a/bin/nodraw.txt +++ b/bin/nodraw.txt @@ -1,13 +1,13 @@ -# This file contains a list of all tiles to be ignored when the "NoDraw" -# option is not active. -# Lines starting with T are terrain tiles, S indicated static tiles. -# A - between numbers indicates a range of tiles. - -#Terrain -T$2 - -#Statics -S$1 -S$2198-$21A4 -S$21BC -S$5690 +# This file contains a list of all tiles to be ignored when the "NoDraw" +# option is not active. +# Lines starting with T are terrain tiles, S indicated static tiles. +# A - between numbers indicates a range of tiles. + +#Terrain +T$2 + +#Statics +S$1 +S$2198-$21A4 +S$21BC +S$5690