← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to components/aggpas/src/agg_trans_affine.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
components/aggpas/src/agg_trans_affine.pas
1
 
//----------------------------------------------------------------------------
2
 
// Anti-Grain Geometry - Version 2.4 (Public License)
3
 
// Copyright (C) 2002-2005 Maxim Shemanarev (http://www.antigrain.com)
4
 
//
5
 
// Anti-Grain Geometry - Version 2.4 Release Milano 3 (AggPas 2.4 RM3)
6
 
// Pascal Port By: Milan Marusinec alias Milano
7
 
//                 milan@marusinec.sk
8
 
//                 http://www.aggpas.org
9
 
// Copyright (c) 2005-2006
10
 
//
11
 
// Permission to copy, use, modify, sell and distribute this software
12
 
// is granted provided this copyright notice appears in all copies.
13
 
// This software is provided "as is" without express or implied
14
 
// warranty, and with no claim as to its suitability for any purpose.
15
 
//
16
 
//----------------------------------------------------------------------------
17
 
// Contact: mcseem@antigrain.com
18
 
//          mcseemagg@yahoo.com
19
 
//          http://www.antigrain.com
20
 
//
21
 
//----------------------------------------------------------------------------
22
 
//
23
 
// Affine transformation classes.
24
 
//
25
 
// [Pascal Port History] -----------------------------------------------------
26
 
//
27
 
// 26.10.2007-Milano: Reflection Transformations
28
 
// 27.09.2005-Milano: Complete unit port
29
 
//
30
 
//----------------------------------------------------------------------------
31
 
//
32
 
// Affine transformation are linear transformations in Cartesian coordinates
33
 
// (strictly speaking not only in Cartesian, but for the beginning we will
34
 
// think so). They are rotation, scaling, translation and skewing.
35
 
// After any affine transformation a line segment remains a line segment
36
 
// and it will never become a curve.
37
 
//
38
 
// There will be no math about matrix calculations, since it has been
39
 
// described many times. Ask yourself a very simple question:
40
 
// "why do we need to understand and use some matrix stuff instead of just
41
 
// rotating, scaling and so on". The answers are:
42
 
//
43
 
// 1. Any combination of transformations can be done by only 4 multiplications
44
 
//    and 4 additions in floating point.
45
 
// 2. One matrix transformation is equivalent to the number of consecutive
46
 
//    discrete transformations, i.e. the matrix "accumulates" all transformations
47
 
//    in the order of their settings. Suppose we have 4 transformations:
48
 
//       * rotate by 30 degrees,
49
 
//       * scale X to 2.0,
50
 
//       * scale Y to 1.5,
51
 
//       * move to (100, 100).
52
 
//    The result will depend on the order of these transformations,
53
 
//    and the advantage of matrix is that the sequence of discret calls:
54
 
//    rotate(30), scaleX(2.0), scaleY(1.5), move(100,100)
55
 
//    will have exactly the same result as the following matrix transformations:
56
 
//
57
 
//    affine_matrix m;
58
 
//    m *= rotate_matrix(30);
59
 
//    m *= scaleX_matrix(2.0);
60
 
//    m *= scaleY_matrix(1.5);
61
 
//    m *= move_matrix(100,100);
62
 
//
63
 
//    m.transform_my_point_at_last(x, y);
64
 
//
65
 
// What is the good of it? In real life we will set-up the matrix only once
66
 
// and then transform many points, let alone the convenience to set any
67
 
// combination of transformations.
68
 
//
69
 
// So, how to use it? Very easy - literally as it's shown above. Not quite,
70
 
// let us write a correct example:
71
 
//
72
 
// agg::trans_affine m;
73
 
// m *= agg::trans_affine_rotation(30.0 * 3.1415926 / 180.0);
74
 
// m *= agg::trans_affine_scaling(2.0, 1.5);
75
 
// m *= agg::trans_affine_translation(100.0, 100.0);
76
 
// m.transform(&x, &y);
77
 
//
78
 
// The affine matrix is all you need to perform any linear transformation,
79
 
// but all transformations have origin point (0,0). It means that we need to
80
 
// use 2 translations if we want to rotate someting around (100,100):
81
 
//
82
 
// m *= agg::trans_affine_translation(-100.0, -100.0);         // move to (0,0)
83
 
// m *= agg::trans_affine_rotation(30.0 * 3.1415926 / 180.0);  // rotate
84
 
// m *= agg::trans_affine_translation(100.0, 100.0);           // move back to (100,100)
85
 
