File Coverage

blib/lib/Geometry/AffineTransform.pm
Criterion Covered Total %
statement 70 70 100.0
branch 3 4 75.0
condition 2 3 66.6
subroutine 19 19 100.0
pod 9 14 64.2
total 103 110 93.6


line stmt bran cond sub pod time code
1             package Geometry::AffineTransform;
2              
3             our $VERSION = '1.4';
4              
5 1     1   41843 use strict;
  1         2  
  1         28  
6 1     1   5 use warnings;
  1         2  
  1         22  
7              
8 1     1   4 use Carp;
  1         6  
  1         58  
9 1     1   842 use Hash::Util;
  1         2337  
  1         5  
10 1     1   928 use Math::Trig ();
  1         21341  
  1         866  
11              
12             =head1 NAME
13              
14             Geometry::AffineTransform - Affine Transformation to map 2D coordinates to other 2D coordinates
15              
16             =head1 SYNOPSIS
17              
18             use Geometry::AffineTransform;
19              
20             my $t = Geometry::AffineTransform->new();
21             $t->translate($delta_x, $delta_y);
22             $t->rotate($degrees);
23             my $t2 = Geometry::AffineTransform->new()->scale(3.1, 2.3);
24             $t->concatenate($t2);
25             my ($x1, $y1, $x2, $y2, ...) = $t->transform($x1, $y1, $x2, $y2, ...);
26              
27             =head1 DESCRIPTION
28              
29             Geometry::AffineTransform instances represent 2D affine transformations
30             that map 2D coordinates to other 2D coordinates. The references in
31             L provide more information about affine transformations.
32              
33             You create a new instance with L, configure it to perform the desired transformation
34             with a combination of L, L and L and then perform the actual
35             transformation on one or more x/y coordinate pairs with L.
36              
37             The state of a newly created instance represents the identity transform,
38             that is, it transforms all input coordinates to the same output coordinates.
39              
40             Most methods return the instance so that you can chain method calls:
41              
42             my $t = Geometry::AffineTransform->new();
43             $t->scale(...)->translate(...)->rotate(...);
44              
45             ($x, $y) = Geometry::AffineTransform->new()->rotate(..)->transform($x, $y);
46              
47             =cut
48              
49              
50             =head1 METHODS
51              
52             =head2 new
53              
54             Constructor, returns a new instance configured with an identity transform.
55              
56             You can optionally supply any of the six specifiable parts of the transformation matrix.
57             The six values in the first two columns are the specifiable values:
58              
59             [ m11 m21 0 ]
60             [ m21 m22 0 ]
61             [ tx ty 1 ]
62              
63             The constructor lets you initialize them with key/value parameters:
64              
65             my $t = Geometry::AffineTransform->new(tx => 10, ty => 15);
66              
67             By default, the identity transform represented by this matrix is used:
68              
69             [ 1 0 0 ]
70             [ 0 1 0 ]
71             [ 0 0 1 ]
72              
73             In other words, invoking the constructor without arguments is equivalent to this:
74              
75             my $t = Geometry::AffineTransform->new(
76             m11 => 1,
77             m12 => 0,
78             m21 => 0,
79             m22 => 1,
80             tx => 0,
81             ty => 0
82             );
83              
84             =cut
85              
86             sub new {
87 16     16 1 10115 my $self = shift;
88 16         29 my (%args) = @_;
89              
90 16   66     64 my $class = ref($self) || $self;
91 16         90 $self = bless {m11 => 1, m12 => 0, m21 => 0, m22 => 1, tx => 0, ty => 0, %args}, $class;
92             # $self->init();
93 16         63 Hash::Util::lock_keys(%$self);
94              
95 16         182 return $self;
96             }
97              
98              
99             # hook for subclasses
100             # sub init {
101             # }
102              
103              
104              
105              
106             =head2 clone
107              
108             Returns a clone of the instance.
109              
110             =cut
111              
112             sub clone {
113 4     4 1 603 my $self = shift;
114 4         18 return $self->new()->set_matrix_2x3($self->matrix_2x3());
115             }
116              
117              
118              
119             =head2 invert
120              
121             Inverts the state of the transformation.
122              
123             my $inverted_clone = $t->clone()->invert();
124              
125             =cut
126              
127             sub invert {
128 4     4 1 535 my $self = shift;
129              
130 4         8 my $det = $self->determinant();
131            
132 4 100       188 croak "Unable to invert this transform (zero determinant)" unless $det;
133              
134 3         20 return $self->set_matrix_2x3(
135             $self->{m22} / $det, # 11
136             -$self->{m12} / $det, # 12
137             -$self->{m21} / $det, # 21
138             $self->{m11} / $det, # 22
139             ($self->{m21} * $self->{ty} - $self->{m22} * $self->{tx}) / $det,
140             ($self->{m12} * $self->{tx} - $self->{m11} * $self->{ty}) / $det,
141             );
142             }
143              
144              
145              
146             =head2 transform
147              
148             Transform one or more coordinate pairs according to the current state.
149              
150             This method expects an even number of positional parameters, each pair
151             representing the x and y coordinates of a point.
152              
153             Returns the transformed list of coordinates in the same form as the input list.
154              
155             my @output = $t->transform(2, 4, 10, 20);
156              
157             =cut
158              
159             sub transform {
160 13     13 1 1923 my $self = shift;
161 13         24 my (@pairs) = @_;
162              
163 13         15 my @result;
164 13         44 while (my ($x, $y) = splice(@pairs, 0, 2)) {
165 15         36 my $x2 = $self->{m11} * $x + $self->{m21} * $y + $self->{tx};
166 15         30 my $y2 = $self->{m12} * $x + $self->{m22} * $y + $self->{ty};
167 15         53 push @result, $x2, $y2;
168             }
169              
170 13         62 return @result;
171             }
172              
173              
174              
175              
176             # concatenate another transformation matrix to the current state.
177             # Takes the six specifiable parts of the 3x3 transformation matrix.
178             sub concatenate_matrix_2x3 {
179 13     13 0 18 my $self = shift;
180 13         25 my ($m11, $m12, $m21, $m22, $tx, $ty) = @_;
181 13         22 my $a = [$self->matrix_2x3()];
182 13         28 my $b = [$m11, $m12, $m21, $m22, $tx, $ty];
183 13         32 return $self->set_matrix_2x3($self->matrix_multiply($a, $b));
184             }
185              
186              
187             =head2 concatenate
188              
189             Combine the receiver's state with that of another transformation instance.
190              
191             This method expects a list of one or more C
192             instances and combines the transformation of each one with the receiver's
193             in the given order.
194              
195             Returns C<$self>.
196              
197             =cut
198              
199             sub concatenate {
200 1     1 1 7 my $self = shift;
201 1         3 my @transforms = @_;
202 1         3 foreach my $t (@transforms) {
203 1 50       5 croak "Expecting argument of type Geometry::AffineTransform" unless (ref $t);
204 1         3 $self->concatenate_matrix_2x3($t->matrix_2x3()) ;
205             }
206 1         4 return $self;
207             }
208              
209              
210             =head2 scale
211              
212             Adds a scaling transformation.
213              
214             This method expects positional parameters.
215              
216             =over
217              
218             =item sx
219              
220             The scaling factor for the x dimension.
221              
222             =item sy
223              
224             The scaling factor for the y dimension.
225              
226             =back
227              
228             Returns C<$self>.
229              
230             =cut
231              
232             sub scale {
233 5     5 1 19 my $self = shift;
234 5         8 my ($sx, $sy) = @_;
235 5         14 return $self->concatenate_matrix_2x3($sx, 0, 0, $sy, 0, 0);
236             }
237              
238              
239             =head2 translate
240              
241             Adds a translation transformation, i.e. the transformation shifts
242             the input coordinates by a constant amount.
243              
244             This method expects positional parameters.
245              
246             =over
247              
248             =item tx
249              
250             The offset for the x dimension.
251              
252             =item ty
253              
254             The offset for the y dimension.
255              
256             =back
257              
258             Returns C<$self>.
259              
260             =cut
261              
262             sub translate {
263 2     2 1 6 my $self = shift;
264 2         98 my ($tx, $ty) = @_;
265 2         7 return $self->concatenate_matrix_2x3(1, 0, 0, 1, $tx, $ty);
266             }
267              
268              
269              
270              
271             =head2 rotate
272              
273             Adds a rotation transformation.
274              
275             This method expects positional parameters.
276              
277             =over
278              
279             =item angle
280              
281             The rotation angle in degrees. With no other transformation active,
282             positive values rotate counterclockwise.
283              
284             =back
285              
286             Returns C<$self>.
287              
288             =cut
289              
290             sub rotate {
291 4     4 1 9 my $self = shift;
292 4         6 my ($degrees) = @_;
293 4         16 my $rad = Math::Trig::deg2rad($degrees);
294 4         106 return $self->concatenate_matrix_2x3(cos($rad), sin($rad), -sin($rad), cos($rad), 0, 0);
295             }
296              
297              
298              
299             # returns the 6 specifiable parts of the transformation matrix
300             sub matrix_2x3 {
301 25     25 0 37 my $self = shift;
302 25         132 return $self->{m11}, $self->{m12}, $self->{m21}, $self->{m22}, $self->{tx}, $self->{ty};
303             }
304              
305              
306             # returns the determinant of the matrix
307             sub determinant {
308 6     6 0 14 my $self = shift;
309 6         20 return $self->{m11} * $self->{m22} - $self->{m12} * $self->{m21};
310             }
311              
312              
313             # sets the 6 specifiable parts of the transformation matrix
314             sub set_matrix_2x3 {
315 26     26 0 46 my $self = shift;
316 26         82 ($self->{m11}, $self->{m12},
317             $self->{m21}, $self->{m22},
318             $self->{tx}, $self->{ty}) = @_;
319 26         103 return $self;
320             }
321              
322              
323             =head2 matrix
324              
325             Returns the current value of the 3 x 3 transformation matrix, including the
326             third, fixed column, as a 9-element list:
327              
328             my ($m11, $m12, undef,
329             $m21, $m22, undef,
330             $tx, $ty, undef) = $t->matrix();
331              
332             =cut
333              
334             sub matrix {
335 1     1 1 2 my $self = shift;
336 1         8 return $self->{m11}, $self->{m12}, 0, $self->{m21}, $self->{m22}, 0, $self->{tx}, $self->{ty}, 1;
337             }
338              
339              
340              
341              
342             # a simplified multiply that assumes the fixed 0 0 1 third column
343             sub matrix_multiply {
344 14     14 0 883 my $self = shift;
345 14         27 my ($a, $b) = @_;
346              
347             # a11 a12 0
348             # a21 a22 0
349             # a31 a32 1
350             #
351             # b11 b12 0
352             # b21 b22 0
353             # b31 b32 1
354              
355 14         24 my ($a11, $a12, $a21, $a22, $a31, $a32) = @$a;
356 14         19 my ($b11, $b12, $b21, $b22, $b31, $b32) = @$b;
357              
358             return
359 14         82 ($a11 * $b11 + $a12 * $b21), ($a11 * $b12 + $a12 * $b22),
360             ($a21 * $b11 + $a22 * $b21), ($a21 * $b12 + $a22 * $b22),
361             ($a31 * $b11 + $a32 * $b21 + $b31), ($a31 * $b12 + $a32 * $b22 + $b32),
362             ;
363              
364             }
365              
366              
367             =head1 SEE ALSO
368              
369             =over
370              
371             =item Apple Quartz 2D Programming Guide - The Math Behind the Matrices
372              
373             L
374              
375             =item Sun Java java.awt.geom.AffineTransform
376              
377             L
378              
379             =item Wikipedia - Matrix Multiplication
380              
381             L
382              
383             =back
384              
385              
386              
387             =head1 AUTHOR
388              
389             Marc Liyanage
390              
391             =head1 COPYRIGHT AND LICENSE
392              
393             Copyright 2008 Marc Liyanage.
394              
395             Distributed under the Artistic License 2.
396              
397             =cut
398              
399              
400             1;