Current Path : /usr/local/lib/perl5/site_perl/5.8.9/mach/GD/ |
FreeBSD hs32.drive.ne.jp 9.1-RELEASE FreeBSD 9.1-RELEASE #1: Wed Jan 14 12:18:08 JST 2015 root@hs32.drive.ne.jp:/sys/amd64/compile/hs32 amd64 |
Current File : //usr/local/lib/perl5/site_perl/5.8.9/mach/GD/Polygon.pm |
package GD::Polygon; use strict; use Carp 'carp'; use GD; # old documentation error *GD::Polygon::delete = \&deletePt; =head1 NAME GD::Polygon - Polygon class for the GD image library =head1 SYNOPSIS See L<GD> =head1 DESCRIPTION See L<GD> =head1 AUTHOR The GD.pm interface is copyright 1995-2005, Lincoln D. Stein. It is distributed under the same terms as Perl itself. See the "Artistic License" in the Perl source code distribution for licensing terms. The latest versions of GD.pm are available on CPAN: http://www.cpan.org =head1 SEE ALSO L<GD> L<GD::Polyline>, L<GD::SVG>, L<GD::Simple>, L<Image::Magick> =cut ### The polygon object ### # create a new polygon sub new { my $class = shift; return bless { 'length'=>0,'points'=>[] },$class; } # automatic destruction of the polygon sub DESTROY { my $self = shift; undef $self->{'points'}; } sub clear { my $self = shift; $self->{'points'} = []; } # add an x,y vertex to the polygon sub addPt { my($self,$x,$y) = @_; push(@{$self->{'points'}},[$x,$y]); $self->{'length'}++; } # get a vertex sub getPt { my($self,$index) = @_; return () unless ($index>=0) && ($index<$self->{'length'}); return @{$self->{'points'}->[$index]}; } # change the value of a vertex sub setPt { my($self,$index,$x,$y) = @_; unless (($index>=0) && ($index<$self->{'length'})) { carp "Attempt to set an undefined polygon vertex"; return undef; } @{$self->{'points'}->[$index]} = ($x,$y); 1; } # return the total number of vertices sub length { my $self = shift; return $self->{'length'}; } # return the array of vertices. # each vertex is an two-member (x,y) array sub vertices { my $self = shift; return @{$self->{'points'}}; } # return the bounding box of the polygon # (smallest rectangle that contains it) sub bounds { my $self = shift; my($top,$bottom,$left,$right) = @_; $top = 99999999; $bottom =-99999999; $left = 99999999; $right = -99999999; my $v; foreach $v ($self->vertices) { $left = $v->[0] if $left > $v->[0]; $right = $v->[0] if $right < $v->[0]; $top = $v->[1] if $top > $v->[1]; $bottom = $v->[1] if $bottom < $v->[1]; } return ($left,$top,$right,$bottom); } # delete a vertex, returning it, just for fun sub deletePt { my($self,$index) = @_; unless (($index>=0) && ($index<@{$self->{'points'}})) { carp "Attempt to delete an undefined polygon vertex"; return undef; } my($vertex) = splice(@{$self->{'points'}},$index,1); $self->{'length'}--; return @$vertex; } # translate the polygon in space by deltaX and deltaY sub offset { my($self,$dh,$dv) = @_; my $size = $self->length; my($i); for ($i=0;$i<$size;$i++) { my($x,$y)=$self->getPt($i); $self->setPt($i,$x+$dh,$y+$dv); } } # map the polygon from sourceRect to destRect, # translating and resizing it if necessary sub map { my($self,$srcL,$srcT,$srcR,$srcB,$destL,$destT,$destR,$destB) = @_; my($factorV) = ($destB-$destT)/($srcB-$srcT); my($factorH) = ($destR-$destL)/($srcR-$srcL); my($vertices) = $self->length; my($i); for ($i=0;$i<$vertices;$i++) { my($x,$y) = $self->getPt($i); $x = int($destL + ($x - $srcL) * $factorH); $y = int($destT + ($y - $srcT) * $factorV); $self->setPt($i,$x,$y); } } # These routines added by Winfriend Koenig. sub toPt { my($self, $dx, $dy) = @_; unless ($self->length > 0) { $self->addPt($dx,$dy); return; } my ($x, $y) = $self->getPt($self->length-1); $self->addPt($x+$dx,$y+$dy); } sub transform($$$$$$$) { # see PostScript Ref. page 154 my($self, $a, $b, $c, $d, $tx, $ty) = @_; my $size = $self->length; for (my $i=0;$i<$size;$i++) { my($x,$y)=$self->getPt($i); $self->setPt($i, $a*$x+$c*$y+$tx, $b*$x+$d*$y+$ty); } } sub scale { my($self, $sx, $sy, $cx, $cy) = @_; $self->offset(-$cx,-$cy) if defined $cx or defined $cy; $self->transform($sx,0,0,$sy,$cx,$cy); } 1;