eliminate use vars
[imager.git] / lib / Imager / Matrix2d.pm
1 package Imager::Matrix2d;
2 use 5.006;
3 use strict;
4 use Scalar::Util qw(reftype looks_like_number);
5 use Carp qw(croak);
6
7 our $VERSION = "1.013";
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);
22   $m8 = Imager::Matric2d->matrix($v11, $v12, $v13,
23                                  $v21, $v22, $v23,
24                                  $v31, $v32, $v33);
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
33 This class provides a simple wrapper around a reference to an array of
34 9 coefficients, treated as a matrix:
35
36  [ 0, 1, 2,
37    3, 4, 5,
38    6, 7, 8 ]
39
40 Most of the methods in this class are constructors.  The others are
41 overloaded operators.
42
43 Note that since Imager represents images with y increasing from top to
44 bottom, rotation angles are clockwise, rather than counter-clockwise.
45
46 =over
47
48 =cut
49
50 our @ISA = 'Exporter';
51 require Exporter;
52 our @EXPORT_OK = qw(m2d_rotate m2d_identity m2d_translate m2d_shear 
53                 m2d_reflect m2d_scale);
54 our %EXPORT_TAGS =
55   (
56    handy=> [ qw(m2d_rotate m2d_identity m2d_translate m2d_shear 
57                 m2d_reflect m2d_scale) ],
58   );
59
60 use overload 
61   '*' => \&_mult,
62   '+' => \&_add,
63   '""'=>\&_string,
64   "eq" => \&_eq;
65
66 =item identity()
67
68 Returns the identity matrix.
69
70 =cut
71
72 sub 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
82 Creates 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
87 sub 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
102   if ($opts{'x'} || $opts{'y'}) {
103     $opts{'x'} ||= 0;
104     $opts{'y'} ||= 0;
105     return $class->translate('x'=>$opts{'x'}, 'y'=>$opts{'y'})
106       * $class->rotate(radians=>$angle)
107         * $class->translate('x'=>-$opts{'x'}, 'y'=>-$opts{'y'});
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
120 =item translate(x=>$dx)
121
122 =item translate(y=>$dy)
123
124 Translates by the specify amounts.
125
126 =cut
127
128 sub translate {
129   my ($class, %opts) = @_;
130
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,
136                    0, 0, 1 ], $class;
137   }
138
139   $Imager::ERRSTR = 'x or y parameter required';
140   return undef;
141 }
142
143 =item shear(x=>$sx, y=>$sy)
144
145 =item shear(x=>$sx)
146
147 =item shear(y=>$sy)
148
149 Shear by the given amounts.
150
151 =cut
152 sub shear {
153   my ($class, %opts) = @_;
154
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;
159   }
160   $Imager::ERRSTR = 'x and y parameters required';
161   return undef;
162 }
163
164 =item reflect(axis=>$axis)
165
166 Reflect around the given axis, either 'x' or 'y'.
167
168 =item reflect(radians=>$angle)
169
170 =item reflect(degrees=>$angle)
171
172 Reflect around a line drawn at the given angle from the origin.
173
174 =cut
175
176 sub 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
213 Scales at the given ratios.
214
215 You can also specify a center for the scaling with the C<cx> and C<cy>
216 parameters.
217
218 =cut
219
220 sub scale {
221   my ($class, %opts) = @_;
222
223   if (defined $opts{'x'} || defined $opts{'y'}) {
224     $opts{'x'} = 1 unless defined $opts{'x'};
225     $opts{'y'} = 1 unless defined $opts{'y'};
226     if ($opts{cx} || $opts{cy}) {
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});
230     }
231     else {
232       return bless [ $opts{'x'}, 0,          0,
233                      0,          $opts{'y'}, 0,
234                      0,          0,          1 ], $class;
235     }
236   }
237   else {
238     $Imager::ERRSTR = 'x or y parameter required';
239     return undef;
240   }
241 }
242
243 =item matrix($v11, $v12, $v13, $v21, $v22, $v23, $v31, $v32, $v33)
244
245 Create a matrix with custom coefficients.
246
247 =cut
248
249 sub matrix {
250   my ($class, @self) = @_;
251
252   if (@self == 9) {
253     return bless \@self, $class;
254   }
255   else {
256     $Imager::ERRSTR = "9 coefficients required";
257     return;
258   }
259 }
260
261 =item transform($x, $y)
262
263 Transform a point the same way matrix_transform does.
264
265 =cut
266
267 sub 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
285 Compose several matrices together for use in transformation.
286
287 For example, for three matrices:
288
289   my $out = Imager::Matrix2d->compose($m1, $m2, $m3);
290
291 is equivalent to:
292
293   my $out = $m3 * $m2 * $m1;
294
295 Returns the identity matrix if no parameters are supplied.
296
297 May return the supplied matrix if only one matrix is supplied.
298
299 =cut
300
301 sub 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
315 =item _mult()
316
317 Implements the overloaded '*' operator.  Internal use.
318
319 Currently both the left and right-hand sides of the operator must be
320 an Imager::Matrix2d.
321
322 When composing a matrix for transformation you should multiply the
323 matrices 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
329 or use the compose method:
330
331   my $shear_then_rotate = Imager::Matrix2d->compose($shear, $rotate);
332
333 =cut
334
335 sub _mult {
336   my ($left, $right, $order) = @_;
337
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);
344       }
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__;
356     }
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
364     return bless \@result, __PACKAGE__;
365   }
366   else {
367     # something we don't handle
368     croak "multiply by array ref or number";
369   }
370 }
371
372 =item _add()
373
374 Implements the overloaded binary '+' operator.
375
376 Currently both the left and right sides of the operator must be
377 Imager::Matrix2d objects.
378
379 =cut
380 sub _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
398 Implements the overloaded stringification operator.
399
400 This returns a string containing 3 lines of text with no terminating
401 newline.
402
403 I tried to make it fairly nicely formatted.  You might disagree :)
404
405 =cut
406
407 sub _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
442 =item _eq
443
444 Implement the overloaded equality operator.
445
446 Provided for older perls that don't handle magic auto generation of eq
447 from "".
448
449 =cut
450
451 sub _eq {
452   my ($left, $right) = @_;
453
454   return $left . "" eq $right . "";
455 }
456
457 =back
458
459 The following functions are shortcuts to the various constructors.
460
461 These are not methods.
462
463 You 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
479 =item m2d_scale()
480
481 =back
482
483 =cut
484
485 sub m2d_identity {
486   return __PACKAGE__->identity;
487 }
488
489 sub m2d_rotate {
490   return __PACKAGE__->rotate(@_);
491 }
492
493 sub m2d_translate {
494   return __PACKAGE__->translate(@_);
495 }
496
497 sub m2d_shear {
498   return __PACKAGE__->shear(@_);
499 }
500
501 sub m2d_reflect {
502   return __PACKAGE__->reflect(@_);
503 }
504
505 sub m2d_scale {
506   return __PACKAGE__->scale(@_);
507 }
508
509 1;
510
511 =head1 AUTHOR
512
513 Tony Cook <tony@develop-help.com>
514
515 =head1 BUGS
516
517 Needs a way to invert a matrix.
518
519 =head1 SEE ALSO
520
521 Imager(3), Imager::Font(3)
522
523 http://imager.perl.org/
524
525 =cut