//
86
 
{ agg_trans_affine.pas }
87
 
unit
88
 
 agg_trans_affine ;
89
 
 
90
 
INTERFACE
91
 
 
92
 
{$I agg_mode.inc }
93
 
 
94
 
uses
95
 
 Math ,
96
 
 agg_basics ;
97
 
 
98
 
{ TYPES DEFINITION }
99
 
const
100
 
 affine_epsilon = 1e-14; // About of precision of doubles
101
 
 
102
 
type
103
 
 trans_affine_ptr = ^trans_affine;
104
 
 
105
 
 proc_transform = procedure(this : trans_affine_ptr; x ,y : double_ptr );
106
 
 
107
 
 parallelo_ptr = ^parallelogram;
108
 
 parallelogram = array[0..5 ] of double;
109
 
 
110
 
 trans_affine = object
111
 
 { sx ,shy ,shx ,sy ,tx ,ty }
112
 
   m0 ,m1  ,m2  ,m3 ,m4 ,m5 : double;
113
 
 
114
 
   transform         ,
115
 
   transform_2x2     ,
116
 
   inverse_transform : proc_transform;
117
 
 
118
 
  // Construct an identity matrix - it does not transform anything
119
 
   constructor Construct; overload;
120
 
 
121
 
  // Construct a custom matrix. Usually used in derived classes
122
 
   constructor Construct(v0 ,v1 ,v2 ,v3 ,v4 ,v5 : double ); overload;
123
 
 
124
 
  // Construct a matrix to transform a parallelogram to another one
125
 
   constructor Construct(rect, parl : parallelo_ptr ); overload;
126
 
 
127
 
  // Construct a matrix to transform a rectangle to a parallelogram
128
 
   constructor Construct(x1 ,y1 ,x2 ,y2 : double; parl : parallelo_ptr ); overload;
129
 
 
130
 
  // Construct a matrix to transform a parallelogram to a rectangle
131
 
   constructor Construct(parl : parallelo_ptr; x1 ,y1 ,x2 ,y2 : double ); overload;
132
 
 
133
 
  // Construct a matrix with different transform function
134
 
   constructor Construct(tr : proc_transform ); overload;
135
 
 
136
 
  //---------------------------------- Parallelogram transformations
137
 
  // Calculate a matrix to transform a parallelogram to another one.
138
 
  // src and dst are pointers to arrays of three points
139
 
  // (double[6], x,y,...) that identify three corners of the
140
 
  // parallelograms assuming implicit fourth points.
141
 
  // There are also transformations rectangtle to parallelogram and
142
 
  // parellelogram to rectangle
143
 
   procedure parl_to_parl(src ,dst : parallelo_ptr );
144
 
   procedure rect_to_parl(x1 ,y1 ,x2 ,y2 : double; parl : parallelo_ptr );
145
 
   procedure parl_to_rect(parl : parallelo_ptr; x1 ,y1 ,x2 ,y2 : double );
146
 
 
147
 
  //------------------------------------------ Operations
148
 
  // Reset - actually load an identity matrix
149
 
   procedure reset; virtual;
150
 
 
151
 
  // Multiply matrix to another one
152
 
   procedure multiply(m : trans_affine_ptr );
153
 
 
154
 
  // Multiply "m" to "this" and assign the result to "this"
155
 
   procedure premultiply(m : trans_affine_ptr );
156
 
 
157
 
  // Multiply matrix to inverse of another one
158
 
   procedure multiply_inv(m : trans_affine_ptr );
159
 
 
160
 
  // Multiply inverse of "m" to "this" and assign the result to "this"
161
 
   procedure premultiply_inv(m : trans_affine_ptr );
162
 
 
163
 
  // Invert matrix. Do not try to invert degenerate matrices,
164
 
  // there's no check for validity. If you set scale to 0 and
165
 
  // then try to invert matrix, expect unpredictable result.
166
 
   procedure invert;
167
 
 
168
 
  // Mirroring around X
169
 
   procedure flip_x;
170
 
 
171
 
  // Mirroring around Y
172
 
   procedure flip_y;
173
 
 
174
 
  //------------------------------------------- Load/Store
175
 
  // Store matrix to an array [6] of double
176
 
   procedure store_to(m : parallelo_ptr );
177
 
 
178
 
  // Load matrix from an array [6] of double
179
 
   procedure load_from(m : parallelo_ptr );
180
 
 
181
 
  //-------------------------------------------- Transformations
182
 
  // Direct transformation x and y
