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