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