183
 
  // see: transform : proc_transform; above
184
 
 
185
 
  // Direct transformation x and y, 2x2 matrix only, no translation
186
 
  // procedure transform_2x2(x ,y : double_ptr );
187
 
 
188
 
  // Inverse transformation x and y. It works slower than the
189
 
  // direct transformation, so if the performance is critical
190
 
  // it's better to invert() the matrix and then use transform()
191
 
  // procedure inverse_transform(x ,y : double_ptr );
192
 
 
193
 
  //-------------------------------------------- Auxiliary
194
 
  // Calculate the determinant of matrix
195
 
   function  determinant : double;
196
 
 
197
 
  // Get the average scale (by X and Y).
198
 
  // Basically used to calculate the approximation_scale when
199
 
  // decomposinting curves into line segments.
200
 
   function  scale : double; overload;
201
 
 
202
 
  // Check to see if it's an identity matrix
203
 
   function  is_identity(epsilon : double = affine_epsilon ) : boolean;
204
 
 
205
 
  // Check to see if two matrices are equal
206
 
   function  is_equal(m : trans_affine; epsilon : double = affine_epsilon ) : boolean;
207
 
 
208
 
  // Determine the major parameters. Use carefully considering degenerate matrices
209
 
   function  rotation : double;
210
 
   procedure translation(dx ,dy : double_ptr );
211
 
   procedure scaling    (sx ,sy : double_ptr );
212
 
   procedure scaling_abs(sx ,sy : double_ptr );
213
 
 
214
 
  // Trans Affine Assignations
215
 
   procedure assign    (from : trans_affine_ptr );
216
 
   procedure assign_all(from : trans_affine_ptr );
217
 
 
218
 
  // Direct transformations operations
219
 
   function  translate(x ,y : double ) : trans_affine_ptr;
220
 
   function  rotate   (a : double ) : trans_affine_ptr;
221
 
   function  scale    (s : double ) : trans_affine_ptr; overload;
222
 
   function  scale    (x ,y : double ) : trans_affine_ptr; overload;
223
 
 
224
 
  end;
225
 
 
226
 
//====================================================trans_affine_rotation
227
 
// Rotation matrix. sin() and cos() are calculated twice for the same angle.
228
 
// There's no harm because the performance of sin()/cos() is very good on all
229
 
// modern processors. Besides, this operation is not going to be invoked too
230
 
// often.
231
 
 trans_affine_rotation = object(trans_affine )
232
 
   constructor Construct(a : double );
233
 
 
234
 
  end;
235
 
 
236
 
//====================================================trans_affine_scaling
237
 
// Scaling matrix. sx, sy - scale coefficients by X and Y respectively
238
 
 trans_affine_scaling = object(trans_affine )
239
 
   constructor Construct(sx ,sy : double ); overload;
240
 
   constructor Construct(s : double ); overload;
241
 
 
242
 
  end;
243
 
 
244
 
//================================================trans_affine_translation
245
 
// Translation matrix
246
 
 trans_affine_translation = object(trans_affine )
247
 
   constructor Construct(tx ,ty : double );
248
 
 
249
 
  end;
250
 
 
251
 
//====================================================trans_affine_skewing
252
 
// Sckewing (shear) matrix
253
 
 trans_affine_skewing = object(trans_affine )
254
 
   constructor Construct(sx ,sy : double );
255
 
 
256
 
  end;
257
 
 
258
 
//===============================================trans_affine_line_segment
259
 
// Rotate, Scale and Translate, associating 0...dist with line segment
260
 
// x1,y1,x2,y2
261
 
 trans_affine_line_segment = object(trans_affine )
262
 
   constructor Construct(x1 ,y1 ,x2 ,y2 ,dist : double );
263
 
 
264
 
  end;
265
 
 
266
 
//============================================trans_affine_reflection_unit
267
 
// Reflection matrix. Reflect coordinates across the line through
268
 
// the origin containing the unit vector (ux, uy).
269
 
// Contributed by John Horigan
270
 
 trans_affine_reflection_unit = object(trans_affine )
271
 
   constructor Construct(ux ,uy : double );
272
 
 
273
 
  end;
274
 
 
275
 
//=================================================trans_affine_reflection
276
 
// Reflection matrix. Reflect coordinates across the line through
277
 
// the origin at the angle a or containing the non-unit vector (x, y).
278
 
// Contributed by John Horigan
279
 
 trans_affine_reflection = object(trans_affine_reflection_unit )
