lib/Imager/Matrix2d.pm

   1 package Imager::Matrix2d;
   2 use strict;
   3 use vars qw($VERSION);
   4
   5 $VERSION = sprintf "%d.%03d", q$Revision$=~/\d+/g;
   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 Translates by the specify amounts.
 116
 117 =cut
 118 sub translate {
 119   my ($class, %opts) = @_;
 120
 121   if (defined $opts{'x'} && defined $opts{'y'}) {
 122     return bless [ 1, 0, $opts{'x'},
 123                    0, 1, $opts{'y'},
 124                    0, 0, 1 ], $class;
 125   }
 126
 127   $Imager::ERRSTR = 'x and y parameters required';
 128   return undef;
 129 }
 130
 131 =item shear(x=>$sx, y=>$sy)
 132
 133 Shear by the given amounts.
 134
 135 =cut
 136 sub shear {
 137   my ($class, %opts) = @_;
 138
 139   if (defined $opts{'x'} || defined $opts{'y'}) {
 140     return bless [ 1,             $opts{'x'}||0, 0,
 141                    $opts{'y'}||0, 1,             0,
 142                    0,             0,             1 ], $class;
 143   }
 144   $Imager::ERRSTR = 'x and y parameters required';
 145   return undef;
 146 }
 147
 148 =item reflect(axis=>$axis)
 149
 150 Reflect around the given axis, either 'x' or 'y'.
 151
 152 =item reflect(radians=>$angle)
 153
 154 =item reflect(degrees=>$angle)
 155
 156 Reflect around a line drawn at the given angle from the origin.
 157
 158 =cut
 159
 160 sub reflect {
 161   my ($class, %opts) = @_;
 162
 163   if (defined $opts{axis}) {
 164     my $result = $class->identity;
 165     if ($opts{axis} eq "y") {
 166       $result->[0] = -$result->[0];
 167     }
 168     elsif ($opts{axis} eq "x") {
 169       $result->[4] = -$result->[4];
 170     }
 171     else {
 172       $Imager::ERRSTR = 'axis must be x or y';
 173       return undef;
 174     }
 175
 176     return $result;
 177   }
 178   my $angle;
 179   if (defined $opts{radians}) {
 180     $angle = $opts{radians};
 181   }
 182   elsif (defined $opts{degrees}) {
 183     $angle = $opts{degrees} * 3.1415926535 / 180;
 184   }
 185   else {
 186     $Imager::ERRSTR = 'axis, degrees or radians parameter required';
 187     return undef;
 188   }
 189
 190   # fun with matrices
 191   return $class->rotate(radians=>-$angle) * $class->reflect(axis=>'x')
 192     * $class->rotate(radians=>$angle);
 193 }
 194
 195 =item scale(x=>$xratio, y=>$yratio)
 196
 197 Scales at the given ratios.
 198
 199 You can also specify a center for the scaling with the cx and cy
 200 parameters.
 201
 202 =cut
 203
 204 sub scale {
 205   my ($class, %opts) = @_;
 206
 207   if (defined $opts{'x'} || defined $opts{'y'}) {
 208     $opts{'x'} = 1 unless defined $opts{'x'};
 209     $opts{'y'} = 1 unless defined $opts{'y'};
 210     if ($opts{cx} || $opts{cy}) {
 211       return $class->translate('x'=>-$opts{cx}, 'y'=>-$opts{cy})
 212         * $class->scale('x'=>$opts{'x'}, 'y'=>$opts{'y'})
 213           * $class->translate('x'=>$opts{cx}, 'y'=>$opts{cy});
 214     }
 215     else {
 216       return bless [ $opts{'x'}, 0,          0,
 217                      0,          $opts{'y'}, 0,
 218                      0,          0,          1 ], $class;
 219     }
 220   }
 221   else {
 222     $Imager::ERRSTR = 'x or y parameter required';
 223     return undef;
 224   }
 225 }
 226
 227 =item _mult()
 228
 229 Implements the overloaded '*' operator.  Internal use.
 230
 231 Currently both the left and right-hand sides of the operator must be
 232 an Imager::Matrix2d.
 233
 234 =cut
 235 sub _mult {
 236   my ($left, $right, $order) = @_;
 237
 238   if (ref($right) && UNIVERSAL::isa($right, __PACKAGE__)) {
 239     if ($order) {
 240       ($left, $right) = ($right, $left);
 241     }
 242     my @result;
 243     for my $i (0..2) {
 244       for my $j (0..2) {
 245         my $accum = 0;
 246         for my $k (0..2) {
 247           $accum += $left->[3*$i + $k] * $right->[3*$k + $j];
 248         }
 249         $result[3*$i+$j] = $accum;
 250       }
 251     }
 252     return bless \@result, __PACKAGE__;
 253   }
 254   else {
 255     # presumably N * matrix or matrix * N
 256     return undef; # for now
 257   }
 258 }
 259
 260 =item _add()
 261
 262 Implements the overloaded binary '+' operator.
 263
 264 Currently both the left and right sides of the operator must be
 265 Imager::Matrix2d objects.
 266
 267 =cut
 268 sub _add {
 269   my ($left, $right, $order) = @_;
 270
 271   if (ref($right) && UNIVERSAL::isa($right, __PACKAGE__)) {
 272     my @result;
 273     for (0..8) {
 274       push @result, $left->[$_] + $right->[$_];
 275     }
 276
 277     return bless \@result, __PACKAGE__;
 278   }
 279   else {
 280     return undef;
 281   }
 282 }
 283
 284 =item _string()
 285
 286 Implements the overloaded stringification operator.
 287
 288 This returns a string containing 3 lines of text with no terminating
 289 newline.
 290
 291 I tried to make it fairly nicely formatted.  You might disagree :)
 292
 293 =cut
 294 sub _string {
 295   my ($m) = @_;
 296
 297   my $maxlen = 0;
 298   for (@$m[0..8]) {
 299     if (length() > $maxlen) {
 300       $maxlen = length;
 301     }
 302   }
 303   $maxlen <= 9 or $maxlen = 9;
 304
 305   my @left = ('[ ', '  ', '  ');
 306   my @right = ("\n", "\n", ']');
 307   my $out;
 308   my $width = $maxlen+2;
 309   for my $i (0..2) {
 310     $out .= $left[$i];
 311     for my $j (0..2) {
 312       my $val = $m->[$i*3+$j];
 313       if (length $val > 9) {
 314         $val = sprintf("%9f", $val);
 315         if ($val =~ /\./ && $val !~ /e/i) {
 316           $val =~ s/0+$//;
 317           $val =~ s/\.$//;
 318         }
 319         $val =~ s/^\s//;
 320       }
 321       $out .= sprintf("%-${width}s", "$val, ");
 322     }
 323     $out =~ s/ +\Z/ /;
 324     $out .= $right[$i];
 325   }
 326   $out;
 327 }
 328
 329 =back
 330
 331 The following functions are shortcuts to the various constructors.
 332
 333 These are not methods.
 334
 335 You can import these methods with:
 336
 337   use Imager::Matrix2d ':handy';
 338
 339 =over
 340
 341 =item m2d_identity
 342
 343 =item m2d_rotate()
 344
 345 =item m2d_translate()
 346
 347 =item m2d_shear()
 348
 349 =item m2d_reflect()
 350
 351 =back
 352
 353 =cut
 354
 355 sub m2d_identity {
 356   return __PACKAGE__->identity;
 357 }
 358
 359 sub m2d_rotate {
 360   return __PACKAGE__->rotate(@_);
 361 }
 362
 363 sub m2d_translate {
 364   return __PACKAGE__->translate(@_);
 365 }
 366
 367 sub m2d_shear {
 368   return __PACKAGE__->shear(@_);
 369 }
 370
 371 sub m2d_reflect {
 372   return __PACKAGE__->reflect(@_);
 373 }
 374
 375 sub m2d_scale {
 376   return __PACKAGE__->scale(@_);
 377 }
 378
 379 1;
 380
 381 =head1 AUTHOR
 382
 383 Tony Cook <tony@develop-help.com>
 384
 385 =head1 BUGS
 386
 387 Needs a way to invert matrixes.
 388
 389 =head1 SEE ALSO
 390
 391 Imager(3), Imager::Font(3)
 392
 393 http://imager.perl.org/
 394
 395 =cut