t/t16matrix.t

   1 #!perl -w
   2 use strict;
   3 use lib 't';
   4 use Test::More tests => 8;
   5 use Imager;
   6
   7 BEGIN { use_ok('Imager::Matrix2d', ':handy') }
   8
   9 my $id = Imager::Matrix2d->identity;
  10
  11 ok(almost_equal($id, [ 1, 0, 0,
  12                        0, 1, 0,
  13                        0, 0, 1 ]), "identity matrix");
  14 my $trans = Imager::Matrix2d->translate('x'=>10, 'y'=>-11);
  15 ok(almost_equal($trans, [ 1, 0, 10,
  16                           0, 1, -11,
  17                           0, 0, 1 ]), "translate matrix");
  18
  19 my $rotate = Imager::Matrix2d->rotate(degrees=>90);
  20 ok(almost_equal($rotate, [ 0, -1, 0,
  21                            1, 0,  0,
  22                            0, 0,  1 ]), "rotate matrix");
  23
  24 my $shear = Imager::Matrix2d->shear('x'=>0.2, 'y'=>0.3);
  25 ok(almost_equal($shear, [ 1,   0.2, 0,
  26                           0.3, 1,   0,
  27                           0,   0,   1 ]), "shear matrix");
  28
  29 my $scale = Imager::Matrix2d->scale('x'=>1.2, 'y'=>0.8);
  30 ok(almost_equal($scale, [ 1.2, 0,   0,
  31                           0,   0.8, 0,
  32                           0,   0,   1 ]), "scale matrix");
  33
  34 my $trans_called;
  35 $rotate = Imager::Matrix2d::Test->rotate(degrees=>90, x=>50);
  36 ok($trans_called, "translate called on rotate with just x");
  37
  38 $trans_called = 0;
  39 $rotate = Imager::Matrix2d::Test->rotate(degrees=>90, 'y'=>50);
  40 ok($trans_called, "translate called on rotate with just y");
  41
  42 sub almost_equal {
  43   my ($m1, $m2) = @_;
  44
  45   for my $i (0..8) {
  46     abs($m1->[$i] - $m2->[$i]) < 0.00001 or return undef;
  47   }
  48   return 1;
  49 }
  50
  51 # this is used to ensure translate() is called correctly by rotate
  52 package Imager::Matrix2d::Test;
  53 use vars qw(@ISA);
  54 BEGIN { @ISA = qw(Imager::Matrix2d); }
  55
  56 sub translate {
  57   my ($class, %opts) = @_;
  58
  59   ++$trans_called;
  60   return $class->SUPER::translate(%opts);
  61 }