<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Imager::Matrix2d;
use strict;
use vars qw($VERSION);

$VERSION = sprintf "%d.%03d", q$Revision$=~/\d+/g;

=head1 NAME

  Imager::Matrix2d - simple wrapper for matrix construction

=head1 SYNOPSIS

  use Imager::Matrix2d;
  $m1 = Imager::Matrix2d-&gt;identity;
  $m2 = Imager::Matrix2d-&gt;rotate(radians=&gt;$angle, x=&gt;$cx, y=&gt;$cy);
  $m3 = Imager::Matrix2d-&gt;translate(x=&gt;$dx, y=&gt;$dy);
  $m4 = Imager::Matrix2d-&gt;shear(x=&gt;$sx, y=&gt;$sy);
  $m5 = Imager::Matrix2d-&gt;reflect(axis=&gt;$axis);
  $m6 = Imager::Matrix2d-&gt;scale(x=&gt;$xratio, y=&gt;$yratio);
  $m6 = $m1 * $m2;
  $m7 = $m1 + $m2;
  use Imager::Matrix2d qw(:handy);
  # various m2d_* functions imported 
  # where m2d_(.*) calls Imager::Matrix2d-&gt;$1()

=head1 DESCRIPTION

This class provides a simple wrapper around a reference to an array of
9 co-efficients, treated as a matrix:

 [ 0, 1, 2,
   3, 4, 5,
   6, 7, 8 ]

Most of the methods in this class are constructors.  The others are
overloaded operators.

Note that since Imager represents images with y increasing from top to
bottom, rotation angles are clockwise, rather than counter-clockwise.

=over

=cut

use vars qw(@EXPORT_OK %EXPORT_TAGS @ISA);
@ISA = 'Exporter';
require 'Exporter.pm';
@EXPORT_OK = qw(m2d_rotate m2d_identity m2d_translate m2d_shear 
                m2d_reflect m2d_scale);
%EXPORT_TAGS =
  (
   handy=&gt; [ qw(m2d_rotate m2d_identity m2d_translate m2d_shear 
                m2d_reflect m2d_scale) ],
  );

use overload 
  '*' =&gt; \&amp;_mult,
  '+' =&gt; \&amp;_add,
  '""'=&gt;\&amp;_string;

=item identity()

Returns the identity matrix.

=cut

sub identity {
  return bless [ 1, 0, 0,
                 0, 1, 0,
                 0, 0, 1 ], $_[0];
}

=item rotate(radians=&gt;$angle)

=item rotate(degrees=&gt;$angle)

Creates a matrix that rotates around the origin, or around the point
(x,y) if the 'x' and 'y' parameters are provided.

=cut

sub rotate {
  my ($class, %opts) = @_;
  my $angle;

  if (defined $opts{radians}) {
    $angle = $opts{radians};
  }
  elsif (defined $opts{degrees}) {
    $angle = $opts{degrees} * 3.1415926535 / 180;
  }
  else {
    $Imager::ERRSTR = "degrees or radians parameter required";
    return undef;
  }

  if ($opts{'x'} || $opts{'y'}) {
    $opts{'x'} ||= 0;
    $opts{'y'} ||= 0;
    return $class-&gt;translate('x'=&gt;-$opts{'x'}, 'y'=&gt;-$opts{'y'})
      * $class-&gt;rotate(radians=&gt;$angle)
        * $class-&gt;translate('x'=&gt;$opts{'x'}, 'y'=&gt;$opts{'y'});
  }
  else {
    my $sin = sin($angle);
    my $cos = cos($angle);
    return bless [ $cos, -$sin, 0,
                   $sin,  $cos, 0,
                   0,     0,    1 ], $class;
  }
}

=item translate(x=&gt;$dx, y=&gt;$dy)

Translates by the specify amounts.

=cut
sub translate {
  my ($class, %opts) = @_;

  if (defined $opts{'x'} &amp;&amp; defined $opts{'y'}) {
    return bless [ 1, 0, $opts{'x'},
                   0, 1, $opts{'y'},
                   0, 0, 1 ], $class;
  }

  $Imager::ERRSTR = 'x and y parameters required';
  return undef;
}

=item shear(x=&gt;$sx, y=&gt;$sy)

Shear by the given amounts.

=cut
sub shear {
  my ($class, %opts) = @_;

  if (defined $opts{'x'} || defined $opts{'y'}) {
    return bless [ 1,             $opts{'x'}||0, 0,
                   $opts{'y'}||0, 1,             0,
                   0,             0,             1 ], $class;
  }
  $Imager::ERRSTR = 'x and y parameters required';
  return undef;
}

=item reflect(axis=&gt;$axis)

Reflect around the given axis, either 'x' or 'y'.

=item reflect(radians=&gt;$angle)

=item reflect(degrees=&gt;$angle)

Reflect around a line drawn at the given angle from the origin.

=cut