280
 
   constructor Construct(a : double ); overload;
281
 
   constructor Construct(x ,y : double ); overload;
282
 
 
283
 
  end;
284
 
 
285
 
{ GLOBAL PROCEDURES }
286
 
 function  is_equal_eps(v1 ,v2 ,epsilon : double ) : boolean;
287
 
 
288
 
 
289
 
IMPLEMENTATION
290
 
{ UNIT IMPLEMENTATION }
291
 
{ is_equal_eps }
292
 
function is_equal_eps;
293
 
begin
294
 
 result:=Abs(v1 - v2 ) < epsilon;
295
 
 
296
 
end;
297
 
 
298
 
{ trans_affine_transform }
299
 
procedure trans_affine_transform(this : trans_affine_ptr; x ,y : double_ptr );
300
 
var
301
 
 tx : double;
302
 
 
303
 
begin
304
 
 tx:=x^;
305
 
 x^:=tx * this.m0 + y^ * this.m2 + this.m4;
306
 
 y^:=tx * this.m1 + y^ * this.m3 + this.m5;
307
 
 
308
 
end;
309
 
 
310
 
{ trans_affine_transform_2x2 }
311
 
procedure trans_affine_transform_2x2(this : trans_affine_ptr; x ,y : double_ptr );
312
 
var
313
 
 tx : double;
314
 
 
315
 
begin
316
 
 tx:=x^;
317
 
 x^:=tx * this.m0 + y^ * this.m2;
318
 
 y^:=tx * this.m1 + y^ * this.m3;
319
 
 
320
 
end;
321
 
 
322
 
{ trans_affine_inverse_transform }
323
 
procedure trans_affine_inverse_transform(this : trans_affine_ptr; x ,y : double_ptr );
324
 
var
325
 
 d ,a ,b : double;
326
 
 
327
 
begin
328
 
 d:=this.determinant;
329
 
 a:=(x^ - this.m4 ) * d;
330
 
 b:=(y^ - this.m5 ) * d;
331
 
 
332
 
 x^:=a * this.m3 - b * this.m2;
333
 
 y^:=b * this.m0 - a * this.m1;
334
 
 
335
 
end;
336
 
 
337
 
{ CONSTRUCT }
338
 
constructor trans_affine.Construct;
339
 
begin
340
 
 m0:=1;
341
 
 m1:=0;
342
 
 m2:=0;
343
 
 m3:=1;
344
 
 m4:=0;
345
 
 m5:=0;
346
 
 
347
 
 transform        :=@trans_affine_transform;
348
 
 transform_2x2    :=@trans_affine_transform_2x2;
349
 
 inverse_transform:=@trans_affine_inverse_transform;
350
 
 
351
 
end;
352
 
 
353
 
{ CONSTRUCT }
354
 
constructor trans_affine.Construct(v0 ,v1 ,v2 ,v3 ,v4 ,v5 : double );
355
 
begin
356
 
 m0:=v0;
357
 
 m1:=v1;
358
 
 m2:=v2;
359
 
 m3:=v3;
360
 
 m4:=v4;
361
 
 m5:=v5;
362
 
 
363
 
 transform        :=@trans_affine_transform;
364
 
 transform_2x2    :=@trans_affine_transform_2x2;
365
 
 inverse_transform:=@trans_affine_inverse_transform;
366
 
 
367
 
end;
368
 
 
369
 
{ CONSTRUCT }
370
 
constructor trans_affine.Construct(rect, parl : parallelo_ptr );
371
 
begin
372
 
 parl_to_parl(rect ,parl );
373
 
 
374
 
 transform        :=@trans_affine_transform;
375
 
 transform_2x2    :=@trans_affine_transform_2x2;
376
 
 inverse_transform:=@trans_affine_inverse_transform;
377
 
 
378
 
end;
379
 
 
380
 
{ CONSTRUCT }
381
 
constructor trans_affine.Construct(x1 ,y1 ,x2 ,y2 : double; parl : parallelo_ptr );
382
 
begin
383
 
 rect_to_parl(x1 ,y1 ,x2 ,y2 ,parl );
384
 
 
385
 
 transform        :=@trans_affine_transform;
386
 
 transform_2x2    :=@trans_affine_transform_2x2;
387
 
 inverse_transform:=@trans_affine_inverse_transform;
388
 
 
389
 
end;
390
 
 
391
 
{ CONSTRUCT }
392
 
constructor trans_affine.Construct(parl : parallelo_ptr; x1 ,y1 ,x2 ,y2 : double );
393
 
