[rt.cpan.org #29938] add matrix() method to Imager::Matrix2d
[imager.git] / lib / Imager / Matrix2d.pm
CommitLineData
faa9b3e7
TC
1package Imager::Matrix2d;
2use strict;
f17b46d8
TC
3use vars qw($VERSION);
4
5715f7c3 5$VERSION = "1.009";
faa9b3e7
TC
6
7=head1 NAME
8
9 Imager::Matrix2d - simple wrapper for matrix construction
10
11=head1 SYNOPSIS
12
13 use Imager::Matrix2d;
14 $m1 = Imager::Matrix2d->identity;
15 $m2 = Imager::Matrix2d->rotate(radians=>$angle, x=>$cx, y=>$cy);
16 $m3 = Imager::Matrix2d->translate(x=>$dx, y=>$dy);
17 $m4 = Imager::Matrix2d->shear(x=>$sx, y=>$sy);
18 $m5 = Imager::Matrix2d->reflect(axis=>$axis);
19 $m6 = Imager::Matrix2d->scale(x=>$xratio, y=>$yratio);
4326b23a
TC
20 $m8 = Imager::Matric2d->matrix($v11, $v12, $v13,
21 $v21, $v22, $v23,
22 $v31, $v32, $v33);
faa9b3e7
TC
23 $m6 = $m1 * $m2;
24 $m7 = $m1 + $m2;
25 use Imager::Matrix2d qw(:handy);
26 # various m2d_* functions imported
27 # where m2d_(.*) calls Imager::Matrix2d->$1()
28
29=head1 DESCRIPTION
30
31This class provides a simple wrapper around a reference to an array of
329 co-efficients, treated as a matrix:
33
34 [ 0, 1, 2,
35 3, 4, 5,
36 6, 7, 8 ]
37
38Most of the methods in this class are constructors. The others are
39overloaded operators.
40
41Note that since Imager represents images with y increasing from top to
42bottom, rotation angles are clockwise, rather than counter-clockwise.
43
44=over
45
46=cut
47
48use vars qw(@EXPORT_OK %EXPORT_TAGS @ISA);
49@ISA = 'Exporter';
50require 'Exporter.pm';
51@EXPORT_OK = qw(m2d_rotate m2d_identity m2d_translate m2d_shear
52 m2d_reflect m2d_scale);
53%EXPORT_TAGS =
54 (
55 handy=> [ qw(m2d_rotate m2d_identity m2d_translate m2d_shear
56 m2d_reflect m2d_scale) ],
57 );
58
59use overload
60 '*' => \&_mult,
61 '+' => \&_add,
62 '""'=>\&_string;
63
64=item identity()
65
66Returns the identity matrix.
67
68=cut
69
70sub identity {
71 return bless [ 1, 0, 0,
72 0, 1, 0,
73 0, 0, 1 ], $_[0];
74}
75
76=item rotate(radians=>$angle)
77
78=item rotate(degrees=>$angle)
79
80Creates a matrix that rotates around the origin, or around the point
81(x,y) if the 'x' and 'y' parameters are provided.
82
83=cut
84
85sub rotate {
86 my ($class, %opts) = @_;
87 my $angle;
88
89 if (defined $opts{radians}) {
90 $angle = $opts{radians};
91 }
92 elsif (defined $opts{degrees}) {
93 $angle = $opts{degrees} * 3.1415926535 / 180;
94 }
95 else {
96 $Imager::ERRSTR = "degrees or radians parameter required";
97 return undef;
98 }
99
fe98a815
TC
100 if ($opts{'x'} || $opts{'y'}) {
101 $opts{'x'} ||= 0;
102 $opts{'y'} ||= 0;
9d540150 103 return $class->translate('x'=>-$opts{'x'}, 'y'=>-$opts{'y'})
faa9b3e7 104 * $class->rotate(radians=>$angle)
9d540150 105 * $class->translate('x'=>$opts{'x'}, 'y'=>$opts{'y'});
faa9b3e7
TC
106 }
107 else {
108 my $sin = sin($angle);
109 my $cos = cos($angle);
110 return bless [ $cos, -$sin, 0,
111 $sin, $cos, 0,
112 0, 0, 1 ], $class;
113 }
114}
115
116=item translate(x=>$dx, y=>$dy)
117
8fde3bbb
TC
118=item translate(x=>$dx)
119
120=item translate(y=>$dy)
121
faa9b3e7
TC
122Translates by the specify amounts.
123
124=cut
33b0ffa6 125
faa9b3e7
TC
126sub translate {
127 my ($class, %opts) = @_;
128
33b0ffa6
TC
129 if (defined $opts{'x'} || defined $opts{'y'}) {
130 my $x = $opts{'x'} || 0;
131 my $y = $opts{'y'} || 0;
132 return bless [ 1, 0, $x,
133 0, 1, $y,
faa9b3e7
TC
134 0, 0, 1 ], $class;
135 }
97c4effc 136
33b0ffa6 137 $Imager::ERRSTR = 'x or y parameter required';
faa9b3e7
TC
138 return undef;
139}
140
141=item shear(x=>$sx, y=>$sy)
142
8fde3bbb
TC
143=item shear(x=>$sx)
144
145=item shear(y=>$sy)
146
faa9b3e7
TC
147Shear by the given amounts.
148
149=cut
150sub shear {
151 my ($class, %opts) = @_;
152
9d540150
TC
153 if (defined $opts{'x'} || defined $opts{'y'}) {
154 return bless [ 1, $opts{'x'}||0, 0,
155 $opts{'y'}||0, 1, 0,
156 0, 0, 1 ], $class;
faa9b3e7
TC
157 }
158 $Imager::ERRSTR = 'x and y parameters required';
159 return undef;
160}
161
162=item reflect(axis=>$axis)
163
164Reflect around the given axis, either 'x' or 'y'.
165
166=item reflect(radians=>$angle)
167
168=item reflect(degrees=>$angle)
169
170Reflect around a line drawn at the given angle from the origin.
171
172=cut
173
174sub reflect {
175 my ($class, %opts) = @_;
176
177 if (defined $opts{axis}) {
178 my $result = $class->identity;
179 if ($opts{axis} eq "y") {
180 $result->[0] = -$result->[0];
181 }
182 elsif ($opts{axis} eq "x") {
183 $result->[4] = -$result->[4];
184 }
185 else {
186 $Imager::ERRSTR = 'axis must be x or y';
187 return undef;
188 }
189
190 return $result;
191 }
192 my $angle;
193 if (defined $opts{radians}) {
194 $angle = $opts{radians};
195 }
196 elsif (defined $opts{degrees}) {
197 $angle = $opts{degrees} * 3.1415926535 / 180;
198 }
199 else {
200 $Imager::ERRSTR = 'axis, degrees or radians parameter required';
201 return undef;
202 }
203
204 # fun with matrices
205 return $class->rotate(radians=>-$angle) * $class->reflect(axis=>'x')
206 * $class->rotate(radians=>$angle);
207}
208
209=item scale(x=>$xratio, y=>$yratio)
210
211Scales at the given ratios.
212
5715f7c3 213You can also specify a center for the scaling with the C<cx> and C<cy>
faa9b3e7
TC
214parameters.
215
216=cut
217
218sub scale {
219 my ($class, %opts) = @_;
220
9d540150
TC
221 if (defined $opts{'x'} || defined $opts{'y'}) {
222 $opts{'x'} = 1 unless defined $opts{'x'};
faa9b3e7
TC
223 $opts{'y'} = 1 unless defined $opts{'y'};
224 if ($opts{cx} || $opts{cy}) {
9d540150
TC
225 return $class->translate('x'=>-$opts{cx}, 'y'=>-$opts{cy})
226 * $class->scale('x'=>$opts{'x'}, 'y'=>$opts{'y'})
227 * $class->translate('x'=>$opts{cx}, 'y'=>$opts{cy});
faa9b3e7
TC
228 }
229 else {
9d540150
TC
230 return bless [ $opts{'x'}, 0, 0,
231 0, $opts{'y'}, 0,
232 0, 0, 1 ], $class;
faa9b3e7
TC
233 }
234 }
235 else {
236 $Imager::ERRSTR = 'x or y parameter required';
237 return undef;
238 }
239}
240
4326b23a
TC
241=item matrix($v11, $v12, $v13, $v21, $v22, $v23, $v31, $v32, $v33)
242
243Create a matrix with custom co-efficients.
244
245=cut
246
247sub matrix {
248 my ($class, @self) = @_;
249
250 if (@self == 9) {
251 return bless \@self, $class;
252 }
253 else {
254 $Imager::ERRSTR = "9 co-efficients required";
255 return;
256 }
257}
258
faa9b3e7
TC
259=item _mult()
260
261Implements the overloaded '*' operator. Internal use.
262
263Currently both the left and right-hand sides of the operator must be
264an Imager::Matrix2d.
265
266=cut
267sub _mult {
268 my ($left, $right, $order) = @_;
269
270 if (ref($right) && UNIVERSAL::isa($right, __PACKAGE__)) {
271 if ($order) {
272 ($left, $right) = ($right, $left);
273 }
274 my @result;
275 for my $i (0..2) {
276 for my $j (0..2) {
277 my $accum = 0;
278 for my $k (0..2) {
279 $accum += $left->[3*$i + $k] * $right->[3*$k + $j];
280 }
281 $result[3*$i+$j] = $accum;
282 }
283 }
284 return bless \@result, __PACKAGE__;
285 }
286 else {
287 # presumably N * matrix or matrix * N
288 return undef; # for now
289 }
290}
291
292=item _add()
293
294Implements the overloaded binary '+' operator.
295
296Currently both the left and right sides of the operator must be
297Imager::Matrix2d objects.
298
299=cut
300sub _add {
301 my ($left, $right, $order) = @_;
302
303 if (ref($right) && UNIVERSAL::isa($right, __PACKAGE__)) {
304 my @result;
305 for (0..8) {
306 push @result, $left->[$_] + $right->[$_];
307 }
308
309 return bless \@result, __PACKAGE__;
310 }
311 else {
312 return undef;
313 }
314}
315
316=item _string()
317
318Implements the overloaded stringification operator.
319
320This returns a string containing 3 lines of text with no terminating
321newline.
322
323I tried to make it fairly nicely formatted. You might disagree :)
324
325=cut
ef1ab93b 326
faa9b3e7
TC
327sub _string {
328 my ($m) = @_;
329
330 my $maxlen = 0;
331 for (@$m[0..8]) {
332 if (length() > $maxlen) {
333 $maxlen = length;
334 }
335 }
336 $maxlen <= 9 or $maxlen = 9;
337
338 my @left = ('[ ', ' ', ' ');
339 my @right = ("\n", "\n", ']');
340 my $out;
341 my $width = $maxlen+2;
342 for my $i (0..2) {
343 $out .= $left[$i];
344 for my $j (0..2) {
345 my $val = $m->[$i*3+$j];
346 if (length $val > 9) {
347 $val = sprintf("%9f", $val);
348 if ($val =~ /\./ && $val !~ /e/i) {
349 $val =~ s/0+$//;
350 $val =~ s/\.$//;
351 }
352 $val =~ s/^\s//;
353 }
354 $out .= sprintf("%-${width}s", "$val, ");
355 }
356 $out =~ s/ +\Z/ /;
357 $out .= $right[$i];
358 }
359 $out;
360}
361
362=back
363
364The following functions are shortcuts to the various constructors.
365
366These are not methods.
367
368You can import these methods with:
369
370 use Imager::Matrix2d ':handy';
371
372=over
373
374=item m2d_identity
375
376=item m2d_rotate()
377
378=item m2d_translate()
379
380=item m2d_shear()
381
382=item m2d_reflect()
383
8688bedd
TC
384=item m2d_scale()
385
faa9b3e7
TC
386=back
387
388=cut
389
390sub m2d_identity {
391 return __PACKAGE__->identity;
392}
393
394sub m2d_rotate {
395 return __PACKAGE__->rotate(@_);
396}
397
398sub m2d_translate {
399 return __PACKAGE__->translate(@_);
400}
401
402sub m2d_shear {
403 return __PACKAGE__->shear(@_);
404}
405
406sub m2d_reflect {
407 return __PACKAGE__->reflect(@_);
408}
409
410sub m2d_scale {
411 return __PACKAGE__->scale(@_);
412}
413
4141;
415
416=head1 AUTHOR
417
418Tony Cook <tony@develop-help.com>
419
420=head1 BUGS
421
5715f7c3 422Needs a way to invert a matrix.
faa9b3e7
TC
423
424=head1 SEE ALSO
425
426Imager(3), Imager::Font(3)
427
8f22b8d8 428http://imager.perl.org/
faa9b3e7
TC
429
430=cut