sub reflect {
  my ($class, %opts) = @_;
  
  if (defined $opts{axis}) {
    my $result = $class-&gt;identity;
    if ($opts{axis} eq "y") {
      $result-&gt;[0] = -$result-&gt;[0];
    }
    elsif ($opts{axis} eq "x") {
      $result-&gt;[4] = -$result-&gt;[4];
    }
    else {
      $Imager::ERRSTR = 'axis must be x or y';
      return undef;
    }

    return $result;
  }
  my $angle;
  if (defined $opts{radians}) {
    $angle = $opts{radians};
  }
  elsif (defined $opts{degrees}) {
    $angle = $opts{degrees} * 3.1415926535 / 180;
  }
  else {
    $Imager::ERRSTR = 'axis, degrees or radians parameter required';
    return undef;
  }

  # fun with matrices
  return $class-&gt;rotate(radians=&gt;-$angle) * $class-&gt;reflect(axis=&gt;'x') 
    * $class-&gt;rotate(radians=&gt;$angle);
}

=item scale(x=&gt;$xratio, y=&gt;$yratio)

Scales at the given ratios.

You can also specify a center for the scaling with the cx and cy
parameters.

=cut

sub scale {
  my ($class, %opts) = @_;

  if (defined $opts{'x'} || defined $opts{'y'}) {
    $opts{'x'} = 1 unless defined $opts{'x'};
    $opts{'y'} = 1 unless defined $opts{'y'};
    if ($opts{cx} || $opts{cy}) {
      return $class-&gt;translate('x'=&gt;-$opts{cx}, 'y'=&gt;-$opts{cy})
        * $class-&gt;scale('x'=&gt;$opts{'x'}, 'y'=&gt;$opts{'y'})
          * $class-&gt;translate('x'=&gt;$opts{cx}, 'y'=&gt;$opts{cy});
    }
    else {
      return bless [ $opts{'x'}, 0,          0,
                     0,          $opts{'y'}, 0,
                     0,          0,          1 ], $class;
    }
  }
  else {
    $Imager::ERRSTR = 'x or y parameter required';
    return undef;
  }
}

=item _mult()

Implements the overloaded '*' operator.  Internal use.

Currently both the left and right-hand sides of the operator must be
an Imager::Matrix2d.

=cut
sub _mult {
  my ($left, $right, $order) = @_;

  if (ref($right) &amp;&amp; UNIVERSAL::isa($right, __PACKAGE__)) {
    if ($order) {
      ($left, $right) = ($right, $left);
    }
    my @result;
    for my $i (0..2) {
      for my $j (0..2) {
        my $accum = 0;
        for my $k (0..2) {
          $accum += $left-&gt;[3*$i + $k] * $right-&gt;[3*$k + $j];
        }
        $result[3*$i+$j] = $accum;
      }
    }
    return bless \@result, __PACKAGE__;
  }
  else {
    # presumably N * matrix or matrix * N
    return undef; # for now
  }
}

=item _add()

Implements the overloaded binary '+' operator.

Currently both the left and right sides of the operator must be
Imager::Matrix2d objects.

=cut
sub _add {
  my ($left, $right, $order) = @_;

  if (ref($right) &amp;&amp; UNIVERSAL::isa($right, __PACKAGE__)) {
    my @result;
    for (0..8) {
      push @result, $left-&gt;[$_] + $right-&gt;[$_];
    }
    
    return bless \@result, __PACKAGE__;
  }
  else {
    return undef;
  }
}

=item _string()

Implements the overloaded stringification operator.

This returns a string containing 3 lines of text with no terminating
newline.

I tried to make it fairly nicely formatted.  You might disagree :)

=cut

sub _string {
  my ($m) = @_;

  my $maxlen = 0;
  for (@$m[0..8]) {
    if (length() &gt; $maxlen) {
      $maxlen = length;
    }
  }
  $maxlen &lt;= 9 or $maxlen = 9;

  my @left = ('[ ', '  ', '  ');
  my @right = ("\n", "\n", ']');
  my $out;
  my $width = $maxlen+2;
  for my $i (0..2) {
    $out .= $left[$i];
    for my $j (0..2) {
      my $val = $m-&gt;[$i*3+$j];
      if (length $val &gt; 9) {
        $val = sprintf("%9f", $val);
        if ($val =~ /\./ &amp;&amp; $val !~ /e/i) {
          $val =~ s/0+$//;
          $val =~ s/\.$//;
        }
        $val =~ s/^\s//;
      }
      $out .= sprintf("%-${width}s", "$val, ");
    }
    $out =~ s/ +\Z/ /;
    $out .= $right[$i];
  }
  $out;
}

=back

The following functions are shortcuts to the various constructors.

These are not methods.

You can import these methods with:

  use Imager::Matrix2d ':handy';

=over

=item m2d_identity

=item m2d_rotate()

=item m2d_translate()

=item m2d_shear()

=item m2d_reflect()

=back

=cut

sub m2d_identity {
  return __PACKAGE__-&gt;identity;
}

sub m2d_rotate {
  return __PACKAGE__-&gt;rotate(@_);
}

sub m2d_translate {
  return __PACKAGE__-&gt;translate(@_);
}

sub m2d_shear {
  return __PACKAGE__-&gt;shear(@_);
}

sub m2d_reflect {
  return __PACKAGE__-&gt;reflect(@_);
}

sub m2d_scale {
  return __PACKAGE__-&gt;scale(@_);
}

1;

=head1 AUTHOR

Tony Cook &lt;tony@develop-help.com&gt;

=head1 BUGS

Needs a way to invert matrixes.

=head1 SEE ALSO

Imager(3), Imager::Font(3)

http://imager.perl.org/

=cut
</pre></body></html>