begin
394
 
 parl_to_rect(parl ,x1 ,y1 ,x2 ,y2 );
395
 
 
396
 
 transform        :=@trans_affine_transform;
397
 
 transform_2x2    :=@trans_affine_transform_2x2;
398
 
 inverse_transform:=@trans_affine_inverse_transform;
399
 
 
400
 
end;
401
 
 
402
 
{ CONSTRUCT }
403
 
constructor trans_affine.Construct(tr : proc_transform );
404
 
begin
405
 
 m0:=1;
406
 
 m1:=0;
407
 
 m2:=0;
408
 
 m3:=1;
409
 
 m4:=0;
410
 
 m5:=0;
411
 
 
412
 
 transform        :=tr;
413
 
 transform_2x2    :=@trans_affine_transform_2x2;
414
 
 inverse_transform:=@trans_affine_inverse_transform;
415
 
 
416
 
end;
417
 
 
418
 
{ parl_to_parl }
419
 
procedure trans_affine.parl_to_parl;
420
 
var
421
 
 m : trans_affine;
422
 
 
423
 
begin
424
 
 m0:=src[2 ] - src[0 ];
425
 
 m1:=src[3 ] - src[1 ];
426
 
 m2:=src[4 ] - src[0 ];
427
 
 m3:=src[5 ] - src[1 ];
428
 
 m4:=src[0 ];
429
 
 m5:=src[1 ];
430
 
 
431
 
 invert;
432
 
 
433
 
 m.Construct(
434
 
  dst[2 ] - dst[0 ] ,
435
 
  dst[3 ] - dst[1 ] ,
436
 
  dst[4 ] - dst[0 ] ,
437
 
  dst[5 ] - dst[1 ] ,
438
 
  dst[0 ] ,
439
 
  dst[1 ] );
440
 
 
441
 
 multiply(@m );
442
 
 
443
 
end;
444
 
 
445
 
{ rect_to_parl }
446
 
procedure trans_affine.rect_to_parl;
447
 
var
448
 
 src : parallelogram;
449
 
 
450
 
begin
451
 
 src[0 ]:=x1;
452
 
 src[1 ]:=y1;
453
 
 src[2 ]:=x2;
454
 
 src[3 ]:=y1;
455
 
 src[4 ]:=x2;
456
 
 src[5 ]:=y2;
457
 
 
458
 
 parl_to_parl(@src ,parl );
459
 
 
460
 
end;
461
 
 
462
 
{ parl_to_rect }
463
 
procedure trans_affine.parl_to_rect;
464
 
var
465
 
 dst : parallelogram;
466
 
 
467
 
begin
468
 
 dst[0 ]:=x1;
469
 
 dst[1 ]:=y1;
470
 
 dst[2 ]:=x2;
471
 
 dst[3 ]:=y1;
472
 
 dst[4 ]:=x2;
473
 
 dst[5 ]:=y2;
474
 
 
475
 
 parl_to_parl(parl ,@dst );
476
 
 
477
 
end;
478
 
 
479
 
{ reset }
480
 
procedure trans_affine.reset;
481
 
begin
482
 
 m0:=1;
483
 
 m1:=0;
484
 
 m2:=0;
485
 
 m3:=1;
486
 
 m4:=0;
487
 
 m5:=0;
488
 
 
489
 
end;
490
 
 
491
 
{ multiply }
492
 
procedure trans_affine.multiply;
493
 
var
494
 
 t0 ,t2 ,t4 : double;
495
 
 
496
 
begin
497
 
 t0:=m0 * m.m0 + m1 * m.m2;
498
 
 t2:=m2 * m.m0 + m3 * m.m2;
499
 
 t4:=m4 * m.m0 + m5 * m.m2 + m.m4;
500
 
 m1:=m0 * m.m1 + m1 * m.m3;
501
 
 m3:=m2 * m.m1 + m3 * m.m3;
502
 
 m5:=m4 * m.m1 + m5 * m.m3 + m.m5;
503
 
 m0:=t0;
504
 
 m2:=t2;
505
 
 m4:=t4;
506
 
 
507
 
end;
508
 
 
509
 
{ premultiply }
510
 
procedure trans_affine.premultiply;
511
 
var
512
 
 t : trans_affine;
513
 
 
514
 
begin
515
 
 t.assign_all(m );
516
 
 
517
 
 t.multiply(@self );
518
 
 
519
 
 assign(@t );
520
 
 
521
 
end;
522
 
 
523
 
