diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Imager/Matrix2d.pm')
| -rwxr-xr-x | Master/tlpkg/tlperl/lib/Imager/Matrix2d.pm | 409 |
1 files changed, 409 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Imager/Matrix2d.pm b/Master/tlpkg/tlperl/lib/Imager/Matrix2d.pm new file mode 100755 index 00000000000..a1000092ea4 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Imager/Matrix2d.pm @@ -0,0 +1,409 @@ +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) + +=item translate(x=>$dx) + +=item translate(y=>$dy) + +Translates by the specify amounts. + +=cut + +sub translate { + my ($class, %opts) = @_; + + if (defined $opts{'x'} || defined $opts{'y'}) { + my $x = $opts{'x'} || 0; + my $y = $opts{'y'} || 0; + return bless [ 1, 0, $x, + 0, 1, $y, + 0, 0, 1 ], $class; + } + + $Imager::ERRSTR = 'x or y parameter required'; + return undef; +} + +=item shear(x=>$sx, y=>$sy) + +=item shear(x=>$sx) + +=item shear(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 |