package Imager::Matrix2d;
use strict;
use vars qw($VERSION);

$VERSION = "1.008";

=head1 NAME

  Imager::Matrix2d - simple wrapper for matrix construction

=head1 SYNOPSIS

  use Imager::Matrix2d;
  $m1 = Imager::Matrix2d->identity;
  $m2 = Imager::Matrix2d->rotate(radians=>$angle, x=>$cx, y=>$cy);
  $m3 = Imager::Matrix2d->translate(x=>$dx, y=>$dy);
  $m4 = Imager::Matrix2d->shear(x=>$sx, y=>$sy);
  $m5 = Imager::Matrix2d->reflect(axis=>$axis);
  $m6 = Imager::Matrix2d->scale(x=>$xratio, y=>$yratio);
  $m6 = $m1 * $m2;
  $m7 = $m1 + $m2;
  use Imager::Matrix2d qw(:handy);
  # various m2d_* functions imported 
  # where m2d_(.*) calls Imager::Matrix2d->$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=> [ qw(m2d_rotate m2d_identity m2d_translate m2d_shear 
                m2d_reflect m2d_scale) ],
  );

use overload 
  '*' => \&_mult,
  '+' => \&_add,
  '""'=>\&_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=>$angle)

=item rotate(degrees=>$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->translate('x'=>-$opts{'x'}, 'y'=>-$opts{'y'})
      * $class->rotate(radians=>$angle)
        * $class->translate('x'=>$opts{'x'}, 'y'=>$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=>$dx, y=>$dy)

Translates by the specify amounts.

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

  if (defined $opts{'x'} && 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=>$sx, y=>$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=>$axis)

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

=item reflect(radians=>$angle)

=item reflect(degrees=>$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->identity;
    if ($opts{axis} eq "y") {
      $result->[0] = -$result->[0];
    }
    elsif ($opts{axis} eq "x") {
      $result->[4] = -$result->[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->rotate(radians=>-$angle) * $class->reflect(axis=>'x') 
    * $class->rotate(radians=>$angle);
}

=item scale(x=>$xratio, y=>$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->translate('x'=>-$opts{cx}, 'y'=>-$opts{cy})
        * $class->scale('x'=>$opts{'x'}, 'y'=>$opts{'y'})
          * $class->translate('x'=>$opts{cx}, 'y'=>$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) && 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->[3*$i + $k] * $right->[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) && UNIVERSAL::isa($right, __PACKAGE__)) {
    my @result;
    for (0..8) {
      push @result, $left->[$_] + $right->[$_];
    }
    
    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() > $maxlen) {
      $maxlen = length;
    }
  }
  $maxlen <= 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->[$i*3+$j];
      if (length $val > 9) {
        $val = sprintf("%9f", $val);
        if ($val =~ /\./ && $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()

=item m2d_scale()

=back

=cut

sub m2d_identity {
  return __PACKAGE__->identity;
}

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

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

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

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

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

1;

=head1 AUTHOR

Tony Cook <tony@develop-help.com>

=head1 BUGS

Needs a way to invert matrixes.

=head1 SEE ALSO

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

http://imager.perl.org/

=cut