lib/Imager/Matrix2d.pm

   1 package Imager::Matrix2d;
   2 use strict;
   3 use vars qw($VERSION);
   4 use Scalar::Util qw(reftype looks_like_number);
   5 use Carp qw(croak);
   6
   7 $VERSION = "1.009";
   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 co-efficients, 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 use vars qw(@EXPORT_OK %EXPORT_TAGS @ISA);
  51 @ISA = 'Exporter';
  52 require '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
  61 use overload
  62   '*' => \&_mult,
  63   '+' => \&_add,
  64   '""'=>\&_string;
  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 co-efficients.
 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 co-efficients required";
 257     return;
 258   }
 259 }
 260
 261 =item _mult()
 262
 263 Implements the overloaded '*' operator.  Internal use.
 264
 265 Currently both the left and right-hand sides of the operator must be
 266 an Imager::Matrix2d.
 267
 268 =cut
 269
 270 sub _mult {
 271   my ($left, $right, $order) = @_;
 272
 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);
 279       }
 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__;
 291     }
 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
 299     return bless \@result, __PACKAGE__;
 300   }
 301   else {
 302     # something we don't handle
 303     croak "multiply by array ref or number";
 304   }
 305 }
 306
 307 =item _add()
 308
 309 Implements the overloaded binary '+' operator.
 310
 311 Currently both the left and right sides of the operator must be
 312 Imager::Matrix2d objects.
 313
 314 =cut
 315 sub _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
 333 Implements the overloaded stringification operator.
 334
 335 This returns a string containing 3 lines of text with no terminating
 336 newline.
 337
 338 I tried to make it fairly nicely formatted.  You might disagree :)
 339
 340 =cut
 341
 342 sub _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
 379 The following functions are shortcuts to the various constructors.
 380
 381 These are not methods.
 382
 383 You 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
 399 =item m2d_scale()
 400
 401 =back
 402
 403 =cut
 404
 405 sub m2d_identity {
 406   return __PACKAGE__->identity;
 407 }
 408
 409 sub m2d_rotate {
 410   return __PACKAGE__->rotate(@_);
 411 }
 412
 413 sub m2d_translate {
 414   return __PACKAGE__->translate(@_);
 415 }
 416
 417 sub m2d_shear {
 418   return __PACKAGE__->shear(@_);
 419 }
 420
 421 sub m2d_reflect {
 422   return __PACKAGE__->reflect(@_);
 423 }
 424
 425 sub m2d_scale {
 426   return __PACKAGE__->scale(@_);
 427 }
 428
 429 1;
 430
 431 =head1 AUTHOR
 432
 433 Tony Cook <tony@develop-help.com>
 434
 435 =head1 BUGS
 436
 437 Needs a way to invert a matrix.
 438
 439 =head1 SEE ALSO
 440
 441 Imager(3), Imager::Font(3)
 442
 443 http://imager.perl.org/
 444
 445 =cut