{ multiply_inv }
524
 
procedure trans_affine.multiply_inv;
525
 
var
526
 
 t : trans_affine;
527
 
 
528
 
begin
529
 
 t.assign_all(m );
530
 
 t.invert;
531
 
 
532
 
 multiply(@t );
533
 
 
534
 
end;
535
 
 
536
 
{ premultiply_inv }
537
 
procedure trans_affine.premultiply_inv;
538
 
var
539
 
 t : trans_affine;
540
 
 
541
 
begin
542
 
 t.assign_all(m );
543
 
 
544
 
 t.invert;
545
 
 t.multiply(@self );
546
 
 
547
 
 assign(@t );
548
 
 
549
 
end;
550
 
 
551
 
{ invert }
552
 
procedure trans_affine.invert;
553
 
var
554
 
 d ,t0 ,t4 : double;
555
 
 
556
 
begin
557
 
 d:=determinant;
558
 
 
559
 
 t0:= m3 * d;
560
 
 m3:= m0 * d;
561
 
 m1:=-m1 * d;
562
 
 m2:=-m2 * d;
563
 
 
564
 
 t4:=-m4 * t0 - m5 * m2;
565
 
 m5:=-m4 * m1 - m5 * m3;
566
 
 
567
 
 m0:=t0;
568
 
 m4:=t4;
569
 
 
570
 
end;
571
 
 
572
 
{ flip_x }
573
 
procedure trans_affine.flip_x;
574
 
begin
575
 
 m0:=-m0;
576
 
 m1:=-m1;
577
 
 m4:=-m4;
578
 
 
579
 
end;
580
 
 
581
 
{ flip_y }
582
 
procedure trans_affine.flip_y;
583
 
begin
584
 
 m2:=-m2;
585
 
 m3:=-m3;
586
 
 m5:=-m5;
587
 
 
588
 
end;
589
 
 
590
 
{ store_to }
591
 
procedure trans_affine.store_to;
592
 
begin
593
 
 m[0 ]:=m0;
594
 
 m[1 ]:=m1;
595
 
 m[2 ]:=m2;
596
 
 m[3 ]:=m3;
597
 
 m[4 ]:=m4;
598
 
 m[5 ]:=m5;
599
 
 
600
 
end;
601
 
 
602
 
{ load_from }
603
 
procedure trans_affine.load_from;
604
 
begin
605
 
 m0:=m[0 ];
606
 
 m1:=m[1 ];
607
 
 m2:=m[2 ];
608
 
 m3:=m[3 ];
609
 
 m4:=m[4 ];
610
 
 m5:=m[5 ];
611
 
 
612
 
end;
613
 
 
614
 
{ determinant }
615
 
function trans_affine.determinant;
616
 
begin
617
 
 try
618
 
  result:=1 / (m0 * m3 - m1 * m2 );
619
 
 
620
 
 except
621
 
  result:=0;
622
 
 
623
 
 end;
624
 
 
625
 
end;
626
 
 
627
 
{ scale }
628
 
function trans_affine.scale : double;
629
 
var
630
 
 x ,y : double;
631
 
 
632
 
begin
633
 
 x:=0.707106781 * m0 + 0.707106781 * m2;
634
 
 y:=0.707106781 * m1 + 0.707106781 * m3;
635
 
 
636
 
 result:=Sqrt(x * x + y * y );
637
 
 
638
 
end;
639
 
 
640
 
{ is_identity }
641
 
function trans_affine.is_identity;
642
 
begin
643
 
 result:=
644
 
  is_equal_eps(m0 ,1 ,epsilon ) and
645
 
  is_equal_eps(m1 ,0 ,epsilon ) and
646
 
  is_equal_eps(m2 ,0 ,epsilon ) and
647
 
  is_equal_eps(m3 ,1 ,epsilon ) and
648
 
  is_equal_eps(m4 ,0 ,epsilon ) and
649
 
  is_equal_eps(m5 ,0 ,epsilon );
650
 
 
651
 
end;
652
 
 
653
 
{ is_equal }
654
 
function trans_affine.is_equal;
655
 
begin
656
 
 result:=
657
 
  is_equal_eps(m0 ,m.m0 ,epsilon ) and
658
 
  is_equal_eps(m1 ,m.m1 ,epsilon ) and
659
 
  is_equal_eps(m2 ,m.m2 ,epsilon ) and
660
 
  is_equal_eps(m3 ,m.m3 ,epsilon ) and
661
 
  is_equal_eps(m4 ,m.m4 ,epsilon ) and
