| 1 | unit GR32_Transforms;
|
|---|
| 2 |
|
|---|
| 3 | (* ***** BEGIN LICENSE BLOCK *****
|
|---|
| 4 | * Version: MPL 1.1 or LGPL 2.1 with linking exception
|
|---|
| 5 | *
|
|---|
| 6 | * The contents of this file are subject to the Mozilla Public License Version
|
|---|
| 7 | * 1.1 (the "License"); you may not use this file except in compliance with
|
|---|
| 8 | * the License. You may obtain a copy of the License at
|
|---|
| 9 | * http://www.mozilla.org/MPL/
|
|---|
| 10 | *
|
|---|
| 11 | * Software distributed under the License is distributed on an "AS IS" basis,
|
|---|
| 12 | * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
|---|
| 13 | * for the specific language governing rights and limitations under the
|
|---|
| 14 | * License.
|
|---|
| 15 | *
|
|---|
| 16 | * Alternatively, the contents of this file may be used under the terms of the
|
|---|
| 17 | * Free Pascal modified version of the GNU Lesser General Public License
|
|---|
| 18 | * Version 2.1 (the "FPC modified LGPL License"), in which case the provisions
|
|---|
| 19 | * of this license are applicable instead of those above.
|
|---|
| 20 | * Please see the file LICENSE.txt for additional information concerning this
|
|---|
| 21 | * license.
|
|---|
| 22 | *
|
|---|
| 23 | * The Original Code is Graphics32
|
|---|
| 24 | *
|
|---|
| 25 | * The Initial Developer of the Original Code is
|
|---|
| 26 | * Alex A. Denisov
|
|---|
| 27 | *
|
|---|
| 28 | * Portions created by the Initial Developer are Copyright (C) 2000-2009
|
|---|
| 29 | * the Initial Developer. All Rights Reserved.
|
|---|
| 30 | *
|
|---|
| 31 | * Contributor(s):
|
|---|
| 32 | * Andre Beckedorf <Andre@metaException.de>
|
|---|
| 33 | * Mattias Andersson <Mattias@Centaurix.com>
|
|---|
| 34 | * J. Tulach <tulach@position.cz>
|
|---|
| 35 | * Michael Hansen <dyster_tid@hotmail.com>
|
|---|
| 36 | * Peter Larson
|
|---|
| 37 | *
|
|---|
| 38 | * ***** END LICENSE BLOCK ***** *)
|
|---|
| 39 |
|
|---|
| 40 | interface
|
|---|
| 41 |
|
|---|
| 42 | {$I GR32.inc}
|
|---|
| 43 |
|
|---|
| 44 | uses
|
|---|
| 45 | {$IFDEF FPC}
|
|---|
| 46 | LCLIntf,
|
|---|
| 47 | {$ELSE}
|
|---|
| 48 | Windows,
|
|---|
| 49 | {$ENDIF}
|
|---|
| 50 | SysUtils, Classes, Types, GR32, GR32_VectorMaps, GR32_Rasterizers;
|
|---|
| 51 |
|
|---|
| 52 | type
|
|---|
| 53 | ETransformError = class(Exception);
|
|---|
| 54 | ETransformNotImplemented = class(Exception);
|
|---|
| 55 |
|
|---|
| 56 | type
|
|---|
| 57 | TFloatMatrix = array [0..2, 0..2] of TFloat; // 3x3 TFloat precision
|
|---|
| 58 | TFixedMatrix = array [0..2, 0..2] of TFixed; // 3x3 fixed precision
|
|---|
| 59 |
|
|---|
| 60 | const
|
|---|
| 61 | IdentityMatrix: TFloatMatrix = (
|
|---|
| 62 | (1, 0, 0),
|
|---|
| 63 | (0, 1, 0),
|
|---|
| 64 | (0, 0, 1));
|
|---|
| 65 |
|
|---|
| 66 | type
|
|---|
| 67 | TVector3f = array [0..2] of TFloat;
|
|---|
| 68 | TVector3i = array [0..2] of Integer;
|
|---|
| 69 |
|
|---|
| 70 | // Matrix conversion routines
|
|---|
| 71 | function FixedMatrix(const FloatMatrix: TFloatMatrix): TFixedMatrix; overload;
|
|---|
| 72 | function FloatMatrix(const FixedMatrix: TFixedMatrix): TFloatMatrix; overload;
|
|---|
| 73 |
|
|---|
| 74 | procedure Adjoint(var M: TFloatMatrix);
|
|---|
| 75 | function Determinant(const M: TFloatMatrix): TFloat;
|
|---|
| 76 | procedure Scale(var M: TFloatMatrix; Factor: TFloat);
|
|---|
| 77 | procedure Invert(var M: TFloatMatrix);
|
|---|
| 78 | function Mult(const M1, M2: TFloatMatrix): TFloatMatrix;
|
|---|
| 79 | function VectorTransform(const M: TFloatMatrix; const V: TVector3f): TVector3f;
|
|---|
| 80 |
|
|---|
| 81 | type
|
|---|
| 82 | TTransformation = class(TNotifiablePersistent)
|
|---|
| 83 | private
|
|---|
| 84 | FSrcRect: TFloatRect;
|
|---|
| 85 | procedure SetSrcRect(const Value: TFloatRect);
|
|---|
| 86 | protected
|
|---|
| 87 | TransformValid: Boolean;
|
|---|
| 88 | procedure PrepareTransform; virtual;
|
|---|
| 89 | procedure ReverseTransformInt(DstX, DstY: Integer; out SrcX, SrcY: Integer); virtual;
|
|---|
| 90 | procedure ReverseTransformFixed(DstX, DstY: TFixed; out SrcX, SrcY: TFixed); virtual;
|
|---|
| 91 | procedure ReverseTransformFloat(DstX, DstY: TFloat; out SrcX, SrcY: TFloat); virtual;
|
|---|
| 92 | procedure TransformInt(SrcX, SrcY: Integer; out DstX, DstY: Integer); virtual;
|
|---|
| 93 | procedure TransformFixed(SrcX, SrcY: TFixed; out DstX, DstY: TFixed); virtual;
|
|---|
| 94 | procedure TransformFloat(SrcX, SrcY: TFloat; out DstX, DstY: TFloat); virtual;
|
|---|
| 95 | public
|
|---|
| 96 | constructor Create; virtual;
|
|---|
| 97 | procedure Changed; override;
|
|---|
| 98 | function HasTransformedBounds: Boolean; virtual;
|
|---|
| 99 | function GetTransformedBounds: TFloatRect; overload;
|
|---|
| 100 | function GetTransformedBounds(const ASrcRect: TFloatRect): TFloatRect; overload; virtual;
|
|---|
| 101 | function ReverseTransform(const P: TPoint): TPoint; overload; virtual;
|
|---|
| 102 | function ReverseTransform(const P: TFixedPoint): TFixedPoint; overload; virtual;
|
|---|
| 103 | function ReverseTransform(const P: TFloatPoint): TFloatPoint; overload; virtual;
|
|---|
| 104 | function Transform(const P: TPoint): TPoint; overload; virtual;
|
|---|
| 105 | function Transform(const P: TFixedPoint): TFixedPoint; overload; virtual;
|
|---|
| 106 | function Transform(const P: TFloatPoint): TFloatPoint; overload; virtual;
|
|---|
| 107 | property SrcRect: TFloatRect read FSrcRect write SetSrcRect;
|
|---|
| 108 | end;
|
|---|
| 109 | TTransformationClass = class of TTransformation;
|
|---|
| 110 |
|
|---|
| 111 | TNestedTransformation = class(TTransformation)
|
|---|
| 112 | private
|
|---|
| 113 | FItems: TList;
|
|---|
| 114 | FOwner: TPersistent;
|
|---|
| 115 | function GetCount: Integer;
|
|---|
| 116 | function GetItem(Index: Integer): TTransformation;
|
|---|
| 117 | procedure SetItem(Index: Integer; const Value: TTransformation);
|
|---|
| 118 | protected
|
|---|
| 119 | procedure PrepareTransform; override;
|
|---|
| 120 | procedure ReverseTransformFixed(DstX, DstY: TFixed; out SrcX, SrcY: TFixed); override;
|
|---|
| 121 | procedure ReverseTransformFloat(DstX, DstY: TFloat; out SrcX, SrcY: TFloat); override;
|
|---|
| 122 | procedure TransformFixed(SrcX, SrcY: TFixed; out DstX, DstY: TFixed); override;
|
|---|
| 123 | procedure TransformFloat(SrcX, SrcY: TFloat; out DstX, DstY: TFloat); override;
|
|---|
| 124 | public
|
|---|
| 125 | constructor Create; override;
|
|---|
| 126 | destructor Destroy; override;
|
|---|
| 127 | function Add(ItemClass: TTransformationClass): TTransformation;
|
|---|
| 128 | procedure Clear;
|
|---|
| 129 | procedure Delete(Index: Integer);
|
|---|
| 130 | function Insert(Index: Integer; ItemClass: TTransformationClass): TTransformation;
|
|---|
| 131 |
|
|---|
| 132 | property Owner: TPersistent read FOwner;
|
|---|
| 133 | property Count: Integer read GetCount;
|
|---|
| 134 | property Items[Index: Integer]: TTransformation read GetItem write SetItem; default;
|
|---|
| 135 | end;
|
|---|
| 136 |
|
|---|
| 137 | T3x3Transformation = class(TTransformation)
|
|---|
| 138 | protected
|
|---|
| 139 | FMatrix, FInverseMatrix: TFloatMatrix;
|
|---|
| 140 | FFixedMatrix, FInverseFixedMatrix: TFixedMatrix;
|
|---|
| 141 | procedure PrepareTransform; override;
|
|---|
| 142 | procedure ReverseTransformFixed(DstX, DstY: TFixed; out SrcX, SrcY: TFixed); override;
|
|---|
| 143 | procedure ReverseTransformFloat(DstX, DstY: TFloat; out SrcX, SrcY: TFloat); override;
|
|---|
| 144 | procedure TransformFixed(SrcX, SrcY: TFixed; out DstX, DstY: TFixed); override;
|
|---|
| 145 | procedure TransformFloat(SrcX, SrcY: TFloat; out DstX, DstY: TFloat); override;
|
|---|
| 146 | public
|
|---|
| 147 | property Matrix: TFloatMatrix read FMatrix;
|
|---|
| 148 | end;
|
|---|
| 149 |
|
|---|
| 150 | TAffineTransformation = class(T3x3Transformation)
|
|---|
| 151 | private
|
|---|
| 152 | FStack: ^TFloatMatrix;
|
|---|
| 153 | FStackLevel: Integer;
|
|---|
| 154 | public
|
|---|
| 155 | constructor Create; override;
|
|---|
| 156 |
|
|---|
| 157 | function GetTransformedBounds(const ASrcRect: TFloatRect): TFloatRect; override;
|
|---|
| 158 | procedure Push;
|
|---|
| 159 | procedure Pop;
|
|---|
| 160 | procedure Clear; overload;
|
|---|
| 161 | procedure Clear(BaseMatrix: TFloatMatrix); overload;
|
|---|
| 162 | procedure Rotate(Alpha: TFloat); overload; // degrees
|
|---|
| 163 | procedure Rotate(Cx, Cy, Alpha: TFloat); overload; // degrees
|
|---|
| 164 | procedure Skew(Fx, Fy: TFloat);
|
|---|
| 165 | procedure Scale(Sx, Sy: TFloat); overload;
|
|---|
| 166 | procedure Scale(Value: TFloat); overload;
|
|---|
| 167 | procedure Translate(Dx, Dy: TFloat);
|
|---|
| 168 | end;
|
|---|
| 169 |
|
|---|
| 170 | TProjectiveTransformation = class(T3x3Transformation)
|
|---|
| 171 | private
|
|---|
| 172 | FQuadX: array [0..3] of TFloat;
|
|---|
| 173 | FQuadY: array [0..3] of TFloat;
|
|---|
| 174 | procedure SetX(Index: Integer; const Value: TFloat); {$IFDEF UseInlining} inline; {$ENDIF}
|
|---|
| 175 | procedure SetY(Index: Integer; const Value: TFloat); {$IFDEF UseInlining} inline; {$ENDIF}
|
|---|
| 176 | function GetX(Index: Integer): TFloat; {$IFDEF UseInlining} inline; {$ENDIF}
|
|---|
| 177 | function GetY(Index: Integer): TFloat; {$IFDEF UseInlining} inline; {$ENDIF}
|
|---|
| 178 | protected
|
|---|
| 179 | procedure PrepareTransform; override;
|
|---|
| 180 | procedure ReverseTransformFixed(DstX, DstY: TFixed; out SrcX, SrcY: TFixed); override;
|
|---|
| 181 | procedure ReverseTransformFloat(DstX, DstY: TFloat; out SrcX, SrcY: TFloat); override;
|
|---|
| 182 | procedure TransformFixed(SrcX, SrcY: TFixed; out DstX, DstY: TFixed); override;
|
|---|
| 183 | procedure TransformFloat(SrcX, SrcY: TFloat; out DstX, DstY: TFloat); override;
|
|---|
| 184 | public
|
|---|
| 185 | function GetTransformedBounds(const ASrcRect: TFloatRect): TFloatRect; override;
|
|---|
| 186 | property X[Index: Integer]: TFloat read GetX write SetX;
|
|---|
| 187 | property Y[index: Integer]: TFloat read GetX write SetY;
|
|---|
| 188 | published
|
|---|
| 189 | property X0: TFloat index 0 read GetX write SetX;
|
|---|
| 190 | property X1: TFloat index 1 read GetX write SetX;
|
|---|
| 191 | property X2: TFloat index 2 read GetX write SetX;
|
|---|
| 192 | property X3: TFloat index 3 read GetX write SetX;
|
|---|
| 193 | property Y0: TFloat index 0 read GetY write SetY;
|
|---|
| 194 | property Y1: TFloat index 1 read GetY write SetY;
|
|---|
| 195 | property Y2: TFloat index 2 read GetY write SetY;
|
|---|
| 196 | property Y3: TFloat index 3 read GetY write SetY;
|
|---|
| 197 | end;
|
|---|
| 198 |
|
|---|
| 199 | TTwirlTransformation = class(TTransformation)
|
|---|
| 200 | private
|
|---|
| 201 | Frx, Fry: TFloat;
|
|---|
| 202 | FTwirl: TFloat;
|
|---|
| 203 | procedure SetTwirl(const Value: TFloat);
|
|---|
| 204 | protected
|
|---|
| 205 | procedure PrepareTransform; override;
|
|---|
| 206 | procedure ReverseTransformFloat(DstX, DstY: TFloat; out SrcX, SrcY: TFloat); override;
|
|---|
| 207 | public
|
|---|
| 208 | constructor Create; override;
|
|---|
| 209 | function GetTransformedBounds(const ASrcRect: TFloatRect): TFloatRect; override;
|
|---|
| 210 | published
|
|---|
| 211 | property Twirl: TFloat read FTwirl write SetTwirl;
|
|---|
| 212 | end;
|
|---|
| 213 |
|
|---|
| 214 | TBloatTransformation = class(TTransformation)
|
|---|
| 215 | private
|
|---|
| 216 | FBloatPower: TFloat;
|
|---|
| 217 | FBP: TFloat;
|
|---|
| 218 | FPiW, FPiH: TFloat;
|
|---|
| 219 | procedure SetBloatPower(const Value: TFloat);
|
|---|
| 220 | protected
|
|---|
| 221 | procedure PrepareTransform; override;
|
|---|
| 222 | procedure ReverseTransformFloat(DstX, DstY: TFloat; out SrcX, SrcY: TFloat); override;
|
|---|
| 223 | procedure TransformFloat(DstX, DstY: TFloat; out SrcX, SrcY: TFloat); override;
|
|---|
| 224 | public
|
|---|
| 225 | constructor Create; override;
|
|---|
| 226 | published
|
|---|
| 227 | property BloatPower: TFloat read FBloatPower write SetBloatPower;
|
|---|
| 228 | end;
|
|---|
| 229 |
|
|---|
| 230 | TDisturbanceTransformation = class(TTransformation)
|
|---|
| 231 | private
|
|---|
| 232 | FDisturbance: TFloat;
|
|---|
| 233 | procedure SetDisturbance(const Value: TFloat);
|
|---|
| 234 | protected
|
|---|
| 235 | procedure ReverseTransformFloat(DstX, DstY: TFloat; out SrcX, SrcY: TFloat); override;
|
|---|
| 236 | public
|
|---|
| 237 | function GetTransformedBounds(const ASrcRect: TFloatRect): TFloatRect; override;
|
|---|
| 238 | published
|
|---|
| 239 | property Disturbance: TFloat read FDisturbance write SetDisturbance;
|
|---|
| 240 | end;
|
|---|
| 241 |
|
|---|
| 242 | TFishEyeTransformation = class(TTransformation)
|
|---|
| 243 | private
|
|---|
| 244 | Frx, Fry: TFloat;
|
|---|
| 245 | Faw, Fsr: TFloat;
|
|---|
| 246 | Sx, Sy: TFloat;
|
|---|
| 247 | FMinR: TFloat;
|
|---|
| 248 | protected
|
|---|
| 249 | procedure PrepareTransform; override;
|
|---|
| 250 | procedure ReverseTransformFloat(DstX, DstY: TFloat; out SrcX, SrcY: TFloat); override;
|
|---|
| 251 | end;
|
|---|
| 252 |
|
|---|
| 253 | TPolarTransformation = class(TTransformation)
|
|---|
| 254 | private
|
|---|
| 255 | FDstRect: TFloatRect;
|
|---|
| 256 | FPhase: TFloat;
|
|---|
| 257 | Sx, Sy, Cx, Cy, Dx, Dy, Rt, Rt2, Rr, Rcx, Rcy: TFloat;
|
|---|
| 258 | procedure SetDstRect(const Value: TFloatRect);
|
|---|
| 259 | procedure SetPhase(const Value: TFloat);
|
|---|
| 260 | protected
|
|---|
| 261 | procedure PrepareTransform; override;
|
|---|
| 262 | procedure TransformFloat(SrcX, SrcY: TFloat; out DstX, DstY: TFloat); override;
|
|---|
| 263 | procedure ReverseTransformFloat(DstX, DstY: TFloat; out SrcX, SrcY: TFloat); override;
|
|---|
| 264 | public
|
|---|
| 265 | property DstRect: TFloatRect read FDstRect write SetDstRect;
|
|---|
| 266 | property Phase: TFloat read FPhase write SetPhase;
|
|---|
| 267 | end;
|
|---|
| 268 |
|
|---|
| 269 | TPathTransformation = class(TTransformation)
|
|---|
| 270 | private
|
|---|
| 271 | FTopLength: TFloat;
|
|---|
| 272 | FBottomLength: TFloat;
|
|---|
| 273 | FBottomCurve: TArrayOfFloatPoint;
|
|---|
| 274 | FTopCurve: TArrayOfFloatPoint;
|
|---|
| 275 | FTopHypot, FBottomHypot: array of record Dist, RecDist: TFloat end;
|
|---|
| 276 | procedure SetBottomCurve(const Value: TArrayOfFloatPoint);
|
|---|
| 277 | procedure SetTopCurve(const Value: TArrayOfFloatPoint);
|
|---|
| 278 | protected
|
|---|
| 279 | rdx, rdy: TFloat;
|
|---|
| 280 | procedure PrepareTransform; override;
|
|---|
| 281 | procedure TransformFloat(SrcX, SrcY: TFloat; out DstX, DstY: TFloat); override;
|
|---|
| 282 | public
|
|---|
| 283 | destructor Destroy; override;
|
|---|
| 284 | property TopCurve: TArrayOfFloatPoint read FTopCurve write SetTopCurve;
|
|---|
| 285 | property BottomCurve: TArrayOfFloatPoint read FBottomCurve write SetBottomCurve;
|
|---|
| 286 | end;
|
|---|
| 287 |
|
|---|
| 288 | TRemapTransformation = class(TTransformation)
|
|---|
| 289 | private
|
|---|
| 290 | FVectorMap : TVectorMap;
|
|---|
| 291 | FScalingFixed: TFixedVector;
|
|---|
| 292 | FScalingFloat: TFloatVector;
|
|---|
| 293 | FCombinedScalingFixed: TFixedVector;
|
|---|
| 294 | FCombinedScalingFloat: TFloatVector;
|
|---|
| 295 | FSrcTranslationFixed: TFixedVector;
|
|---|
| 296 | FSrcScaleFixed: TFixedVector;
|
|---|
| 297 | FDstTranslationFixed: TFixedVector;
|
|---|
| 298 | FDstScaleFixed: TFixedVector;
|
|---|
| 299 | FSrcTranslationFloat: TFloatVector;
|
|---|
| 300 | FSrcScaleFloat: TFloatVector;
|
|---|
| 301 | FDstTranslationFloat: TFloatVector;
|
|---|
| 302 | FDstScaleFloat: TFloatVector;
|
|---|
| 303 | FOffsetFixed : TFixedVector;
|
|---|
| 304 | FOffsetInt : TPoint;
|
|---|
| 305 | FMappingRect: TFloatRect;
|
|---|
| 306 | FOffset: TFloatVector;
|
|---|
| 307 | procedure SetMappingRect(Rect: TFloatRect);
|
|---|
| 308 | procedure SetOffset(const Value: TFloatVector);
|
|---|
| 309 | protected
|
|---|
| 310 | procedure PrepareTransform; override;
|
|---|
| 311 | procedure ReverseTransformInt(DstX, DstY: Integer; out SrcX, SrcY: Integer); override;
|
|---|
| 312 | procedure ReverseTransformFloat(DstX, DstY: TFloat; out SrcX, SrcY: TFloat); override;
|
|---|
| 313 | procedure ReverseTransformFixed(DstX, DstY: TFixed; out SrcX, SrcY: TFixed); override;
|
|---|
| 314 | public
|
|---|
| 315 | constructor Create; override;
|
|---|
| 316 | destructor Destroy; override;
|
|---|
| 317 | function HasTransformedBounds: Boolean; override;
|
|---|
| 318 | function GetTransformedBounds(const ASrcRect: TFloatRect): TFloatRect; override;
|
|---|
| 319 | procedure Scale(Sx, Sy: TFloat);
|
|---|
| 320 | property MappingRect: TFloatRect read FMappingRect write SetMappingRect;
|
|---|
| 321 | property Offset: TFloatVector read FOffset write SetOffset;
|
|---|
| 322 | property VectorMap: TVectorMap read FVectorMap write FVectorMap;
|
|---|
| 323 | end;
|
|---|
| 324 |
|
|---|
| 325 | function TransformPoints(Points: TArrayOfArrayOfFixedPoint; Transformation: TTransformation): TArrayOfArrayOfFixedPoint;
|
|---|
| 326 |
|
|---|
| 327 | procedure Transform(Dst, Src: TCustomBitmap32; Transformation: TTransformation); overload;
|
|---|
| 328 | procedure Transform(Dst, Src: TCustomBitmap32; Transformation: TTransformation;
|
|---|
| 329 | const DstClip: TRect); overload;
|
|---|
| 330 | procedure Transform(Dst, Src: TCustomBitmap32; Transformation: TTransformation;
|
|---|
| 331 | Rasterizer: TRasterizer); overload;
|
|---|
| 332 | procedure Transform(Dst, Src: TCustomBitmap32; Transformation: TTransformation;
|
|---|
| 333 | Rasterizer: TRasterizer; const DstClip: TRect); overload;
|
|---|
| 334 |
|
|---|
| 335 | procedure RasterizeTransformation(Vectormap: TVectormap;
|
|---|
| 336 | Transformation: TTransformation; DstRect: TRect;
|
|---|
| 337 | CombineMode: TVectorCombineMode = vcmAdd;
|
|---|
| 338 | CombineCallback: TVectorCombineEvent = nil);
|
|---|
| 339 |
|
|---|
| 340 | procedure SetBorderTransparent(ABitmap: TCustomBitmap32; ARect: TRect);
|
|---|
| 341 |
|
|---|
| 342 | { FullEdge controls how the bitmap is resampled }
|
|---|
| 343 | var
|
|---|
| 344 | FullEdge: Boolean = True;
|
|---|
| 345 |
|
|---|
| 346 | resourcestring
|
|---|
| 347 | RCStrReverseTransformationNotImplemented = 'Reverse transformation is not implemented in %s.';
|
|---|
| 348 | RCStrForwardTransformationNotImplemented = 'Forward transformation is not implemented in %s.';
|
|---|
| 349 | RCStrTopBottomCurveNil = 'Top or bottom curve is nil';
|
|---|
| 350 |
|
|---|
| 351 | implementation
|
|---|
| 352 |
|
|---|
| 353 | uses
|
|---|
| 354 | Math, GR32_Blend, GR32_LowLevel, GR32_Math, GR32_Bindings,
|
|---|
| 355 | GR32_Resamplers;
|
|---|
| 356 |
|
|---|
| 357 | resourcestring
|
|---|
| 358 | RCStrSrcRectIsEmpty = 'SrcRect is empty!';
|
|---|
| 359 | RCStrMappingRectIsEmpty = 'MappingRect is empty!';
|
|---|
| 360 | RStrStackEmpty = 'Stack empty';
|
|---|
| 361 |
|
|---|
| 362 | type
|
|---|
| 363 | {provides access to proctected members of TCustomBitmap32 by typecasting}
|
|---|
| 364 | TTransformationAccess = class(TTransformation);
|
|---|
| 365 |
|
|---|
| 366 | var
|
|---|
| 367 | DET32: function(a1, a2, b1, b2: Single): Single;
|
|---|
| 368 | DET64: function(a1, a2, b1, b2: Double): Double;
|
|---|
| 369 |
|
|---|
| 370 |
|
|---|
| 371 | { A bit of linear algebra }
|
|---|
| 372 |
|
|---|
| 373 | function DET32_Pas(a1, a2, b1, b2: Single): Single; overload;
|
|---|
| 374 | begin
|
|---|
| 375 | Result := a1 * b2 - a2 * b1;
|
|---|
| 376 | end;
|
|---|
| 377 |
|
|---|
| 378 | function DET64_Pas(a1, a2, b1, b2: Double): Double; overload;
|
|---|
| 379 | begin
|
|---|
| 380 | Result := a1 * b2 - a2 * b1;
|
|---|
| 381 | end;
|
|---|
| 382 |
|
|---|
| 383 | {$IFNDEF PUREPASCAL}
|
|---|
| 384 | function DET32_ASM(a1, a2, b1, b2: Single): Single; overload;
|
|---|
| 385 | asm
|
|---|
| 386 | {$IFDEF CPU64}
|
|---|
| 387 | MULSS XMM0, XMM3
|
|---|
| 388 | MULSS XMM1, XMM2
|
|---|
| 389 | ADDSS XMM0, XMM1
|
|---|
| 390 | {$ELSE}
|
|---|
| 391 | FLD A1.Single
|
|---|
| 392 | FMUL B2.Single
|
|---|
| 393 | FLD A2.Single
|
|---|
| 394 | FMUL B1.Single
|
|---|
| 395 | FSUBP
|
|---|
| 396 | {$ENDIF}
|
|---|
| 397 | end;
|
|---|
| 398 |
|
|---|
| 399 | function DET64_ASM(a1, a2, b1, b2: Double): Double; overload;
|
|---|
| 400 | asm
|
|---|
| 401 | {$IFDEF CPU64}
|
|---|
| 402 | MULSD XMM0, XMM3
|
|---|
| 403 | MULSD XMM1, XMM2
|
|---|
| 404 | ADDSD XMM0, XMM1
|
|---|
| 405 | {$ELSE}
|
|---|
| 406 | FLD A1.Double
|
|---|
| 407 | FMUL B2.Double
|
|---|
| 408 | FLD A2.Double
|
|---|
| 409 | FMUL B1.Double
|
|---|
| 410 | FSUBP
|
|---|
| 411 | {$ENDIF}
|
|---|
| 412 | end;
|
|---|
| 413 | {$ENDIF}
|
|---|
| 414 |
|
|---|
| 415 | { implementation of detereminant for TFloat precision }
|
|---|
| 416 |
|
|---|
| 417 | function _DET(a1, a2, b1, b2: TFloat): TFloat; overload; {$IFDEF UseInlining} inline; {$ENDIF}
|
|---|
| 418 | begin
|
|---|
| 419 | Result := a1 * b2 - a2 * b1;
|
|---|
| 420 | end;
|
|---|
| 421 |
|
|---|
| 422 | function _DET(a1, a2, a3, b1, b2, b3, c1, c2, c3: TFloat): TFloat; overload; {$IFDEF UseInlining} inline; {$ENDIF}
|
|---|
| 423 | begin
|
|---|
| 424 | Result :=
|
|---|
| 425 | a1 * (b2 * c3 - b3 * c2) -
|
|---|
| 426 | b1 * (a2 * c3 - a3 * c2) +
|
|---|
| 427 | c1 * (a2 * b3 - a3 * b2);
|
|---|
| 428 | end;
|
|---|
| 429 |
|
|---|
| 430 | procedure Adjoint(var M: TFloatMatrix);
|
|---|
| 431 | var
|
|---|
| 432 | Tmp: TFloatMatrix;
|
|---|
| 433 | begin
|
|---|
| 434 | Tmp := M;
|
|---|
| 435 |
|
|---|
| 436 | M[0,0] := _DET(Tmp[1,1], Tmp[1,2], Tmp[2,1], Tmp[2,2]);
|
|---|
| 437 | M[0,1] := -_DET(Tmp[0,1], Tmp[0,2], Tmp[2,1], Tmp[2,2]);
|
|---|
| 438 | M[0,2] := _DET(Tmp[0,1], Tmp[0,2], Tmp[1,1], Tmp[1,2]);
|
|---|
| 439 |
|
|---|
| 440 | M[1,0] := -_DET(Tmp[1,0], Tmp[1,2], Tmp[2,0], Tmp[2,2]);
|
|---|
| 441 | M[1,1] := _DET(Tmp[0,0], Tmp[0,2], Tmp[2,0], Tmp[2,2]);
|
|---|
| 442 | M[1,2] := -_DET(Tmp[0,0], Tmp[0,2], Tmp[1,0], Tmp[1,2]);
|
|---|
| 443 |
|
|---|
| 444 | M[2,0] := _DET(Tmp[1,0], Tmp[1,1], Tmp[2,0], Tmp[2,1]);
|
|---|
| 445 | M[2,1] := -_DET(Tmp[0,0], Tmp[0,1], Tmp[2,0], Tmp[2,1]);
|
|---|
| 446 | M[2,2] := _DET(Tmp[0,0], Tmp[0,1], Tmp[1,0], Tmp[1,1]);
|
|---|
| 447 | end;
|
|---|
| 448 |
|
|---|
| 449 | function Determinant(const M: TFloatMatrix): TFloat;
|
|---|
| 450 | begin
|
|---|
| 451 | Result := _DET(M[0,0], M[1,0], M[2,0],
|
|---|
| 452 | M[0,1], M[1,1], M[2,1],
|
|---|
| 453 | M[0,2], M[1,2], M[2,2]);
|
|---|
| 454 | end;
|
|---|
| 455 |
|
|---|
| 456 | procedure Scale(var M: TFloatMatrix; Factor: TFloat);
|
|---|
| 457 | var
|
|---|
| 458 | i, j: Integer;
|
|---|
| 459 | begin
|
|---|
| 460 | for i := 0 to 2 do
|
|---|
| 461 | for j := 0 to 2 do
|
|---|
| 462 | M[i,j] := M[i,j] * Factor;
|
|---|
| 463 | end;
|
|---|
| 464 |
|
|---|
| 465 | procedure Invert(var M: TFloatMatrix);
|
|---|
| 466 | var
|
|---|
| 467 | Det: TFloat;
|
|---|
| 468 | begin
|
|---|
| 469 | Det := Determinant(M);
|
|---|
| 470 | if Abs(Det) < 1E-5 then M := IdentityMatrix
|
|---|
| 471 | else
|
|---|
| 472 | begin
|
|---|
| 473 | Adjoint(M);
|
|---|
| 474 | Scale(M, 1 / Det);
|
|---|
| 475 | end;
|
|---|
| 476 | end;
|
|---|
| 477 |
|
|---|
| 478 | function Mult(const M1, M2: TFloatMatrix): TFloatMatrix;
|
|---|
| 479 | var
|
|---|
| 480 | i, j: Integer;
|
|---|
| 481 | begin
|
|---|
| 482 | for i := 0 to 2 do
|
|---|
| 483 | for j := 0 to 2 do
|
|---|
| 484 | Result[i, j] :=
|
|---|
| 485 | M1[0, j] * M2[i, 0] +
|
|---|
| 486 | M1[1, j] * M2[i, 1] +
|
|---|
| 487 | M1[2, j] * M2[i, 2];
|
|---|
| 488 | end;
|
|---|
| 489 |
|
|---|
| 490 | function VectorTransform(const M: TFloatMatrix; const V: TVector3f): TVector3f;
|
|---|
| 491 | begin
|
|---|
| 492 | Result[0] := M[0,0] * V[0] + M[1,0] * V[1] + M[2,0] * V[2];
|
|---|
| 493 | Result[1] := M[0,1] * V[0] + M[1,1] * V[1] + M[2,1] * V[2];
|
|---|
| 494 | Result[2] := M[0,2] * V[0] + M[1,2] * V[1] + M[2,2] * V[2];
|
|---|
| 495 | end;
|
|---|
| 496 |
|
|---|
| 497 | { Transformation functions }
|
|---|
| 498 |
|
|---|
| 499 | function TransformPoints(Points: TArrayOfArrayOfFixedPoint; Transformation: TTransformation): TArrayOfArrayOfFixedPoint;
|
|---|
| 500 | var
|
|---|
| 501 | I, J: Integer;
|
|---|
| 502 | begin
|
|---|
| 503 | if Points = nil then
|
|---|
| 504 | Result := nil
|
|---|
| 505 | else
|
|---|
| 506 | begin
|
|---|
| 507 | SetLength(Result, Length(Points));
|
|---|
| 508 | Transformation.PrepareTransform;
|
|---|
| 509 |
|
|---|
| 510 | for I := 0 to High(Result) do
|
|---|
| 511 | begin
|
|---|
| 512 | SetLength(Result[I], Length(Points[I]));
|
|---|
| 513 | if Length(Result[I]) > 0 then
|
|---|
| 514 | for J := 0 to High(Result[I]) do
|
|---|
| 515 | Transformation.TransformFixed(Points[I][J].X, Points[I][J].Y, Result[I][J].X, Result[I][J].Y);
|
|---|
| 516 | end;
|
|---|
| 517 | end;
|
|---|
| 518 | end;
|
|---|
| 519 |
|
|---|
| 520 | procedure Transform(Dst, Src: TCustomBitmap32; Transformation: TTransformation);
|
|---|
| 521 | var
|
|---|
| 522 | Rasterizer: TRasterizer;
|
|---|
| 523 | begin
|
|---|
| 524 | Rasterizer := DefaultRasterizerClass.Create;
|
|---|
| 525 | try
|
|---|
| 526 | Transform(Dst, Src, Transformation, Rasterizer);
|
|---|
| 527 | finally
|
|---|
| 528 | Rasterizer.Free;
|
|---|
| 529 | end;
|
|---|
| 530 | end;
|
|---|
| 531 |
|
|---|
| 532 | procedure Transform(Dst, Src: TCustomBitmap32; Transformation: TTransformation; const DstClip: TRect);
|
|---|
| 533 | var
|
|---|
| 534 | Rasterizer: TRasterizer;
|
|---|
| 535 | begin
|
|---|
| 536 | Rasterizer := DefaultRasterizerClass.Create;
|
|---|
| 537 | try
|
|---|
| 538 | Transform(Dst, Src, Transformation, Rasterizer, DstClip);
|
|---|
| 539 | finally
|
|---|
| 540 | Rasterizer.Free;
|
|---|
| 541 | end;
|
|---|
| 542 | end;
|
|---|
| 543 |
|
|---|
| 544 | procedure Transform(Dst, Src: TCustomBitmap32; Transformation: TTransformation;
|
|---|
| 545 | Rasterizer: TRasterizer);
|
|---|
| 546 | begin
|
|---|
| 547 | Transform(Dst, Src, Transformation, Rasterizer, Dst.BoundsRect);
|
|---|
| 548 | end;
|
|---|
| 549 |
|
|---|
| 550 | procedure Transform(Dst, Src: TCustomBitmap32; Transformation: TTransformation;
|
|---|
| 551 | Rasterizer: TRasterizer; const DstClip: TRect);
|
|---|
| 552 | var
|
|---|
| 553 | DstRect: TRect;
|
|---|
| 554 | Transformer: TTransformer;
|
|---|
| 555 | begin
|
|---|
| 556 | GR32.IntersectRect(DstRect, DstClip, Dst.ClipRect);
|
|---|
| 557 |
|
|---|
| 558 | if (DstRect.Right < DstRect.Left) or (DstRect.Bottom < DstRect.Top) then Exit;
|
|---|
| 559 |
|
|---|
| 560 | if not Dst.MeasuringMode then
|
|---|
| 561 | begin
|
|---|
| 562 | Transformer := TTransformer.Create(Src.Resampler, Transformation);
|
|---|
| 563 | try
|
|---|
| 564 | Rasterizer.Sampler := Transformer;
|
|---|
| 565 | Rasterizer.Rasterize(Dst, DstRect, Src);
|
|---|
| 566 | finally
|
|---|
| 567 | EMMS;
|
|---|
| 568 | Transformer.Free;
|
|---|
| 569 | end;
|
|---|
| 570 | end;
|
|---|
| 571 | Dst.Changed(DstRect);
|
|---|
| 572 | end;
|
|---|
| 573 |
|
|---|
| 574 | procedure SetBorderTransparent(ABitmap: TCustomBitmap32; ARect: TRect);
|
|---|
| 575 | var
|
|---|
| 576 | I: Integer;
|
|---|
| 577 | begin
|
|---|
| 578 | GR32.IntersectRect(ARect, ARect, ABitmap.BoundsRect);
|
|---|
| 579 | with ARect, ABitmap do
|
|---|
| 580 | if (Right > Left) and (Bottom > Top) and
|
|---|
| 581 | (Left < ClipRect.Right) and (Top < ClipRect.Bottom) and
|
|---|
| 582 | (Right > ClipRect.Left) and (Bottom > ClipRect.Top) then
|
|---|
| 583 | begin
|
|---|
| 584 | Dec(Right);
|
|---|
| 585 | Dec(Bottom);
|
|---|
| 586 | for I := Left to Right do
|
|---|
| 587 | begin
|
|---|
| 588 | ABitmap[I, Top] := ABitmap[I, Top] and $00FFFFFF;
|
|---|
| 589 | ABitmap[I, Bottom] := ABitmap[I, Bottom] and $00FFFFFF;
|
|---|
| 590 | end;
|
|---|
| 591 | for I := Top to Bottom do
|
|---|
| 592 | begin
|
|---|
| 593 | ABitmap[Left, I] := ABitmap[Left, I] and $00FFFFFF;
|
|---|
| 594 | ABitmap[Right, I] := ABitmap[Right, I] and $00FFFFFF;
|
|---|
| 595 | end;
|
|---|
| 596 | Changed;
|
|---|
| 597 | end;
|
|---|
| 598 | end;
|
|---|
| 599 |
|
|---|
| 600 | { TTransformation }
|
|---|
| 601 |
|
|---|
| 602 | function TTransformation.GetTransformedBounds: TFloatRect;
|
|---|
| 603 | begin
|
|---|
| 604 | Result := GetTransformedBounds(FSrcRect);
|
|---|
| 605 | end;
|
|---|
| 606 |
|
|---|
| 607 | procedure TTransformation.Changed;
|
|---|
| 608 | begin
|
|---|
| 609 | TransformValid := False;
|
|---|
| 610 | inherited;
|
|---|
| 611 | end;
|
|---|
| 612 |
|
|---|
| 613 | constructor TTransformation.Create;
|
|---|
| 614 | begin
|
|---|
| 615 | // virtual constructor to be overriden in derived classes
|
|---|
| 616 | end;
|
|---|
| 617 |
|
|---|
| 618 | function TTransformation.GetTransformedBounds(const ASrcRect: TFloatRect): TFloatRect;
|
|---|
| 619 | begin
|
|---|
| 620 | Result := ASrcRect;
|
|---|
| 621 | end;
|
|---|
| 622 |
|
|---|
| 623 | function TTransformation.HasTransformedBounds: Boolean;
|
|---|
| 624 | begin
|
|---|
| 625 | Result := True;
|
|---|
| 626 | end;
|
|---|
| 627 |
|
|---|
| 628 | procedure TTransformation.PrepareTransform;
|
|---|
| 629 | begin
|
|---|
| 630 | // Dummy
|
|---|
| 631 | end;
|
|---|
| 632 |
|
|---|
| 633 | function TTransformation.ReverseTransform(const P: TFloatPoint): TFloatPoint;
|
|---|
| 634 | begin
|
|---|
| 635 | if not TransformValid then PrepareTransform;
|
|---|
| 636 | ReverseTransformFloat(P.X, P.Y, Result.X, Result.Y);
|
|---|
| 637 | end;
|
|---|
| 638 |
|
|---|
| 639 | function TTransformation.ReverseTransform(const P: TFixedPoint): TFixedPoint;
|
|---|
| 640 | begin
|
|---|
| 641 | if not TransformValid then PrepareTransform;
|
|---|
| 642 | ReverseTransformFixed(P.X, P.Y, Result.X, Result.Y);
|
|---|
| 643 | end;
|
|---|
| 644 |
|
|---|
| 645 | function TTransformation.ReverseTransform(const P: TPoint): TPoint;
|
|---|
| 646 | begin
|
|---|
| 647 | if not TransformValid then PrepareTransform;
|
|---|
| 648 | ReverseTransformInt(P.X, P.Y, Result.X, Result.Y);
|
|---|
| 649 | end;
|
|---|
| 650 |
|
|---|
| 651 | procedure TTransformation.ReverseTransformFixed(DstX, DstY: TFixed;
|
|---|
| 652 | out SrcX, SrcY: TFixed);
|
|---|
| 653 | var
|
|---|
| 654 | X, Y: TFloat;
|
|---|
| 655 | begin
|
|---|
| 656 | ReverseTransformFloat(DstX * FixedToFloat, DstY * FixedToFloat, X, Y);
|
|---|
| 657 | SrcX := Fixed(X);
|
|---|
| 658 | SrcY := Fixed(Y);
|
|---|
| 659 | end;
|
|---|
| 660 |
|
|---|
| 661 | procedure TTransformation.ReverseTransformFloat(DstX, DstY: TFloat;
|
|---|
| 662 | out SrcX, SrcY: TFloat);
|
|---|
| 663 | begin
|
|---|
| 664 | // ReverseTransformFloat is the top precisionlevel, all descendants must override at least this level!
|
|---|
| 665 | raise ETransformNotImplemented.CreateFmt(RCStrReverseTransformationNotImplemented, [Self.Classname]);
|
|---|
| 666 | end;
|
|---|
| 667 |
|
|---|
| 668 | procedure TTransformation.ReverseTransformInt(DstX, DstY: Integer;
|
|---|
| 669 | out SrcX, SrcY: Integer);
|
|---|
| 670 | var
|
|---|
| 671 | X, Y: TFixed;
|
|---|
| 672 | begin
|
|---|
| 673 | ReverseTransformFixed(DstX shl 16, DstY shl 16, X, Y);
|
|---|
| 674 | SrcX := FixedRound(X);
|
|---|
| 675 | SrcY := FixedRound(Y);
|
|---|
| 676 | end;
|
|---|
| 677 |
|
|---|
| 678 | procedure TTransformation.SetSrcRect(const Value: TFloatRect);
|
|---|
| 679 | begin
|
|---|
| 680 | FSrcRect := Value;
|
|---|
| 681 | Changed;
|
|---|
| 682 | end;
|
|---|
| 683 |
|
|---|
| 684 | function TTransformation.Transform(const P: TFloatPoint): TFloatPoint;
|
|---|
| 685 | begin
|
|---|
| 686 | if not TransformValid then PrepareTransform;
|
|---|
| 687 | TransformFloat(P.X, P.Y, Result.X, Result.Y);
|
|---|
| 688 | end;
|
|---|
| 689 |
|
|---|
| 690 | function TTransformation.Transform(const P: TFixedPoint): TFixedPoint;
|
|---|
| 691 | begin
|
|---|
| 692 | if not TransformValid then PrepareTransform;
|
|---|
| 693 | TransformFixed(P.X, P.Y, Result.X, Result.Y);
|
|---|
| 694 | end;
|
|---|
| 695 |
|
|---|
| 696 | function TTransformation.Transform(const P: TPoint): TPoint;
|
|---|
| 697 | begin
|
|---|
| 698 | if not TransformValid then PrepareTransform;
|
|---|
| 699 | TransformInt(P.X, P.Y, Result.X, Result.Y);
|
|---|
| 700 | end;
|
|---|
| 701 |
|
|---|
| 702 | procedure TTransformation.TransformFixed(SrcX, SrcY: TFixed; out DstX,
|
|---|
| 703 | DstY: TFixed);
|
|---|
| 704 | var
|
|---|
| 705 | X, Y: TFloat;
|
|---|
| 706 | begin
|
|---|
| 707 | TransformFloat(SrcX * FixedToFloat, SrcY * FixedToFloat, X, Y);
|
|---|
| 708 | DstX := Fixed(X);
|
|---|
| 709 | DstY := Fixed(Y);
|
|---|
| 710 | end;
|
|---|
| 711 |
|
|---|
| 712 | procedure TTransformation.TransformFloat(SrcX, SrcY: TFloat; out DstX, DstY: TFloat);
|
|---|
| 713 | begin
|
|---|
| 714 | // TransformFloat is the top precisionlevel, all descendants must override at least this level!
|
|---|
| 715 | raise ETransformNotImplemented.CreateFmt(RCStrForwardTransformationNotImplemented, [Self.Classname]);
|
|---|
| 716 | end;
|
|---|
| 717 |
|
|---|
| 718 | procedure TTransformation.TransformInt(SrcX, SrcY: Integer; out DstX, DstY: Integer);
|
|---|
| 719 | var
|
|---|
| 720 | X, Y: TFixed;
|
|---|
| 721 | begin
|
|---|
| 722 | TransformFixed(SrcX shl 16, SrcY shl 16, X, Y);
|
|---|
| 723 | DstX := FixedRound(X);
|
|---|
| 724 | DstY := FixedRound(Y);
|
|---|
| 725 | end;
|
|---|
| 726 |
|
|---|
| 727 |
|
|---|
| 728 | { TNestedTransformation }
|
|---|
| 729 |
|
|---|
| 730 | constructor TNestedTransformation.Create;
|
|---|
| 731 | begin
|
|---|
| 732 | FItems := TList.Create;
|
|---|
| 733 | end;
|
|---|
| 734 |
|
|---|
| 735 | destructor TNestedTransformation.Destroy;
|
|---|
| 736 | begin
|
|---|
| 737 | if Assigned(FItems) then Clear;
|
|---|
| 738 | FItems.Free;
|
|---|
| 739 | inherited;
|
|---|
| 740 | end;
|
|---|
| 741 |
|
|---|
| 742 | function TNestedTransformation.Add(
|
|---|
| 743 | ItemClass: TTransformationClass): TTransformation;
|
|---|
| 744 | begin
|
|---|
| 745 | Result := ItemClass.Create;
|
|---|
| 746 | {$IFDEF NEXTGEN}
|
|---|
| 747 | Result.__ObjAddRef;
|
|---|
| 748 | {$ENDIF}
|
|---|
| 749 | FItems.Add(Result);
|
|---|
| 750 | end;
|
|---|
| 751 |
|
|---|
| 752 | procedure TNestedTransformation.Clear;
|
|---|
| 753 | begin
|
|---|
| 754 | BeginUpdate;
|
|---|
| 755 | try
|
|---|
| 756 | while FItems.Count > 0 do
|
|---|
| 757 | Delete(FItems.Count - 1);
|
|---|
| 758 | finally
|
|---|
| 759 | EndUpdate;
|
|---|
| 760 | end;
|
|---|
| 761 | end;
|
|---|
| 762 |
|
|---|
| 763 | procedure TNestedTransformation.Delete(Index: Integer);
|
|---|
| 764 | begin
|
|---|
| 765 | TTransformation(FItems[Index]).Free;
|
|---|
| 766 | FItems.Delete(Index);
|
|---|
| 767 | end;
|
|---|
| 768 |
|
|---|
| 769 | function TNestedTransformation.GetCount: Integer;
|
|---|
| 770 | begin
|
|---|
| 771 | Result := FItems.Count;
|
|---|
| 772 | end;
|
|---|
| 773 |
|
|---|
| 774 | function TNestedTransformation.GetItem(Index: Integer): TTransformation;
|
|---|
| 775 | begin
|
|---|
| 776 | Result := FItems[Index];
|
|---|
| 777 | end;
|
|---|
| 778 |
|
|---|
| 779 | function TNestedTransformation.Insert(Index: Integer;
|
|---|
| 780 | ItemClass: TTransformationClass): TTransformation;
|
|---|
| 781 | begin
|
|---|
| 782 | BeginUpdate;
|
|---|
| 783 | try
|
|---|
| 784 | Result := Add(ItemClass);
|
|---|
| 785 | finally
|
|---|
| 786 | EndUpdate;
|
|---|
| 787 | end;
|
|---|
| 788 | end;
|
|---|
| 789 |
|
|---|
| 790 | procedure TNestedTransformation.PrepareTransform;
|
|---|
| 791 | var
|
|---|
| 792 | Index: Integer;
|
|---|
| 793 | begin
|
|---|
| 794 | for Index := 0 to Count - 1 do
|
|---|
| 795 | TTransformation(FItems[Index]).PrepareTransform;
|
|---|
| 796 | end;
|
|---|
| 797 |
|
|---|
| 798 | procedure TNestedTransformation.ReverseTransformFixed(DstX, DstY: TFixed;
|
|---|
| 799 | out SrcX, SrcY: TFixed);
|
|---|
| 800 | var
|
|---|
| 801 | Index: Integer;
|
|---|
| 802 | begin
|
|---|
| 803 | for Index := 0 to Count - 1 do
|
|---|
| 804 | begin
|
|---|
| 805 | TTransformation(FItems[Index]).ReverseTransformFixed(DstX, DstY, SrcX,
|
|---|
| 806 | SrcY);
|
|---|
| 807 | DstX := SrcX;
|
|---|
| 808 | DstY := SrcY;
|
|---|
| 809 | end;
|
|---|
| 810 | end;
|
|---|
| 811 |
|
|---|
| 812 | procedure TNestedTransformation.ReverseTransformFloat(DstX, DstY: TFloat;
|
|---|
| 813 | out SrcX, SrcY: TFloat);
|
|---|
| 814 | var
|
|---|
| 815 | Index: Integer;
|
|---|
| 816 | begin
|
|---|
| 817 | for Index := 0 to Count - 1 do
|
|---|
| 818 | begin
|
|---|
| 819 | TTransformation(FItems[Index]).ReverseTransformFloat(DstX, DstY, SrcX,
|
|---|
| 820 | SrcY);
|
|---|
| 821 | DstX := SrcX;
|
|---|
| 822 | DstY := SrcY;
|
|---|
| 823 | end;
|
|---|
| 824 | end;
|
|---|
| 825 |
|
|---|
| 826 | procedure TNestedTransformation.SetItem(Index: Integer;
|
|---|
| 827 | const Value: TTransformation);
|
|---|
| 828 | begin
|
|---|
| 829 | TCollectionItem(FItems[Index]).Assign(Value);
|
|---|
| 830 | end;
|
|---|
| 831 |
|
|---|
| 832 | procedure TNestedTransformation.TransformFixed(SrcX, SrcY: TFixed; out DstX,
|
|---|
| 833 | DstY: TFixed);
|
|---|
| 834 | var
|
|---|
| 835 | Index: Integer;
|
|---|
| 836 | begin
|
|---|
| 837 | for Index := 0 to Count - 1 do
|
|---|
| 838 | begin
|
|---|
| 839 | TTransformation(FItems[Index]).TransformFixed(SrcX, SrcY, DstX, DstY);
|
|---|
| 840 | SrcX := DstX;
|
|---|
| 841 | SrcY := DstY;
|
|---|
| 842 | end;
|
|---|
| 843 | end;
|
|---|
| 844 |
|
|---|
| 845 | procedure TNestedTransformation.TransformFloat(SrcX, SrcY: TFloat; out DstX,
|
|---|
| 846 | DstY: TFloat);
|
|---|
| 847 | var
|
|---|
| 848 | Index: Integer;
|
|---|
| 849 | begin
|
|---|
| 850 | for Index := 0 to Count - 1 do
|
|---|
| 851 | begin
|
|---|
| 852 | TTransformation(FItems[Index]).TransformFloat(SrcX, SrcY, DstX, DstY);
|
|---|
| 853 | SrcX := DstX;
|
|---|
| 854 | SrcY := DstY;
|
|---|
| 855 | end;
|
|---|
| 856 | end;
|
|---|
| 857 |
|
|---|
| 858 |
|
|---|
| 859 | { T3x3Transformation }
|
|---|
| 860 |
|
|---|
| 861 | procedure T3x3Transformation.PrepareTransform;
|
|---|
| 862 | begin
|
|---|
| 863 | FInverseMatrix := Matrix;
|
|---|
| 864 | Invert(FInverseMatrix);
|
|---|
| 865 |
|
|---|
| 866 | // calculate a fixed point (65536) factors
|
|---|
| 867 | FInverseFixedMatrix := FixedMatrix(FInverseMatrix);
|
|---|
| 868 | FFixedMatrix := FixedMatrix(Matrix);
|
|---|
| 869 |
|
|---|
| 870 | TransformValid := True;
|
|---|
| 871 | end;
|
|---|
| 872 |
|
|---|
| 873 | procedure T3x3Transformation.ReverseTransformFixed(DstX, DstY: TFixed; out SrcX,
|
|---|
| 874 | SrcY: TFixed);
|
|---|
| 875 | begin
|
|---|
| 876 | SrcX := FixedMul(DstX, FInverseFixedMatrix[0, 0]) +
|
|---|
| 877 | FixedMul(DstY, FInverseFixedMatrix[1, 0]) + FInverseFixedMatrix[2, 0];
|
|---|
| 878 | SrcY := FixedMul(DstX, FInverseFixedMatrix[0, 1]) +
|
|---|
| 879 | FixedMul(DstY, FInverseFixedMatrix[1, 1]) + FInverseFixedMatrix[2, 1];
|
|---|
| 880 | end;
|
|---|
| 881 |
|
|---|
| 882 | procedure T3x3Transformation.ReverseTransformFloat(DstX, DstY: TFloat; out SrcX,
|
|---|
| 883 | SrcY: TFloat);
|
|---|
| 884 | begin
|
|---|
| 885 | SrcX := DstX * FInverseMatrix[0, 0] + DstY * FInverseMatrix[1, 0] +
|
|---|
| 886 | FInverseMatrix[2, 0];
|
|---|
| 887 | SrcY := DstX * FInverseMatrix[0, 1] + DstY * FInverseMatrix[1, 1] +
|
|---|
| 888 | FInverseMatrix[2, 1];
|
|---|
| 889 | end;
|
|---|
| 890 |
|
|---|
| 891 | procedure T3x3Transformation.TransformFixed(SrcX, SrcY: TFixed; out DstX,
|
|---|
| 892 | DstY: TFixed);
|
|---|
| 893 | begin
|
|---|
| 894 | DstX := FixedMul(SrcX, FFixedMatrix[0, 0]) +
|
|---|
| 895 | FixedMul(SrcY, FFixedMatrix[1, 0]) + FFixedMatrix[2, 0];
|
|---|
| 896 | DstY := FixedMul(SrcX, FFixedMatrix[0, 1]) +
|
|---|
| 897 | FixedMul(SrcY, FFixedMatrix[1, 1]) + FFixedMatrix[2, 1];
|
|---|
| 898 | end;
|
|---|
| 899 |
|
|---|
| 900 | procedure T3x3Transformation.TransformFloat(SrcX, SrcY: TFloat; out DstX,
|
|---|
| 901 | DstY: TFloat);
|
|---|
| 902 | begin
|
|---|
| 903 | DstX := SrcX * Matrix[0, 0] + SrcY * Matrix[1, 0] + Matrix[2, 0];
|
|---|
| 904 | DstY := SrcX * Matrix[0, 1] + SrcY * Matrix[1, 1] + Matrix[2, 1];
|
|---|
| 905 | end;
|
|---|
| 906 |
|
|---|
| 907 |
|
|---|
| 908 | { TAffineTransformation }
|
|---|
| 909 |
|
|---|
| 910 | constructor TAffineTransformation.Create;
|
|---|
| 911 | begin
|
|---|
| 912 | FStackLevel := 0;
|
|---|
| 913 | FStack := nil;
|
|---|
| 914 | Clear;
|
|---|
| 915 | end;
|
|---|
| 916 |
|
|---|
| 917 | procedure TAffineTransformation.Clear;
|
|---|
| 918 | begin
|
|---|
| 919 | FMatrix := IdentityMatrix;
|
|---|
| 920 | Changed;
|
|---|
| 921 | end;
|
|---|
| 922 |
|
|---|
| 923 | procedure TAffineTransformation.Clear(BaseMatrix: TFloatMatrix);
|
|---|
| 924 | begin
|
|---|
| 925 | FMatrix := BaseMatrix;
|
|---|
| 926 | Changed;
|
|---|
| 927 | end;
|
|---|
| 928 |
|
|---|
| 929 | function TAffineTransformation.GetTransformedBounds(const ASrcRect: TFloatRect): TFloatRect;
|
|---|
| 930 | var
|
|---|
| 931 | V1, V2, V3, V4: TVector3f;
|
|---|
| 932 | begin
|
|---|
| 933 | V1[0] := ASrcRect.Left; V1[1] := ASrcRect.Top; V1[2] := 1;
|
|---|
| 934 | V2[0] := ASrcRect.Right; V2[1] := V1[1]; V2[2] := 1;
|
|---|
| 935 | V3[0] := V1[0]; V3[1] := ASrcRect.Bottom; V3[2] := 1;
|
|---|
| 936 | V4[0] := V2[0]; V4[1] := V3[1]; V4[2] := 1;
|
|---|
| 937 | V1 := VectorTransform(Matrix, V1);
|
|---|
| 938 | V2 := VectorTransform(Matrix, V2);
|
|---|
| 939 | V3 := VectorTransform(Matrix, V3);
|
|---|
| 940 | V4 := VectorTransform(Matrix, V4);
|
|---|
| 941 | Result.Left := Min(Min(V1[0], V2[0]), Min(V3[0], V4[0]));
|
|---|
| 942 | Result.Right := Max(Max(V1[0], V2[0]), Max(V3[0], V4[0]));
|
|---|
| 943 | Result.Top := Min(Min(V1[1], V2[1]), Min(V3[1], V4[1]));
|
|---|
| 944 | Result.Bottom := Max(Max(V1[1], V2[1]), Max(V3[1], V4[1]));
|
|---|
| 945 | end;
|
|---|
| 946 |
|
|---|
| 947 | procedure TAffineTransformation.Push;
|
|---|
| 948 | begin
|
|---|
| 949 | Inc(FStackLevel);
|
|---|
| 950 | ReallocMem(FStack, FStackLevel * SizeOf(TFloatMatrix));
|
|---|
| 951 | Move(FMatrix, FStack^[FStackLevel - 1], SizeOf(TFloatMatrix));
|
|---|
| 952 | end;
|
|---|
| 953 |
|
|---|
| 954 | procedure TAffineTransformation.Pop;
|
|---|
| 955 | begin
|
|---|
| 956 | if FStackLevel <= 0 then
|
|---|
| 957 | raise Exception.Create(RStrStackEmpty);
|
|---|
| 958 |
|
|---|
| 959 | Move(FStack^[FStackLevel - 1], FMatrix, SizeOf(TFloatMatrix));
|
|---|
| 960 | Dec(FStackLevel);
|
|---|
| 961 | Changed;
|
|---|
| 962 | end;
|
|---|
| 963 |
|
|---|
| 964 | procedure TAffineTransformation.Rotate(Alpha: TFloat);
|
|---|
| 965 | var
|
|---|
| 966 | S, C: TFloat;
|
|---|
| 967 | M: TFloatMatrix;
|
|---|
| 968 | begin
|
|---|
| 969 | Alpha := DegToRad(Alpha);
|
|---|
| 970 | GR32_Math.SinCos(Alpha, S, C);
|
|---|
| 971 | M := IdentityMatrix;
|
|---|
| 972 | M[0, 0] := C; M[1, 0] := S;
|
|---|
| 973 | M[0, 1] := -S; M[1, 1] := C;
|
|---|
| 974 | FMatrix := Mult(M, Matrix);
|
|---|
| 975 | Changed;
|
|---|
| 976 | end;
|
|---|
| 977 |
|
|---|
| 978 | procedure TAffineTransformation.Rotate(Cx, Cy, Alpha: TFloat);
|
|---|
| 979 | var
|
|---|
| 980 | S, C: TFloat;
|
|---|
| 981 | M: TFloatMatrix;
|
|---|
| 982 | begin
|
|---|
| 983 | if (Cx <> 0) or (Cy <> 0) then Translate(-Cx, -Cy);
|
|---|
| 984 | Alpha := DegToRad(Alpha);
|
|---|
| 985 | GR32_Math.SinCos(Alpha, S, C);
|
|---|
| 986 | M := IdentityMatrix;
|
|---|
| 987 | M[0, 0] := C; M[1, 0] := S;
|
|---|
| 988 | M[0, 1] := -S; M[1, 1] := C;
|
|---|
| 989 | FMatrix := Mult(M, Matrix);
|
|---|
| 990 | if (Cx <> 0) or (Cy <> 0) then Translate(Cx, Cy);
|
|---|
| 991 | Changed;
|
|---|
| 992 | end;
|
|---|
| 993 |
|
|---|
| 994 | procedure TAffineTransformation.Scale(Sx, Sy: TFloat);
|
|---|
| 995 | var
|
|---|
| 996 | M: TFloatMatrix;
|
|---|
| 997 | begin
|
|---|
| 998 | M := IdentityMatrix;
|
|---|
| 999 | M[0, 0] := Sx;
|
|---|
| 1000 | M[1, 1] := Sy;
|
|---|
| 1001 | FMatrix := Mult(M, Matrix);
|
|---|
| 1002 | Changed;
|
|---|
| 1003 | end;
|
|---|
| 1004 |
|
|---|
| 1005 | procedure TAffineTransformation.Scale(Value: TFloat);
|
|---|
| 1006 | var
|
|---|
| 1007 | M: TFloatMatrix;
|
|---|
| 1008 | begin
|
|---|
| 1009 | M := IdentityMatrix;
|
|---|
| 1010 | M[0, 0] := Value;
|
|---|
| 1011 | M[1, 1] := Value;
|
|---|
| 1012 | FMatrix := Mult(M, Matrix);
|
|---|
| 1013 | Changed;
|
|---|
| 1014 | end;
|
|---|
| 1015 |
|
|---|
| 1016 | procedure TAffineTransformation.Skew(Fx, Fy: TFloat);
|
|---|
| 1017 | var
|
|---|
| 1018 | M: TFloatMatrix;
|
|---|
| 1019 | begin
|
|---|
| 1020 | M := IdentityMatrix;
|
|---|
| 1021 | M[1, 0] := Fx;
|
|---|
| 1022 | M[0, 1] := Fy;
|
|---|
| 1023 | FMatrix := Mult(M, Matrix);
|
|---|
| 1024 | Changed;
|
|---|
| 1025 | end;
|
|---|
| 1026 |
|
|---|
| 1027 | procedure TAffineTransformation.Translate(Dx, Dy: TFloat);
|
|---|
| 1028 | var
|
|---|
| 1029 | M: TFloatMatrix;
|
|---|
| 1030 | begin
|
|---|
| 1031 | M := IdentityMatrix;
|
|---|
| 1032 | M[2, 0] := Dx;
|
|---|
| 1033 | M[2, 1] := Dy;
|
|---|
| 1034 | FMatrix := Mult(M, Matrix);
|
|---|
| 1035 |
|
|---|
| 1036 | Changed;
|
|---|
| 1037 | end;
|
|---|
| 1038 |
|
|---|
| 1039 |
|
|---|
| 1040 | { TProjectiveTransformation }
|
|---|
| 1041 |
|
|---|
| 1042 | function TProjectiveTransformation.GetTransformedBounds(const ASrcRect: TFloatRect): TFloatRect;
|
|---|
| 1043 | begin
|
|---|
| 1044 | Result.Left := Min(Min(FQuadX[0], FQuadX[1]), Min(FQuadX[2], FQuadX[3]));
|
|---|
| 1045 | Result.Right := Max(Max(FQuadX[0], FQuadX[1]), Max(FQuadX[2], FQuadX[3]));
|
|---|
| 1046 | Result.Top := Min(Min(FQuadY[0], FQuadY[1]), Min(FQuadY[2], FQuadY[3]));
|
|---|
| 1047 | Result.Bottom := Max(Max(FQuadY[0], FQuadY[1]), Max(FQuadY[2], FQuadY[3]));
|
|---|
| 1048 | end;
|
|---|
| 1049 |
|
|---|
| 1050 | function TProjectiveTransformation.GetX(Index: Integer): TFloat;
|
|---|
| 1051 | begin
|
|---|
| 1052 | Result := FQuadX[Index];
|
|---|
| 1053 | end;
|
|---|
| 1054 |
|
|---|
| 1055 | function TProjectiveTransformation.GetY(Index: Integer): TFloat;
|
|---|
| 1056 | begin
|
|---|
| 1057 | Result := FQuadY[Index];
|
|---|
| 1058 | end;
|
|---|
| 1059 |
|
|---|
| 1060 | procedure TProjectiveTransformation.PrepareTransform;
|
|---|
| 1061 | var
|
|---|
| 1062 | dx1, dx2, px, dy1, dy2, py: TFloat;
|
|---|
| 1063 | g, h, k: TFloat;
|
|---|
| 1064 | R: TFloatMatrix;
|
|---|
| 1065 | begin
|
|---|
| 1066 | px := FQuadX[0] - FQuadX[1] + FQuadX[2] - FQuadX[3];
|
|---|
| 1067 | py := FQuadY[0] - FQuadY[1] + FQuadY[2] - FQuadY[3];
|
|---|
| 1068 |
|
|---|
| 1069 | if (px = 0) and (py = 0) then
|
|---|
| 1070 | begin
|
|---|
| 1071 | // affine mapping
|
|---|
| 1072 | FMatrix[0, 0] := FQuadX[1] - FQuadX[0];
|
|---|
| 1073 | FMatrix[1, 0] := FQuadX[2] - FQuadX[1];
|
|---|
| 1074 | FMatrix[2, 0] := FQuadX[0];
|
|---|
| 1075 |
|
|---|
| 1076 | FMatrix[0, 1] := FQuadY[1] - FQuadY[0];
|
|---|
| 1077 | FMatrix[1, 1] := FQuadY[2] - FQuadY[1];
|
|---|
| 1078 | FMatrix[2, 1] := FQuadY[0];
|
|---|
| 1079 |
|
|---|
| 1080 | FMatrix[0, 2] := 0;
|
|---|
| 1081 | FMatrix[1, 2] := 0;
|
|---|
| 1082 | FMatrix[2, 2] := 1;
|
|---|
| 1083 | end
|
|---|
| 1084 | else
|
|---|
| 1085 | begin
|
|---|
| 1086 | // projective mapping
|
|---|
| 1087 | dx1 := FQuadX[1] - FQuadX[2];
|
|---|
| 1088 | dx2 := FQuadX[3] - FQuadX[2];
|
|---|
| 1089 | dy1 := FQuadY[1] - FQuadY[2];
|
|---|
| 1090 | dy2 := FQuadY[3] - FQuadY[2];
|
|---|
| 1091 | k := dx1 * dy2 - dx2 * dy1;
|
|---|
| 1092 | if k <> 0 then
|
|---|
| 1093 | begin
|
|---|
| 1094 | k := 1 / k;
|
|---|
| 1095 | g := (px * dy2 - py * dx2) * k;
|
|---|
| 1096 | h := (dx1 * py - dy1 * px) * k;
|
|---|
| 1097 |
|
|---|
| 1098 | FMatrix[0, 0] := FQuadX[1] - FQuadX[0] + g * FQuadX[1];
|
|---|
| 1099 | FMatrix[1, 0] := FQuadX[3] - FQuadX[0] + h * FQuadX[3];
|
|---|
| 1100 | FMatrix[2, 0] := FQuadX[0];
|
|---|
| 1101 |
|
|---|
| 1102 | FMatrix[0, 1] := FQuadY[1] - FQuadY[0] + g * FQuadY[1];
|
|---|
| 1103 | FMatrix[1, 1] := FQuadY[3] - FQuadY[0] + h * FQuadY[3];
|
|---|
| 1104 | FMatrix[2, 1] := FQuadY[0];
|
|---|
| 1105 |
|
|---|
| 1106 | FMatrix[0, 2] := g;
|
|---|
| 1107 | FMatrix[1, 2] := h;
|
|---|
| 1108 | FMatrix[2, 2] := 1;
|
|---|
| 1109 | end
|
|---|
| 1110 | else
|
|---|
| 1111 | begin
|
|---|
| 1112 | FillChar(FMatrix, SizeOf(FMatrix), 0);
|
|---|
| 1113 | end;
|
|---|
| 1114 | end;
|
|---|
| 1115 |
|
|---|
| 1116 | // denormalize texture space (u, v)
|
|---|
| 1117 | R := IdentityMatrix;
|
|---|
| 1118 | R[0, 0] := 1 / (SrcRect.Right - SrcRect.Left);
|
|---|
| 1119 | R[1, 1] := 1 / (SrcRect.Bottom - SrcRect.Top);
|
|---|
| 1120 | FMatrix := Mult(FMatrix, R);
|
|---|
| 1121 |
|
|---|
| 1122 | R := IdentityMatrix;
|
|---|
| 1123 | R[2, 0] := -SrcRect.Left;
|
|---|
| 1124 | R[2, 1] := -SrcRect.Top;
|
|---|
| 1125 | FMatrix := Mult(FMatrix, R);
|
|---|
| 1126 |
|
|---|
| 1127 | inherited;
|
|---|
| 1128 | end;
|
|---|
| 1129 |
|
|---|
| 1130 | procedure TProjectiveTransformation.SetX(Index: Integer; const Value: TFloat);
|
|---|
| 1131 | begin
|
|---|
| 1132 | FQuadX[Index] := Value;
|
|---|
| 1133 | Changed;
|
|---|
| 1134 | end;
|
|---|
| 1135 |
|
|---|
| 1136 | procedure TProjectiveTransformation.SetY(Index: Integer; const Value: TFloat);
|
|---|
| 1137 | begin
|
|---|
| 1138 | FQuadY[Index] := Value;
|
|---|
| 1139 | Changed;
|
|---|
| 1140 | end;
|
|---|
| 1141 |
|
|---|
| 1142 | procedure TProjectiveTransformation.ReverseTransformFixed(DstX, DstY: TFixed;
|
|---|
| 1143 | out SrcX, SrcY: TFixed);
|
|---|
| 1144 | var
|
|---|
| 1145 | Z: TFixed;
|
|---|
| 1146 | Zf: TFloat;
|
|---|
| 1147 | begin
|
|---|
| 1148 | Z := FixedMul(FInverseFixedMatrix[0, 2], DstX) +
|
|---|
| 1149 | FixedMul(FInverseFixedMatrix[1, 2], DstY) + FInverseFixedMatrix[2, 2];
|
|---|
| 1150 |
|
|---|
| 1151 | if Z = 0 then Exit;
|
|---|
| 1152 |
|
|---|
| 1153 | {$IFDEF UseInlining}
|
|---|
| 1154 | SrcX := FixedMul(DstX, FInverseFixedMatrix[0, 0]) +
|
|---|
| 1155 | FixedMul(DstY, FInverseFixedMatrix[1, 0]) + FInverseFixedMatrix[2, 0];
|
|---|
| 1156 | SrcY := FixedMul(DstX, FInverseFixedMatrix[0,1]) +
|
|---|
| 1157 | FixedMul(DstY, FInverseFixedMatrix[1, 1]) + FInverseFixedMatrix[2, 1];
|
|---|
| 1158 | {$ELSE}
|
|---|
| 1159 | inherited;
|
|---|
| 1160 | {$ENDIF}
|
|---|
| 1161 |
|
|---|
| 1162 | if Z <> FixedOne then
|
|---|
| 1163 | begin
|
|---|
| 1164 | EMMS;
|
|---|
| 1165 | Zf := FixedOne / Z;
|
|---|
| 1166 | SrcX := Round(SrcX * Zf);
|
|---|
| 1167 | SrcY := Round(SrcY * Zf);
|
|---|
| 1168 | end;
|
|---|
| 1169 | end;
|
|---|
| 1170 |
|
|---|
| 1171 | procedure TProjectiveTransformation.ReverseTransformFloat(
|
|---|
| 1172 | DstX, DstY: TFloat;
|
|---|
| 1173 | out SrcX, SrcY: TFloat);
|
|---|
| 1174 | var
|
|---|
| 1175 | Z: TFloat;
|
|---|
| 1176 | begin
|
|---|
| 1177 | EMMS;
|
|---|
| 1178 | Z := FInverseMatrix[0, 2] * DstX + FInverseMatrix[1, 2] * DstY +
|
|---|
| 1179 | FInverseMatrix[2, 2];
|
|---|
| 1180 |
|
|---|
| 1181 | if Z = 0 then Exit;
|
|---|
| 1182 |
|
|---|
| 1183 | {$IFDEF UseInlining}
|
|---|
| 1184 | SrcX := DstX * FInverseMatrix[0, 0] + DstY * FInverseMatrix[1, 0] +
|
|---|
| 1185 | FInverseMatrix[2, 0];
|
|---|
| 1186 | SrcY := DstX * FInverseMatrix[0, 1] + DstY * FInverseMatrix[1, 1] +
|
|---|
| 1187 | FInverseMatrix[2, 1];
|
|---|
| 1188 | {$ELSE}
|
|---|
| 1189 | inherited;
|
|---|
| 1190 | {$ENDIF}
|
|---|
| 1191 |
|
|---|
| 1192 | if Z <> 1 then
|
|---|
| 1193 | begin
|
|---|
| 1194 | Z := 1 / Z;
|
|---|
| 1195 | SrcX := SrcX * Z;
|
|---|
| 1196 | SrcY := SrcY * Z;
|
|---|
| 1197 | end;
|
|---|
| 1198 | end;
|
|---|
| 1199 |
|
|---|
| 1200 | procedure TProjectiveTransformation.TransformFixed(SrcX, SrcY: TFixed;
|
|---|
| 1201 | out DstX, DstY: TFixed);
|
|---|
| 1202 | var
|
|---|
| 1203 | Z: TFixed;
|
|---|
| 1204 | Zf: TFloat;
|
|---|
| 1205 | begin
|
|---|
| 1206 | Z := FixedMul(FFixedMatrix[0, 2], SrcX) +
|
|---|
| 1207 | FixedMul(FFixedMatrix[1, 2], SrcY) + FFixedMatrix[2, 2];
|
|---|
| 1208 |
|
|---|
| 1209 | if Z = 0 then Exit;
|
|---|
| 1210 |
|
|---|
| 1211 | {$IFDEF UseInlining}
|
|---|
| 1212 | DstX := FixedMul(SrcX, FFixedMatrix[0, 0]) +
|
|---|
| 1213 | FixedMul(SrcY, FFixedMatrix[1, 0]) + FFixedMatrix[2, 0];
|
|---|
| 1214 | DstY := FixedMul(SrcX, FFixedMatrix[0, 1]) +
|
|---|
| 1215 | FixedMul(SrcY, FFixedMatrix[1, 1]) + FFixedMatrix[2, 1];
|
|---|
| 1216 | {$ELSE}
|
|---|
| 1217 | inherited;
|
|---|
| 1218 | {$ENDIF}
|
|---|
| 1219 |
|
|---|
| 1220 | if Z <> FixedOne then
|
|---|
| 1221 | begin
|
|---|
| 1222 | EMMS;
|
|---|
| 1223 | Zf := FixedOne / Z;
|
|---|
| 1224 | DstX := Round(DstX * Zf);
|
|---|
| 1225 | DstY := Round(DstY * Zf);
|
|---|
| 1226 | end;
|
|---|
| 1227 | end;
|
|---|
| 1228 |
|
|---|
| 1229 | procedure TProjectiveTransformation.TransformFloat(SrcX, SrcY: TFloat;
|
|---|
| 1230 | out DstX, DstY: TFloat);
|
|---|
| 1231 | var
|
|---|
| 1232 | Z: TFloat;
|
|---|
| 1233 | begin
|
|---|
| 1234 | EMMS;
|
|---|
| 1235 | Z := FMatrix[0, 2] * SrcX + FMatrix[1, 2] * SrcY + FMatrix[2, 2];
|
|---|
| 1236 |
|
|---|
| 1237 | if Z = 0 then Exit;
|
|---|
| 1238 |
|
|---|
| 1239 | {$IFDEF UseInlining}
|
|---|
| 1240 | DstX := SrcX * Matrix[0, 0] + SrcY * Matrix[1, 0] + Matrix[2, 0];
|
|---|
| 1241 | DstY := SrcX * Matrix[0, 1] + SrcY * Matrix[1, 1] + Matrix[2, 1];
|
|---|
| 1242 | {$ELSE}
|
|---|
| 1243 | inherited;
|
|---|
| 1244 | {$ENDIF}
|
|---|
| 1245 |
|
|---|
| 1246 | if Z <> 1 then
|
|---|
| 1247 | begin
|
|---|
| 1248 | Z := 1 / Z;
|
|---|
| 1249 | DstX := DstX * Z;
|
|---|
| 1250 | DstY := DstY * Z;
|
|---|
| 1251 | end;
|
|---|
| 1252 | end;
|
|---|
| 1253 |
|
|---|
| 1254 |
|
|---|
| 1255 | { TTwirlTransformation }
|
|---|
| 1256 |
|
|---|
| 1257 | constructor TTwirlTransformation.Create;
|
|---|
| 1258 | begin
|
|---|
| 1259 | FTwirl := 0.03;
|
|---|
| 1260 | end;
|
|---|
| 1261 |
|
|---|
| 1262 | function TTwirlTransformation.GetTransformedBounds(const ASrcRect: TFloatRect): TFloatRect;
|
|---|
| 1263 | var
|
|---|
| 1264 | Cx, Cy, R: TFloat;
|
|---|
| 1265 | const
|
|---|
| 1266 | CPiHalf: TFloat = 0.5 * Pi;
|
|---|
| 1267 | begin
|
|---|
| 1268 | Cx := (ASrcRect.Left + ASrcRect.Right) * 0.5;
|
|---|
| 1269 | Cy := (ASrcRect.Top + ASrcRect.Bottom) * 0.5;
|
|---|
| 1270 | R := Max(Cx - ASrcRect.Left, Cy - ASrcRect.Top);
|
|---|
| 1271 | Result.Left := Cx - R * CPiHalf;
|
|---|
| 1272 | Result.Right := Cx + R * CPiHalf;
|
|---|
| 1273 | Result.Top := Cy - R * CPiHalf;
|
|---|
| 1274 | Result.Bottom := Cy + R * CPiHalf;
|
|---|
| 1275 | end;
|
|---|
| 1276 |
|
|---|
| 1277 | procedure TTwirlTransformation.PrepareTransform;
|
|---|
| 1278 | begin
|
|---|
| 1279 | with FSrcRect do
|
|---|
| 1280 | begin
|
|---|
| 1281 | Frx := (Right - Left) * 0.5;
|
|---|
| 1282 | Fry := (Bottom - Top) * 0.5;
|
|---|
| 1283 | end;
|
|---|
| 1284 | TransformValid := True;
|
|---|
| 1285 | end;
|
|---|
| 1286 |
|
|---|
| 1287 | procedure TTwirlTransformation.ReverseTransformFloat(DstX, DstY: TFloat;
|
|---|
| 1288 | out SrcX, SrcY: TFloat);
|
|---|
| 1289 | var
|
|---|
| 1290 | xf, yf, r, t: Single;
|
|---|
| 1291 | begin
|
|---|
| 1292 | xf := DstX - Frx;
|
|---|
| 1293 | yf := DstY - Fry;
|
|---|
| 1294 |
|
|---|
| 1295 | r := GR32_Math.Hypot(xf, yf);
|
|---|
| 1296 | t := ArcTan2(yf, xf) + r * FTwirl;
|
|---|
| 1297 | GR32_Math.SinCos(t, yf, xf);
|
|---|
| 1298 |
|
|---|
| 1299 | SrcX := Frx + r * xf;
|
|---|
| 1300 | SrcY := Fry + r * yf;
|
|---|
| 1301 | end;
|
|---|
| 1302 |
|
|---|
| 1303 | procedure TTwirlTransformation.SetTwirl(const Value: TFloat);
|
|---|
| 1304 | begin
|
|---|
| 1305 | FTwirl := Value;
|
|---|
| 1306 | Changed;
|
|---|
| 1307 | end;
|
|---|
| 1308 |
|
|---|
| 1309 | { TBloatTransformation }
|
|---|
| 1310 |
|
|---|
| 1311 | constructor TBloatTransformation.Create;
|
|---|
| 1312 | begin
|
|---|
| 1313 | FBloatPower := 0.3;
|
|---|
| 1314 | end;
|
|---|
| 1315 |
|
|---|
| 1316 | procedure TBloatTransformation.PrepareTransform;
|
|---|
| 1317 | begin
|
|---|
| 1318 | FPiW := (Pi / (FSrcRect.Right - FSrcRect.Left));
|
|---|
| 1319 | FPiH := (Pi / (FSrcRect.Bottom - FSrcRect.Top));
|
|---|
| 1320 | FBP := FBloatPower * Max(FSrcRect.Right - FSrcRect.Left, FSrcRect.Bottom - FSrcRect.Top);
|
|---|
| 1321 | TransformValid := True;
|
|---|
| 1322 | end;
|
|---|
| 1323 |
|
|---|
| 1324 | procedure TBloatTransformation.ReverseTransformFloat(DstX, DstY: TFloat;
|
|---|
| 1325 | out SrcX, SrcY: TFloat);
|
|---|
| 1326 | var
|
|---|
| 1327 | SinY, CosY, SinX, CosX, t: Single;
|
|---|
| 1328 | begin
|
|---|
| 1329 | GR32_Math.SinCos(FPiH * DstY, SinY, CosY);
|
|---|
| 1330 | GR32_Math.SinCos(FPiW * DstX, SinX, CosX);
|
|---|
| 1331 | t := FBP * SinY * SinX;
|
|---|
| 1332 | SrcX := DstX + t * CosX;
|
|---|
| 1333 | SrcY := DstY + t * CosY;
|
|---|
| 1334 | end;
|
|---|
| 1335 |
|
|---|
| 1336 | procedure TBloatTransformation.TransformFloat(DstX, DstY: TFloat;
|
|---|
| 1337 | out SrcX, SrcY: TFloat);
|
|---|
| 1338 | var
|
|---|
| 1339 | SinY, CosY, SinX, CosX, t: Single;
|
|---|
| 1340 | begin
|
|---|
| 1341 | GR32_Math.SinCos(-FPiH * DstY, SinY, CosY);
|
|---|
| 1342 | GR32_Math.SinCos(-FPiW * DstX, SinX, CosX);
|
|---|
| 1343 | t := FBP * SinY * SinX;
|
|---|
| 1344 | SrcX := DstX + t * CosX;
|
|---|
| 1345 | SrcY := DstY + t * CosY;
|
|---|
| 1346 | end;
|
|---|
| 1347 |
|
|---|
| 1348 | procedure TBloatTransformation.SetBloatPower(const Value: TFloat);
|
|---|
| 1349 | begin
|
|---|
| 1350 | FBloatPower := Value;
|
|---|
| 1351 | Changed;
|
|---|
| 1352 | end;
|
|---|
| 1353 |
|
|---|
| 1354 | { TFishEyeTransformation }
|
|---|
| 1355 |
|
|---|
| 1356 | procedure TFishEyeTransformation.PrepareTransform;
|
|---|
| 1357 | begin
|
|---|
| 1358 | with FSrcRect do
|
|---|
| 1359 | begin
|
|---|
| 1360 | Frx := (Right - Left) * 0.5;
|
|---|
| 1361 | Fry := (Bottom - Top) * 0.5;
|
|---|
| 1362 | if Frx <= Fry then
|
|---|
| 1363 | begin
|
|---|
| 1364 | FMinR := Frx;
|
|---|
| 1365 | Sx := 1;
|
|---|
| 1366 | Sy:= Frx / Fry;
|
|---|
| 1367 | end
|
|---|
| 1368 | else
|
|---|
| 1369 | begin
|
|---|
| 1370 | FMinR := Fry;
|
|---|
| 1371 | Sx:= Fry / Frx;
|
|---|
| 1372 | Sy := 1;
|
|---|
| 1373 | end;
|
|---|
| 1374 | Fsr := 1 / FMinR;
|
|---|
| 1375 | Faw := ArcSin(Constrain(FMinR * Fsr, -1, 1));
|
|---|
| 1376 | if Faw <> 0 then Faw := 1 / Faw;
|
|---|
| 1377 | Faw := Faw * FMinR
|
|---|
| 1378 | end;
|
|---|
| 1379 | TransformValid := True;
|
|---|
| 1380 | end;
|
|---|
| 1381 |
|
|---|
| 1382 | procedure TFishEyeTransformation.ReverseTransformFloat(DstX, DstY: TFloat;
|
|---|
| 1383 | out SrcX, SrcY: TFloat);
|
|---|
| 1384 | var
|
|---|
| 1385 | d, Xrx, Yry: TFloat;
|
|---|
| 1386 | begin
|
|---|
| 1387 | Yry := (DstY - Fry) * sy;
|
|---|
| 1388 | Xrx := (DstX - Frx) * sx;
|
|---|
| 1389 | d := GR32_Math.Hypot(Xrx, Yry);
|
|---|
| 1390 | if (d < FMinR) and (d > 0) then
|
|---|
| 1391 | begin
|
|---|
| 1392 | d := ArcSin(d * Fsr) * Faw / d;
|
|---|
| 1393 | SrcX := Frx + Xrx * d;
|
|---|
| 1394 | SrcY := Fry + Yry * d;
|
|---|
| 1395 | end
|
|---|
| 1396 | else
|
|---|
| 1397 | begin
|
|---|
| 1398 | SrcX := DstX;
|
|---|
| 1399 | SrcY := DstY;
|
|---|
| 1400 | end;
|
|---|
| 1401 | end;
|
|---|
| 1402 |
|
|---|
| 1403 |
|
|---|
| 1404 | { TPolarTransformation }
|
|---|
| 1405 |
|
|---|
| 1406 | procedure TPolarTransformation.PrepareTransform;
|
|---|
| 1407 | begin
|
|---|
| 1408 | Sx := SrcRect.Right - SrcRect.Left;
|
|---|
| 1409 | Sy := SrcRect.Bottom - SrcRect.Top;
|
|---|
| 1410 | Cx := (DstRect.Left + DstRect.Right) * 0.5;
|
|---|
| 1411 | Cy := (DstRect.Top + DstRect.Bottom) * 0.5;
|
|---|
| 1412 | Dx := DstRect.Right - Cx;
|
|---|
| 1413 | Dy := DstRect.Bottom - Cy;
|
|---|
| 1414 |
|
|---|
| 1415 | Rt := (1 / (PI * 2)) * Sx;
|
|---|
| 1416 |
|
|---|
| 1417 | Rt2 := Sx;
|
|---|
| 1418 | if Rt2 <> 0 then Rt2 := 1 / Sx else Rt2 := 0.00000001;
|
|---|
| 1419 | Rt2 := Rt2 * 2 * Pi;
|
|---|
| 1420 |
|
|---|
| 1421 | Rr := Sy;
|
|---|
| 1422 | if Rr <> 0 then Rr := 1 / Rr else Rr := 0.00000001;
|
|---|
| 1423 |
|
|---|
| 1424 | Rcx := Cx;
|
|---|
| 1425 | if Rcx <> 0 then Rcx := 1 / Rcx else Rcx := 0.00000001;
|
|---|
| 1426 |
|
|---|
| 1427 | Rcy := Cy;
|
|---|
| 1428 | if Rcy <> 0 then Rcy := 1 / Rcy else Rcy := 0.00000001;
|
|---|
| 1429 |
|
|---|
| 1430 | TransformValid := True;
|
|---|
| 1431 | end;
|
|---|
| 1432 |
|
|---|
| 1433 | procedure TPolarTransformation.SetDstRect(const Value: TFloatRect);
|
|---|
| 1434 | begin
|
|---|
| 1435 | FDstRect := Value;
|
|---|
| 1436 | Changed;
|
|---|
| 1437 | end;
|
|---|
| 1438 |
|
|---|
| 1439 | procedure TPolarTransformation.TransformFloat(SrcX, SrcY: TFloat; out DstX,
|
|---|
| 1440 | DstY: TFloat);
|
|---|
| 1441 | var
|
|---|
| 1442 | R, Theta, S, C: TFloat;
|
|---|
| 1443 | begin
|
|---|
| 1444 | Theta := (SrcX - SrcRect.Left) * Rt2 + Phase;
|
|---|
| 1445 | R := (SrcY - SrcRect.Bottom) * Rr;
|
|---|
| 1446 | GR32_Math.SinCos(Theta, S, C);
|
|---|
| 1447 |
|
|---|
| 1448 | DstX := Dx * R * C + Cx;
|
|---|
| 1449 | DstY := Dy * R * S + Cy;
|
|---|
| 1450 | end;
|
|---|
| 1451 |
|
|---|
| 1452 | procedure TPolarTransformation.ReverseTransformFloat(DstX, DstY: TFloat;
|
|---|
| 1453 | out SrcX, SrcY: TFloat);
|
|---|
| 1454 | const
|
|---|
| 1455 | PI2 = 2 * PI;
|
|---|
| 1456 | var
|
|---|
| 1457 | Dcx, Dcy, Theta: TFloat;
|
|---|
| 1458 | begin
|
|---|
| 1459 | Dcx := (DstX - Cx) * Rcx;
|
|---|
| 1460 | Dcy := (DstY - Cy) * Rcy;
|
|---|
| 1461 |
|
|---|
| 1462 | Theta := ArcTan2(Dcy, Dcx) + Pi - Phase;
|
|---|
| 1463 | if Theta < 0 then Theta := Theta + PI2;
|
|---|
| 1464 |
|
|---|
| 1465 | SrcX := SrcRect.Left + Theta * Rt;
|
|---|
| 1466 | SrcY := SrcRect.Bottom - GR32_Math.Hypot(Dcx, Dcy) * Sy;
|
|---|
| 1467 | end;
|
|---|
| 1468 |
|
|---|
| 1469 |
|
|---|
| 1470 | procedure TPolarTransformation.SetPhase(const Value: TFloat);
|
|---|
| 1471 | begin
|
|---|
| 1472 | FPhase := Value;
|
|---|
| 1473 | Changed;
|
|---|
| 1474 | end;
|
|---|
| 1475 |
|
|---|
| 1476 |
|
|---|
| 1477 | { TPathTransformation }
|
|---|
| 1478 |
|
|---|
| 1479 | destructor TPathTransformation.Destroy;
|
|---|
| 1480 | begin
|
|---|
| 1481 | FTopHypot := nil;
|
|---|
| 1482 | FBottomHypot := nil;
|
|---|
| 1483 | inherited;
|
|---|
| 1484 | end;
|
|---|
| 1485 |
|
|---|
| 1486 | procedure TPathTransformation.PrepareTransform;
|
|---|
| 1487 | var
|
|---|
| 1488 | I: Integer;
|
|---|
| 1489 | L, DDist: TFloat;
|
|---|
| 1490 | begin
|
|---|
| 1491 | if not (Assigned(FTopCurve) and Assigned(FBottomCurve)) then
|
|---|
| 1492 | raise ETransformError.Create(RCStrTopBottomCurveNil);
|
|---|
| 1493 |
|
|---|
| 1494 | SetLength(FTopHypot, Length(FTopCurve));
|
|---|
| 1495 | SetLength(FBottomHypot, Length(FBottomCurve));
|
|---|
| 1496 |
|
|---|
| 1497 | L := 0;
|
|---|
| 1498 | for I := 0 to High(FTopCurve) - 1 do
|
|---|
| 1499 | begin
|
|---|
| 1500 | FTopHypot[I].Dist := L;
|
|---|
| 1501 | with FTopCurve[I + 1] do
|
|---|
| 1502 | L := L + GR32_Math.Hypot(FTopCurve[I].X - X, FTopCurve[I].Y - Y);
|
|---|
| 1503 | end;
|
|---|
| 1504 | FTopLength := L;
|
|---|
| 1505 |
|
|---|
| 1506 | for I := 1 to High(FTopCurve) do
|
|---|
| 1507 | with FTopHypot[I] do
|
|---|
| 1508 | begin
|
|---|
| 1509 | DDist := Dist - FTopHypot[I - 1].Dist;
|
|---|
| 1510 | if DDist <> 0 then
|
|---|
| 1511 | RecDist := 1 / DDist
|
|---|
| 1512 | else if I > 1 then
|
|---|
| 1513 | RecDist := FTopHypot[I - 1].RecDist
|
|---|
| 1514 | else
|
|---|
| 1515 | RecDist := 0;
|
|---|
| 1516 | end;
|
|---|
| 1517 |
|
|---|
| 1518 | L := 0;
|
|---|
| 1519 | for I := 0 to High(FBottomCurve) - 1 do
|
|---|
| 1520 | begin
|
|---|
| 1521 | FBottomHypot[I].Dist := L;
|
|---|
| 1522 | with FBottomCurve[I + 1] do
|
|---|
| 1523 | L := L + GR32_Math.Hypot(FBottomCurve[I].X - X, FBottomCurve[I].Y - Y);
|
|---|
| 1524 | end;
|
|---|
| 1525 | FBottomLength := L;
|
|---|
| 1526 |
|
|---|
| 1527 | for I := 1 to High(FBottomCurve) do
|
|---|
| 1528 | with FBottomHypot[I] do
|
|---|
| 1529 | begin
|
|---|
| 1530 | DDist := Dist - FBottomHypot[I - 1].Dist;
|
|---|
| 1531 | if DDist <> 0 then
|
|---|
| 1532 | RecDist := 1 / DDist
|
|---|
| 1533 | else if I > 1 then
|
|---|
| 1534 | RecDist := FBottomHypot[I - 1].RecDist
|
|---|
| 1535 | else
|
|---|
| 1536 | RecDist := 0;
|
|---|
| 1537 | end;
|
|---|
| 1538 |
|
|---|
| 1539 | rdx := 1 / (SrcRect.Right - SrcRect.Left);
|
|---|
| 1540 | rdy := 1 / (SrcRect.Bottom - SrcRect.Top);
|
|---|
| 1541 |
|
|---|
| 1542 | TransformValid := True;
|
|---|
| 1543 | end;
|
|---|
| 1544 |
|
|---|
| 1545 | procedure TPathTransformation.SetBottomCurve(const Value: TArrayOfFloatPoint);
|
|---|
| 1546 | begin
|
|---|
| 1547 | FBottomCurve := Value;
|
|---|
| 1548 | Changed;
|
|---|
| 1549 | end;
|
|---|
| 1550 |
|
|---|
| 1551 | procedure TPathTransformation.SetTopCurve(const Value: TArrayOfFloatPoint);
|
|---|
| 1552 | begin
|
|---|
| 1553 | FTopCurve := Value;
|
|---|
| 1554 | Changed;
|
|---|
| 1555 | end;
|
|---|
| 1556 |
|
|---|
| 1557 | procedure TPathTransformation.TransformFloat(SrcX, SrcY: TFloat; out DstX,
|
|---|
| 1558 | DstY: TFloat);
|
|---|
| 1559 | var
|
|---|
| 1560 | I, H: Integer;
|
|---|
| 1561 | X, Y, fx, dx, dy, r, Tx, Ty, Bx, By: TFloat;
|
|---|
| 1562 | begin
|
|---|
| 1563 | X := (SrcX - SrcRect.Left) * rdx;
|
|---|
| 1564 | Y := (SrcY - SrcRect.Top) * rdy;
|
|---|
| 1565 |
|
|---|
| 1566 | fx := X * FTopLength;
|
|---|
| 1567 | I := 1;
|
|---|
| 1568 | H := High(FTopHypot);
|
|---|
| 1569 | while (FTopHypot[I].Dist < fx) and (I < H) do Inc(I);
|
|---|
| 1570 |
|
|---|
| 1571 |
|
|---|
| 1572 | with FTopHypot[I] do
|
|---|
| 1573 | r := (Dist - fx) * RecDist;
|
|---|
| 1574 |
|
|---|
| 1575 | dx := (FTopCurve[I - 1].X - FTopCurve[I].X);
|
|---|
| 1576 | dy := (FTopCurve[I - 1].Y - FTopCurve[I].Y);
|
|---|
| 1577 | Tx := FTopCurve[I].X + r * dx;
|
|---|
| 1578 | Ty := FTopCurve[I].Y + r * dy;
|
|---|
| 1579 |
|
|---|
| 1580 | fx := X * FBottomLength;
|
|---|
| 1581 | I := 1;
|
|---|
| 1582 | H := High(FBottomHypot);
|
|---|
| 1583 | while (FBottomHypot[I].Dist < fx) and (I < H) do Inc(I);
|
|---|
| 1584 |
|
|---|
| 1585 |
|
|---|
| 1586 | with FBottomHypot[I] do
|
|---|
| 1587 | r := (Dist - fx) * RecDist;
|
|---|
| 1588 |
|
|---|
| 1589 | dx := (FBottomCurve[I - 1].X - FBottomCurve[I].X);
|
|---|
| 1590 | dy := (FBottomCurve[I - 1].Y - FBottomCurve[I].Y);
|
|---|
| 1591 | Bx := FBottomCurve[I].X + r * dx;
|
|---|
| 1592 | By := FBottomCurve[I].Y + r * dy;
|
|---|
| 1593 |
|
|---|
| 1594 | DstX := Tx + Y * (Bx - Tx);
|
|---|
| 1595 | DstY := Ty + Y * (By - Ty);
|
|---|
| 1596 | end;
|
|---|
| 1597 |
|
|---|
| 1598 |
|
|---|
| 1599 | { TDisturbanceTransformation }
|
|---|
| 1600 |
|
|---|
| 1601 | function TDisturbanceTransformation.GetTransformedBounds(
|
|---|
| 1602 | const ASrcRect: TFloatRect): TFloatRect;
|
|---|
| 1603 | begin
|
|---|
| 1604 | Result := ASrcRect;
|
|---|
| 1605 | InflateRect(Result, 0.5 * FDisturbance, 0.5 * FDisturbance);
|
|---|
| 1606 | end;
|
|---|
| 1607 |
|
|---|
| 1608 | procedure TDisturbanceTransformation.ReverseTransformFloat(DstX,
|
|---|
| 1609 | DstY: TFloat; out SrcX, SrcY: TFloat);
|
|---|
| 1610 | begin
|
|---|
| 1611 | SrcX := DstX + (Random - 0.5) * FDisturbance;
|
|---|
| 1612 | SrcY := DstY + (Random - 0.5) * FDisturbance;
|
|---|
| 1613 | end;
|
|---|
| 1614 |
|
|---|
| 1615 | procedure TDisturbanceTransformation.SetDisturbance(const Value: TFloat);
|
|---|
| 1616 | begin
|
|---|
| 1617 | FDisturbance := Value;
|
|---|
| 1618 | Changed;
|
|---|
| 1619 | end;
|
|---|
| 1620 |
|
|---|
| 1621 | { TRemapTransformation }
|
|---|
| 1622 |
|
|---|
| 1623 | constructor TRemapTransformation.Create;
|
|---|
| 1624 | begin
|
|---|
| 1625 | inherited;
|
|---|
| 1626 | FScalingFixed := FixedPoint(1, 1);
|
|---|
| 1627 | FScalingFloat := FloatPoint(1, 1);
|
|---|
| 1628 | FOffset := FloatPoint(0,0);
|
|---|
| 1629 | FVectorMap := TVectorMap.Create;
|
|---|
| 1630 | //Ensuring initial setup to avoid exceptions
|
|---|
| 1631 | FVectorMap.SetSize(1, 1);
|
|---|
| 1632 | end;
|
|---|
| 1633 |
|
|---|
| 1634 | destructor TRemapTransformation.Destroy;
|
|---|
| 1635 | begin
|
|---|
| 1636 | FVectorMap.Free;
|
|---|
| 1637 | inherited;
|
|---|
| 1638 | end;
|
|---|
| 1639 |
|
|---|
| 1640 | function TRemapTransformation.GetTransformedBounds(const ASrcRect: TFloatRect): TFloatRect;
|
|---|
| 1641 | const
|
|---|
| 1642 | InfRect: TFloatRect = (Left: -Infinity; Top: -Infinity; Right: Infinity; Bottom: Infinity);
|
|---|
| 1643 | begin
|
|---|
| 1644 | // We can't predict the ultimate bounds without transforming each vector in
|
|---|
| 1645 | // the vector map, return the absolute biggest possible transformation bounds
|
|---|
| 1646 | Result := InfRect;
|
|---|
| 1647 | end;
|
|---|
| 1648 |
|
|---|
| 1649 | function TRemapTransformation.HasTransformedBounds: Boolean;
|
|---|
| 1650 | begin
|
|---|
| 1651 | Result := False;
|
|---|
| 1652 | end;
|
|---|
| 1653 |
|
|---|
| 1654 | procedure TRemapTransformation.PrepareTransform;
|
|---|
| 1655 | begin
|
|---|
| 1656 | if IsRectEmpty(SrcRect) then raise Exception.Create(RCStrSrcRectIsEmpty);
|
|---|
| 1657 | if IsRectEmpty(FMappingRect) then raise Exception.Create(RCStrMappingRectIsEmpty);
|
|---|
| 1658 | with SrcRect do
|
|---|
| 1659 | begin
|
|---|
| 1660 | FSrcTranslationFloat.X := Left;
|
|---|
| 1661 | FSrcTranslationFloat.Y := Top;
|
|---|
| 1662 | FSrcScaleFloat.X := (Right - Left) / (FVectorMap.Width - 1);
|
|---|
| 1663 | FSrcScaleFloat.Y := (Bottom - Top) / (FVectorMap.Height - 1);
|
|---|
| 1664 | FSrcTranslationFixed := FixedPoint(FSrcTranslationFloat);
|
|---|
| 1665 | FSrcScaleFixed := FixedPoint(FSrcScaleFloat);
|
|---|
| 1666 | end;
|
|---|
| 1667 |
|
|---|
| 1668 | with FMappingRect do
|
|---|
| 1669 | begin
|
|---|
| 1670 | FDstTranslationFloat.X := Left;
|
|---|
| 1671 | FDstTranslationFloat.Y := Top;
|
|---|
| 1672 | FDstScaleFloat.X := (FVectorMap.Width - 1) / (Right - Left);
|
|---|
| 1673 | FDstScaleFloat.Y := (FVectorMap.Height - 1) / (Bottom - Top);
|
|---|
| 1674 | FCombinedScalingFloat.X := FDstScaleFloat.X * FScalingFloat.X;
|
|---|
| 1675 | FCombinedScalingFloat.Y := FDstScaleFloat.Y * FScalingFloat.Y;
|
|---|
| 1676 | FCombinedScalingFixed := FixedPoint(FCombinedScalingFloat);
|
|---|
| 1677 | FDstTranslationFixed := FixedPoint(FDstTranslationFloat);
|
|---|
| 1678 | FDstScaleFixed := FixedPoint(FDstScaleFloat);
|
|---|
| 1679 | end;
|
|---|
| 1680 | TransformValid := True;
|
|---|
| 1681 | end;
|
|---|
| 1682 |
|
|---|
| 1683 | procedure TRemapTransformation.ReverseTransformFixed(DstX, DstY: TFixed;
|
|---|
| 1684 | out SrcX, SrcY: TFixed);
|
|---|
| 1685 | begin
|
|---|
| 1686 | with FVectorMap.FixedVectorX[DstX - FOffsetFixed.X, DstY - FOffsetFixed.Y] do
|
|---|
| 1687 | begin
|
|---|
| 1688 | DstX := DstX - FDstTranslationFixed.X;
|
|---|
| 1689 | DstX := FixedMul(DstX , FDstScaleFixed.X);
|
|---|
| 1690 | DstX := DstX + FixedMul(X, FCombinedScalingFixed.X);
|
|---|
| 1691 | DstX := FixedMul(DstX, FSrcScaleFixed.X);
|
|---|
| 1692 | SrcX := DstX + FSrcTranslationFixed.X;
|
|---|
| 1693 |
|
|---|
| 1694 | DstY := DstY - FDstTranslationFixed.Y;
|
|---|
| 1695 | DstY := FixedMul(DstY, FDstScaleFixed.Y);
|
|---|
| 1696 | DstY := DstY + FixedMul(Y, FCombinedScalingFixed.Y);
|
|---|
| 1697 | DstY := FixedMul(DstY, FSrcScaleFixed.Y);
|
|---|
| 1698 | SrcY := DstY + FSrcTranslationFixed.Y;
|
|---|
| 1699 | end;
|
|---|
| 1700 | end;
|
|---|
| 1701 |
|
|---|
| 1702 | procedure TRemapTransformation.ReverseTransformFloat(DstX, DstY: TFloat;
|
|---|
| 1703 | out SrcX, SrcY: TFloat);
|
|---|
| 1704 | begin
|
|---|
| 1705 | with FVectorMap.FloatVectorF[DstX - FOffset.X, DstY - FOffset.Y] do
|
|---|
| 1706 | begin
|
|---|
| 1707 | DstX := DstX - FDstTranslationFloat.X;
|
|---|
| 1708 | DstY := DstY - FDstTranslationFloat.Y;
|
|---|
| 1709 | DstX := DstX * FDstScaleFloat.X;
|
|---|
| 1710 | DstY := DstY * FDstScaleFloat.Y;
|
|---|
| 1711 |
|
|---|
| 1712 | DstX := DstX + X * FCombinedScalingFloat.X;
|
|---|
| 1713 | DstY := DstY + Y * FCombinedScalingFloat.Y;
|
|---|
| 1714 |
|
|---|
| 1715 | DstX := DstX * FSrcScaleFloat.X;
|
|---|
| 1716 | DstY := DstY * FSrcScaleFloat.Y;
|
|---|
| 1717 | SrcX := DstX + FSrcTranslationFloat.X;
|
|---|
| 1718 | SrcY := DstY + FSrcTranslationFloat.Y;
|
|---|
| 1719 | end;
|
|---|
| 1720 | end;
|
|---|
| 1721 |
|
|---|
| 1722 | procedure TRemapTransformation.ReverseTransformInt(DstX, DstY: Integer;
|
|---|
| 1723 | out SrcX, SrcY: Integer);
|
|---|
| 1724 | begin
|
|---|
| 1725 | with FVectorMap.FixedVector[DstX - FOffsetInt.X, DstY - FOffsetInt.Y] do
|
|---|
| 1726 | begin
|
|---|
| 1727 | DstX := DstX * FixedOne - FDstTranslationFixed.X;
|
|---|
| 1728 | DstY := DstY * FixedOne - FDstTranslationFixed.Y;
|
|---|
| 1729 | DstX := FixedMul(DstX, FDstScaleFixed.X);
|
|---|
| 1730 | DstY := FixedMul(DstY, FDstScaleFixed.Y);
|
|---|
| 1731 |
|
|---|
| 1732 | DstX := DstX + FixedMul(X, FCombinedScalingFixed.X);
|
|---|
| 1733 | DstY := DstY + FixedMul(Y, FCombinedScalingFixed.Y);
|
|---|
| 1734 |
|
|---|
| 1735 | DstX := FixedMul(DstX, FSrcScaleFixed.X);
|
|---|
| 1736 | DstY := FixedMul(DstY, FSrcScaleFixed.Y);
|
|---|
| 1737 | SrcX := FixedRound(DstX + FSrcTranslationFixed.X);
|
|---|
| 1738 | SrcY := FixedRound(DstY + FSrcTranslationFixed.Y);
|
|---|
| 1739 | end;
|
|---|
| 1740 | end;
|
|---|
| 1741 |
|
|---|
| 1742 | procedure TRemapTransformation.Scale(Sx, Sy: TFloat);
|
|---|
| 1743 | begin
|
|---|
| 1744 | FScalingFixed.X := Fixed(Sx);
|
|---|
| 1745 | FScalingFixed.Y := Fixed(Sy);
|
|---|
| 1746 | FScalingFloat.X := Sx;
|
|---|
| 1747 | FScalingFloat.Y := Sy;
|
|---|
| 1748 | Changed;
|
|---|
| 1749 | end;
|
|---|
| 1750 |
|
|---|
| 1751 | procedure TRemapTransformation.SetMappingRect(Rect: TFloatRect);
|
|---|
| 1752 | begin
|
|---|
| 1753 | FMappingRect := Rect;
|
|---|
| 1754 | Changed;
|
|---|
| 1755 | end;
|
|---|
| 1756 |
|
|---|
| 1757 | procedure TRemapTransformation.SetOffset(const Value: TFloatVector);
|
|---|
| 1758 | begin
|
|---|
| 1759 | FOffset := Value;
|
|---|
| 1760 | FOffsetInt := Point(Value);
|
|---|
| 1761 | FOffsetFixed := FixedPoint(Value);
|
|---|
| 1762 | Changed;
|
|---|
| 1763 | end;
|
|---|
| 1764 |
|
|---|
| 1765 | procedure RasterizeTransformation(Vectormap: TVectormap;
|
|---|
| 1766 | Transformation: TTransformation; DstRect: TRect;
|
|---|
| 1767 | CombineMode: TVectorCombineMode = vcmAdd;
|
|---|
| 1768 | CombineCallback: TVectorCombineEvent = nil);
|
|---|
| 1769 | var
|
|---|
| 1770 | I, J: Integer;
|
|---|
| 1771 | P, Q, Progression: TFixedVector;
|
|---|
| 1772 | ProgressionX, ProgressionY: TFixed;
|
|---|
| 1773 | MapPtr: PFixedPointArray;
|
|---|
| 1774 | begin
|
|---|
| 1775 | GR32.IntersectRect(DstRect, VectorMap.BoundsRect, DstRect);
|
|---|
| 1776 | if GR32.IsRectEmpty(DstRect) then Exit;
|
|---|
| 1777 |
|
|---|
| 1778 | if not TTransformationAccess(Transformation).TransformValid then
|
|---|
| 1779 | TTransformationAccess(Transformation).PrepareTransform;
|
|---|
| 1780 |
|
|---|
| 1781 | case CombineMode of
|
|---|
| 1782 | vcmAdd:
|
|---|
| 1783 | begin
|
|---|
| 1784 | with DstRect do
|
|---|
| 1785 | for I := Top to Bottom - 1 do
|
|---|
| 1786 | begin
|
|---|
| 1787 | MapPtr := @VectorMap.Vectors[I * VectorMap.Width];
|
|---|
| 1788 | for J := Left to Right - 1 do
|
|---|
| 1789 | begin
|
|---|
| 1790 | P := FixedPoint(Integer(J - Left), Integer(I - Top));
|
|---|
| 1791 | Q := Transformation.ReverseTransform(P);
|
|---|
| 1792 | Inc(MapPtr[J].X, Q.X - P.X);
|
|---|
| 1793 | Inc(MapPtr[J].Y, Q.Y - P.Y);
|
|---|
| 1794 | end;
|
|---|
| 1795 | end;
|
|---|
| 1796 | end;
|
|---|
| 1797 | vcmReplace:
|
|---|
| 1798 | begin
|
|---|
| 1799 | with DstRect do
|
|---|
| 1800 | for I := Top to Bottom - 1 do
|
|---|
| 1801 | begin
|
|---|
| 1802 | MapPtr := @VectorMap.Vectors[I * VectorMap.Width];
|
|---|
| 1803 | for J := Left to Right - 1 do
|
|---|
| 1804 | begin
|
|---|
| 1805 | P := FixedPoint(Integer(J - Left), Integer(I - Top));
|
|---|
| 1806 | Q := Transformation.ReverseTransform(P);
|
|---|
| 1807 | MapPtr[J].X := Q.X - P.X;
|
|---|
| 1808 | MapPtr[J].Y := Q.Y - P.Y;
|
|---|
| 1809 | end;
|
|---|
| 1810 | end;
|
|---|
| 1811 | end;
|
|---|
| 1812 | else // vcmCustom
|
|---|
| 1813 | ProgressionX := Fixed(1 / (DstRect.Right - DstRect.Left - 1));
|
|---|
| 1814 | ProgressionY := Fixed(1 / (DstRect.Bottom - DstRect.Top - 1));
|
|---|
| 1815 | Progression.Y := 0;
|
|---|
| 1816 | with DstRect do for I := Top to Bottom - 1 do
|
|---|
| 1817 | begin
|
|---|
| 1818 | Progression.X := 0;
|
|---|
| 1819 | MapPtr := @VectorMap.Vectors[I * VectorMap.Width];
|
|---|
| 1820 | for J := Left to Right - 1 do
|
|---|
| 1821 | begin
|
|---|
| 1822 | P := FixedPoint(Integer(J - Left), Integer(I - Top));
|
|---|
| 1823 | Q := Transformation.ReverseTransform(P);
|
|---|
| 1824 | Q.X := Q.X - P.X;
|
|---|
| 1825 | Q.Y := Q.Y - P.Y;
|
|---|
| 1826 | CombineCallback(Q, Progression, MapPtr[J]);
|
|---|
| 1827 |
|
|---|
| 1828 | Inc(Progression.X, ProgressionX);
|
|---|
| 1829 | end;
|
|---|
| 1830 | Inc(Progression.Y, ProgressionY);
|
|---|
| 1831 | end;
|
|---|
| 1832 | end;
|
|---|
| 1833 | end;
|
|---|
| 1834 |
|
|---|
| 1835 | { Matrix conversion routines }
|
|---|
| 1836 |
|
|---|
| 1837 | function FixedMatrix(const FloatMatrix: TFloatMatrix): TFixedMatrix;
|
|---|
| 1838 | begin
|
|---|
| 1839 | Result[0,0] := Round(FloatMatrix[0,0] * FixedOne);
|
|---|
| 1840 | Result[0,1] := Round(FloatMatrix[0,1] * FixedOne);
|
|---|
| 1841 | Result[0,2] := Round(FloatMatrix[0,2] * FixedOne);
|
|---|
| 1842 | Result[1,0] := Round(FloatMatrix[1,0] * FixedOne);
|
|---|
| 1843 | Result[1,1] := Round(FloatMatrix[1,1] * FixedOne);
|
|---|
| 1844 | Result[1,2] := Round(FloatMatrix[1,2] * FixedOne);
|
|---|
| 1845 | Result[2,0] := Round(FloatMatrix[2,0] * FixedOne);
|
|---|
| 1846 | Result[2,1] := Round(FloatMatrix[2,1] * FixedOne);
|
|---|
| 1847 | Result[2,2] := Round(FloatMatrix[2,2] * FixedOne);
|
|---|
| 1848 | end;
|
|---|
| 1849 |
|
|---|
| 1850 | function FloatMatrix(const FixedMatrix: TFixedMatrix): TFloatMatrix;
|
|---|
| 1851 | begin
|
|---|
| 1852 | Result[0,0] := FixedMatrix[0,0] * FixedToFloat;
|
|---|
| 1853 | Result[0,1] := FixedMatrix[0,1] * FixedToFloat;
|
|---|
| 1854 | Result[0,2] := FixedMatrix[0,2] * FixedToFloat;
|
|---|
| 1855 | Result[1,0] := FixedMatrix[1,0] * FixedToFloat;
|
|---|
| 1856 | Result[1,1] := FixedMatrix[1,1] * FixedToFloat;
|
|---|
| 1857 | Result[1,2] := FixedMatrix[1,2] * FixedToFloat;
|
|---|
| 1858 | Result[2,0] := FixedMatrix[2,0] * FixedToFloat;
|
|---|
| 1859 | Result[2,1] := FixedMatrix[2,1] * FixedToFloat;
|
|---|
| 1860 | Result[2,2] := FixedMatrix[2,2] * FixedToFloat;
|
|---|
| 1861 | end;
|
|---|
| 1862 |
|
|---|
| 1863 | {CPU target and feature Function templates}
|
|---|
| 1864 |
|
|---|
| 1865 | const
|
|---|
| 1866 | FID_DETERMINANT32 = 0;
|
|---|
| 1867 | FID_DETERMINANT64 = 1;
|
|---|
| 1868 |
|
|---|
| 1869 | {Complete collection of unit templates}
|
|---|
| 1870 |
|
|---|
| 1871 | var
|
|---|
| 1872 | Registry: TFunctionRegistry;
|
|---|
| 1873 |
|
|---|
| 1874 | procedure RegisterBindings;
|
|---|
| 1875 | begin
|
|---|
| 1876 | Registry := NewRegistry('GR32_Transforms bindings');
|
|---|
| 1877 | Registry.RegisterBinding(FID_DETERMINANT32, @@DET32);
|
|---|
| 1878 |
|
|---|
| 1879 | Registry.Add(FID_DETERMINANT32, @DET32_Pas, []);
|
|---|
| 1880 | {$IFNDEF PUREPASCAL}
|
|---|
| 1881 | Registry.Add(FID_DETERMINANT32, @DET32_ASM, []);
|
|---|
| 1882 | // Registry.Add(FID_DETERMINANT32, @DET32_SSE2, [ciSSE2]);
|
|---|
| 1883 | {$ENDIF}
|
|---|
| 1884 |
|
|---|
| 1885 | Registry.RegisterBinding(FID_DETERMINANT64, @@DET64);
|
|---|
| 1886 |
|
|---|
| 1887 | Registry.Add(FID_DETERMINANT64, @DET64_Pas, []);
|
|---|
| 1888 | {$IFNDEF PUREPASCAL}
|
|---|
| 1889 | Registry.Add(FID_DETERMINANT64, @DET64_ASM, []);
|
|---|
| 1890 | // Registry.Add(FID_DETERMINANT64, @DET64_SSE2, [ciSSE2]);
|
|---|
| 1891 | {$ENDIF}
|
|---|
| 1892 |
|
|---|
| 1893 | Registry.RebindAll;
|
|---|
| 1894 | end;
|
|---|
| 1895 |
|
|---|
| 1896 | initialization
|
|---|
| 1897 | RegisterBindings;
|
|---|
| 1898 |
|
|---|
| 1899 | end.
|
|---|
![(please configure the [header_logo] section in trac.ini)](/GraphicTest/chrome/site/your_project_logo.png){kind=logo}
