lib/Imager/Matrix2d.pm

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