662
 
  is_equal_eps(m5 ,m.m5 ,epsilon );
663
 
  
664
 
end;
665
 
 
666
 
{ rotation }
667
 
function trans_affine.rotation;
668
 
var
669
 
 x1 ,y1 ,x2 ,y2 : double;
670
 
 
671
 
begin
672
 
 x1:=0;
673
 
 y1:=0;
674
 
 x2:=1;
675
 
 y2:=0;
676
 
 
677
 
 transform(@self ,@x1 ,@y1 );
678
 
 transform(@self ,@x2 ,@y2 );
679
 
 
680
 
 result:=ArcTan2(y2 - y1 ,x2 - x1 );
681
 
 
682
 
end;
683
 
 
684
 
{ translation }
685
 
procedure trans_affine.translation;
686
 
begin
687
 
 dx:=0;
688
 
 dy:=0;
689
 
 
690
 
 transform(@self ,@dx ,@dy );
691
 
 
692
 
end;
693
 
 
694
 
{ scaling }
695
 
procedure trans_affine.scaling;
696
 
var
697
 
 t : trans_affine_rotation;
698
 
 
699
 
 x1 ,y1 ,x2 ,y2 : double;
700
 
 
701
 
begin
702
 
 x1:=0;
703
 
 y1:=0;
704
 
 x2:=1;
705
 
 y2:=1;
706
 
 
707
 
 trans_affine(t ):=self;
708
 
 
709
 
 t.Construct(-rotation );
710
 
 
711
 
 t.transform(@self ,@x1 ,@y1 );
712
 
 t.transform(@self ,@x2 ,@y2 );
713
 
 
714
 
 sx^:=x2 - x1;
715
 
 sy^:=y2 - y1;
716
 
 
717
 
end;
718
 
 
719
 
{ scaling_abs }
720
 
procedure trans_affine.scaling_abs;
721
 
begin
722
 
 sx^:=Sqrt(m0 * m0 + m2 * m2 );
723
 
 sy^:=Sqrt(m1 * m1 + m3 * m3 );
724
 
 
725
 
end;
726
 
 
727
 
{ ASSIGN }
728
 
procedure trans_affine.assign;
729
 
begin
730
 
 m0:=from.m0;
731
 
 m1:=from.m1;
732
 
 m2:=from.m2;
733
 
 m3:=from.m3;
734
 
 m4:=from.m4;
735
 
 m5:=from.m5;
736
 
 
737
 
end;
738
 
 
739
 
{ ASSIGN_ALL }
740
 
procedure trans_affine.assign_all;
741
 
begin
742
 
 m0:=from.m0;
743
 
 m1:=from.m1;
744
 
 m2:=from.m2;
745
 
 m3:=from.m3;
746
 
 m4:=from.m4;
747
 
 m5:=from.m5;
748
 
 
749
 
 transform        :=@from.transform;
750
 
 transform_2x2    :=@from.transform_2x2;
751
 
 inverse_transform:=@from.inverse_transform;
752
 
 
753
 
end;
754
 
 
755
 
{ TRANSLATE }
756
 
function trans_affine.translate(x ,y : double ) : trans_affine_ptr;
757
 
begin
758
 
 m4:=m4 + x;
759
 
 m5:=m5 + y;
760
 
 
761
 
 result:=@self;
762
 
 
763
 
end;
764
 
 
765
 
{ ROTATE }
766
 
function trans_affine.rotate(a : double ) : trans_affine_ptr;
767
 
var
768
 
 ca ,sa ,t0 ,t2 ,t4 : double;
769
 
 
770
 
begin
771
 
 ca:=Cos(a);
772
 
 sa:=Sin(a);
773
 
 t0:=m0 * ca - m1 * sa;
774
 
 t2:=m2 * ca - m3 * sa;
775
 
 t4:=m4 * ca - m5 * sa;
776
 
 
777
 
 m1:=m0 * sa + m1 * ca;
778
 
 m3:=m2 * sa + m3 * ca;
779
 
 m5:=m4 * sa + m5 * ca;
780
 
 m0:=t0;
781
 
 m2:=t2;
782
 
 m4:=t4;
783
 
 
784
 
 result:=@self;
785
 
 
786
 
end;
787
 
 
788
 
{ SCALE }
789
 
function trans_affine.scale(s : double ) : trans_affine_ptr;
790
 
begin
791
 
 m0:=m0 * s;
792
 
 m1:=m1 * s;
