t/t16matrix.t

   1 #!perl -w
   2 use strict;
   3 use Test::More tests => 23;
   4 use Imager;
   5
   6 BEGIN { use_ok('Imager::Matrix2d', ':handy') }
   7
   8 my $id = Imager::Matrix2d->identity;
   9
  10 ok(almost_equal($id, [ 1, 0, 0,
  11                        0, 1, 0,
  12                        0, 0, 1 ]), "identity matrix");
  13 my $trans = Imager::Matrix2d->translate('x'=>10, 'y'=>-11);
  14 ok(almost_equal($trans, [ 1, 0, 10,
  15                           0, 1, -11,
  16                           0, 0, 1 ]), "translate matrix");
  17 my $trans_x = Imager::Matrix2d->translate(x => 10);
  18 ok(almost_equal($trans_x, [ 1, 0, 10,
  19                            0, 1, 0,
  20                            0, 0, 1 ]), "translate just x");
  21 my $trans_y = Imager::Matrix2d->translate('y' => 11);
  22 ok(almost_equal($trans_y, [ 1, 0, 0,
  23                            0, 1, 11,
  24                            0, 0, 1 ]), "translate just y");
  25
  26 my $rotate = Imager::Matrix2d->rotate(degrees=>90);
  27 ok(almost_equal($rotate, [ 0, -1, 0,
  28                            1, 0,  0,
  29                            0, 0,  1 ]), "rotate matrix");
  30
  31 my $shear = Imager::Matrix2d->shear('x'=>0.2, 'y'=>0.3);
  32 ok(almost_equal($shear, [ 1,   0.2, 0,
  33                           0.3, 1,   0,
  34                           0,   0,   1 ]), "shear matrix");
  35
  36 my $scale = Imager::Matrix2d->scale('x'=>1.2, 'y'=>0.8);
  37 ok(almost_equal($scale, [ 1.2, 0,   0,
  38                           0,   0.8, 0,
  39                           0,   0,   1 ]), "scale matrix");
  40
  41 my $custom = Imager::Matrix2d->matrix(1, 0, 0, 0, 1, 0, 0, 0, 1);
  42 ok(almost_equal($custom, [ 1, 0, 0,
  43                        0, 1, 0,
  44                        0, 0, 1 ]), "custom matrix");
  45
  46 my $trans_called;
  47 $rotate = Imager::Matrix2d::Test->rotate(degrees=>90, x=>50);
  48 ok($trans_called, "translate called on rotate with just x");
  49
  50 $trans_called = 0;
  51 $rotate = Imager::Matrix2d::Test->rotate(degrees=>90, 'y'=>50);
  52 ok($trans_called, "translate called on rotate with just y");
  53
  54 ok(!Imager::Matrix2d->matrix(), "bad custom matrix");
  55 is(Imager->errstr, "9 co-efficients required", "check error");
  56
  57 {
  58   my @half = ( 0.5, 0, 0,
  59                0, 0.5, 0,
  60                0, 0, 1 );
  61   my @quart = ( 0, 0.25, 0,
  62                 1, 0, 0,
  63                 0, 0, 1 );
  64   my $half_matrix = Imager::Matrix2d->matrix(@half);
  65   my $quart_matrix = Imager::Matrix2d->matrix(@quart);
  66   my $result = $half_matrix * $quart_matrix;
  67   is_deeply($half_matrix * \@quart, $result, "mult by unblessed matrix");
  68   is_deeply(\@half * $quart_matrix, $result, "mult with unblessed matrix");
  69
  70   my $half_three = Imager::Matrix2d->matrix(1.5, 0, 0, 0, 1.5, 0, 0, 0, 3);
  71   is_deeply($half_matrix * 3, $half_three, "mult by three");
  72   is_deeply(3 * $half_matrix, $half_three, "mult with three");
  73
  74   {
  75     # check error handling - bad ref type
  76     my $died =
  77       !eval {
  78       my $foo = $half_matrix * +{};
  79       1;
  80     };
  81     ok($died, "mult by hash ref died");
  82     like($@, qr/multiply by array ref or number/, "check message");
  83   }
  84
  85   {
  86     # check error handling - bad array
  87     $@ = '';
  88     my $died =
  89       !eval {
  90       my $foo = $half_matrix * [ 1 .. 8 ];
  91       1;
  92     };
  93     ok($died, "mult by short array ref died");
  94     like($@, qr/9 elements required in array ref/, "check message");
  95   }
  96
  97   {
  98     # check error handling - bad value
  99     $@ = '';
 100     my $died =
 101       !eval {
 102       my $foo = $half_matrix * "abc";
 103       1;
 104     };
 105     ok($died, "mult by bad scalar died");
 106     like($@, qr/multiply by array ref or number/, "check message");
 107   }
 108
 109 }
 110
 111
 112 sub almost_equal {
 113   my ($m1, $m2) = @_;
 114
 115   for my $i (0..8) {
 116     abs($m1->[$i] - $m2->[$i]) < 0.00001 or return undef;
 117   }
 118   return 1;
 119 }
 120
 121 # this is used to ensure translate() is called correctly by rotate
 122 package Imager::Matrix2d::Test;
 123 use vars qw(@ISA);
 124 BEGIN { @ISA = qw(Imager::Matrix2d); }
 125
 126 sub translate {
 127   my ($class, %opts) = @_;
 128
 129   ++$trans_called;
 130   return $class->SUPER::translate(%opts);
 131 }
 132