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