793
 
 m2:=m2 * s;
794
 
 m3:=m3 * s;
795
 
 m4:=m4 * s;
796
 
 m5:=m5 * s;
797
 
 
798
 
 result:=@self;
799
 
 
800
 
end;
801
 
 
802
 
{ SCALE }
803
 
function trans_affine.scale(x ,y : double ) : trans_affine_ptr;
804
 
begin
805
 
 m0:=m0 * x;
806
 
 m2:=m2 * x;
807
 
 m4:=m4 * x;
808
 
 m1:=m1 * y;
809
 
 m3:=m3 * y;
810
 
 m5:=m5 * y;
811
 
 
812
 
 result:=@self;
813
 
 
814
 
end;
815
 
 
816
 
{ CONSTRUCT }
817
 
constructor trans_affine_rotation.Construct;
818
 
begin
819
 
 inherited Construct(Cos(a ) ,Sin(a ) ,-Sin(a ) ,Cos(a ) ,0 ,0 );
820
 
 
821
 
end;
822
 
 
823
 
{ CONSTRUCT }
824
 
constructor trans_affine_scaling.Construct(sx ,sy : double );
825
 
begin
826
 
 inherited Construct(sx ,0 ,0 ,sy ,0 ,0 );
827
 
 
828
 
end;
829
 
 
830
 
{ CONSTRUCT }
831
 
constructor trans_affine_scaling.Construct(s : double );
832
 
begin
833
 
 inherited Construct(s ,0 ,0 ,s ,0 ,0 );
834
 
 
835
 
end;
836
 
 
837
 
{ CONSTRUCT }
838
 
constructor trans_affine_translation.Construct;
839
 
begin
840
 
 inherited Construct(1 ,0 ,0 ,1 ,tx ,ty );
841
 
 
842
 
end;
843
 
 
844
 
{ CONSTRUCT }
845
 
constructor trans_affine_skewing.Construct;
846
 
begin
847
 
 inherited Construct(1 ,Tan(sy ) ,Tan(sx ) ,1 ,0 ,0 );
848
 
 
849
 
end;
850
 
 
851
 
{ CONSTRUCT }
852
 
constructor trans_affine_line_segment.Construct;
853
 
var
854
 
 dx ,dy : double;
855
 
 
856
 
 s : trans_affine_scaling;
857
 
 r : trans_affine_rotation;
858
 
 t : trans_affine_translation;
859
 
 
860
 
begin
861
 
 dx:=x2 - x1;
862
 
 dy:=y2 - y1;
863
 
 
864
 
 if dist > 0 then
865
 
  begin
866
 
   s.Construct(Sqrt(dx * dx + dy * dy ) / dist );
867
 
 
868
 
   multiply(@s );
869
 
 
870
 
  end;
871
 
 
872
 
 r.Construct(ArcTan2(dy ,dx ) );
873
 
 
874
 
 multiply(@r );
875
 
 
876
 
 t.Construct(x1 ,y1 );
877
 
 
878
 
 multiply(@t );
879
 
 
880
 
end;
881
 
 
882
 
{ CONSTRUCT }
883
 
constructor trans_affine_reflection_unit.Construct(ux ,uy : double );
884
 
begin
885
 
 inherited Construct(
886
 
  2.0 * ux * ux - 1.0 ,
887
 
  2.0 * ux * uy ,
888
 
  2.0 * ux * uy ,
889
 
  2.0 * uy * uy - 1.0 ,
890
 
  0.0 ,0.0 );
891
 
 
892
 
end;
893
 
 
894
 
{ CONSTRUCT }
895
 
constructor trans_affine_reflection.Construct(a : double );
896
 
begin
897
 
 inherited Construct(Cos(a ) ,Sin(a ) );
898
 
 
899
 
end;
900
 
 
901
 
{ CONSTRUCT }
902
 
constructor trans_affine_reflection.Construct(x ,y : double );
903
 
var
904
 
 nx ,ny : double;
905
 
 
906
 
begin
907
 
 if (x = 0 ) and
908
 
    (y = 0 ) then
909
 
  begin
910
 
   x:=0;
911
 
   y:=0;
912
 
 
913
 
  end
914
 
 else
915
 
  begin
916
 
   nx:=x / Sqrt(x * x + y * y );
917
 
   ny:=y / Sqrt(x * x + y * y );
918
 
 
919
 
  end;
920
 
 
921
 
 inherited Construct(nx ,ny );
922
 
 
923
 
end;
924
 
 
925
 
END.
926