eliminate use vars
[imager.git] / lib / Imager / Matrix2d.pm
CommitLineData
faa9b3e7 1package Imager::Matrix2d;
ee64a81f 2use 5.006;
faa9b3e7 3use strict;
a34dc54c
TC
4use Scalar::Util qw(reftype looks_like_number);
5use Carp qw(croak);
f17b46d8 6
ee64a81f 7our $VERSION = "1.013";
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
ee64a81f
TC
50our @ISA = 'Exporter';
51require Exporter;
52our @EXPORT_OK = qw(m2d_rotate m2d_identity m2d_translate m2d_shear
faa9b3e7 53 m2d_reflect m2d_scale);
ee64a81f 54our %EXPORT_TAGS =
faa9b3e7
TC
55 (
56 handy=> [ qw(m2d_rotate m2d_identity m2d_translate m2d_shear
57 m2d_reflect m2d_scale) ],
58 );
59
60use overload
61 '*' => \&_mult,
62 '+' => \&_add,
5efba0c6
TC
63 '""'=>\&_string,
64 "eq" => \&_eq;
faa9b3e7
TC
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;
f480f885 105 return $class->translate('x'=>$opts{'x'}, 'y'=>$opts{'y'})
faa9b3e7 106 * $class->rotate(radians=>$angle)
f480f885 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
94995883 245Create a matrix with custom coefficients.
4326b23a
TC
246
247=cut
248
249sub matrix {
250 my ($class, @self) = @_;
251
252 if (@self == 9) {
253 return bless \@self, $class;
254 }
255 else {
94995883 256 $Imager::ERRSTR = "9 coefficients required";
4326b23a
TC
257 return;
258 }
259}
260
f480f885
TC
261=item transform($x, $y)
262
263Transform a point the same way matrix_transform does.
264
265=cut
266
267sub transform {
268 my ($self, $x, $y) = @_;
269
270 my $sz = $x * $self->[6] + $y * $self->[7] + $self->[8];
271 my ($sx, $sy);
272 if (abs($sz) > 0.000001) {
273 $sx = ($x * $self->[0] + $y * $self->[1] + $self->[2]) / $sz;
274 $sy = ($x * $self->[3] + $y * $self->[4] + $self->[5]) / $sz;
275 }
276 else {
277 $sx = $sy = 0;
278 }
279
280 return ($sx, $sy);
281}
282
283=item compose(matrix...)
284
285Compose several matrices together for use in transformation.
286
287For example, for three matrices:
288
289 my $out = Imager::Matrix2d->compose($m1, $m2, $m3);
290
291is equivalent to:
292
293 my $out = $m3 * $m2 * $m1;
294
295Returns the identity matrix if no parameters are supplied.
296
297May return the supplied matrix if only one matrix is supplied.
298
299=cut
300
301sub compose {
302 my ($class, @in) = @_;
303
304 @in
305 or return $class->identity;
306
307 my $out = pop @in;
308 for my $m (reverse @in) {
309 $out = $out * $m;
310 }
311
312 return $out;
313}
314
faa9b3e7
TC
315=item _mult()
316
317Implements the overloaded '*' operator. Internal use.
318
319Currently both the left and right-hand sides of the operator must be
320an Imager::Matrix2d.
321
f480f885
TC
322When composing a matrix for transformation you should multiply the
323matrices in the reverse order of the transformations:
324
325 my $shear = Imager::Matrix2d->shear(x => 0.1);
326 my $rotate = Imager::Matrix2d->rotate(degrees => 45);
327 my $shear_then_rotate = $rotate * $shear;
328
329or use the compose method:
330
331 my $shear_then_rotate = Imager::Matrix2d->compose($shear, $rotate);
332
faa9b3e7 333=cut
a34dc54c 334
faa9b3e7
TC
335sub _mult {
336 my ($left, $right, $order) = @_;
337
a34dc54c
TC
338 if (ref($right)) {
339 if (reftype($right) eq "ARRAY") {
340 @$right == 9
341 or croak "9 elements required in array ref";
342 if ($order) {
343 ($left, $right) = ($right, $left);
faa9b3e7 344 }
a34dc54c
TC
345 my @result;
346 for my $i (0..2) {
347 for my $j (0..2) {
348 my $accum = 0;
349 for my $k (0..2) {
350 $accum += $left->[3*$i + $k] * $right->[3*$k + $j];
351 }
352 $result[3*$i+$j] = $accum;
353 }
354 }
355 return bless \@result, __PACKAGE__;
faa9b3e7 356 }
a34dc54c
TC
357 else {
358 croak "multiply by array ref or number";
359 }
360 }
361 elsif (defined $right && looks_like_number($right)) {
362 my @result = map $_ * $right, @$left;
363
faa9b3e7
TC
364 return bless \@result, __PACKAGE__;
365 }
366 else {
a34dc54c
TC
367 # something we don't handle
368 croak "multiply by array ref or number";
faa9b3e7
TC
369 }
370}
371
372=item _add()
373
374Implements the overloaded binary '+' operator.
375
376Currently both the left and right sides of the operator must be
377Imager::Matrix2d objects.
378
379=cut
380sub _add {
381 my ($left, $right, $order) = @_;
382
383 if (ref($right) && UNIVERSAL::isa($right, __PACKAGE__)) {
384 my @result;
385 for (0..8) {
386 push @result, $left->[$_] + $right->[$_];
387 }
388
389 return bless \@result, __PACKAGE__;
390 }
391 else {
392 return undef;
393 }
394}
395
396=item _string()
397
398Implements the overloaded stringification operator.
399
400This returns a string containing 3 lines of text with no terminating
401newline.
402
403I tried to make it fairly nicely formatted. You might disagree :)
404
405=cut
ef1ab93b 406
faa9b3e7
TC
407sub _string {
408 my ($m) = @_;
409
410 my $maxlen = 0;
411 for (@$m[0..8]) {
412 if (length() > $maxlen) {
413 $maxlen = length;
414 }
415 }
416 $maxlen <= 9 or $maxlen = 9;
417
418 my @left = ('[ ', ' ', ' ');
419 my @right = ("\n", "\n", ']');
420 my $out;
421 my $width = $maxlen+2;
422 for my $i (0..2) {
423 $out .= $left[$i];
424 for my $j (0..2) {
425 my $val = $m->[$i*3+$j];
426 if (length $val > 9) {
427 $val = sprintf("%9f", $val);
428 if ($val =~ /\./ && $val !~ /e/i) {
429 $val =~ s/0+$//;
430 $val =~ s/\.$//;
431 }
432 $val =~ s/^\s//;
433 }
434 $out .= sprintf("%-${width}s", "$val, ");
435 }
436 $out =~ s/ +\Z/ /;
437 $out .= $right[$i];
438 }
439 $out;
440}
441
5efba0c6
TC
442=item _eq
443
444Implement the overloaded equality operator.
445
446Provided for older perls that don't handle magic auto generation of eq
447from "".
448
449=cut
450
451sub _eq {
452 my ($left, $right) = @_;
453
454 return $left . "" eq $right . "";
455}
456
faa9b3e7
TC
457=back
458
459The following functions are shortcuts to the various constructors.
460
461These are not methods.
462
463You can import these methods with:
464
465 use Imager::Matrix2d ':handy';
466
467=over
468
469=item m2d_identity
470
471=item m2d_rotate()
472
473=item m2d_translate()
474
475=item m2d_shear()
476
477=item m2d_reflect()
478
8688bedd
TC
479=item m2d_scale()
480
faa9b3e7
TC
481=back
482
483=cut
484
485sub m2d_identity {
486 return __PACKAGE__->identity;
487}
488
489sub m2d_rotate {
490 return __PACKAGE__->rotate(@_);
491}
492
493sub m2d_translate {
494 return __PACKAGE__->translate(@_);
495}
496
497sub m2d_shear {
498 return __PACKAGE__->shear(@_);
499}
500
501sub m2d_reflect {
502 return __PACKAGE__->reflect(@_);
503}
504
505sub m2d_scale {
506 return __PACKAGE__->scale(@_);
507}
508
5091;
510
511=head1 AUTHOR
512
513Tony Cook <tony@develop-help.com>
514
515=head1 BUGS
516
5715f7c3 517Needs a way to invert a matrix.
faa9b3e7
TC
518
519=head1 SEE ALSO
520
521Imager(3), Imager::Font(3)
522
8f22b8d8 523http://imager.perl.org/
faa9b3e7
TC
524
525=cut