t/900-util/050-matrix.t

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