Mercurial > repos > dereeper > sniploid

comparison GD/Polygon.pm @ 0:58111b3965b2 draft default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Uploaded
author dereeper
date Thu, 01 Nov 2012 09:35:05 -0400
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:58111b3965b2
1 package GD::Polygon;
2
3 use strict;
4 use Carp 'carp';
5 use GD;
6
7 # old documentation error
8 *GD::Polygon::delete = \&deletePt;
9
10 =head1 NAME
11
12 GD::Polygon - Polygon class for the GD image library
13
14 =head1 SYNOPSIS
15
16 See L<GD>
17
18 =head1 DESCRIPTION
19
20 See L<GD>
21
22 =head1 AUTHOR
23
24 The GD.pm interface is copyright 1995-2005, Lincoln D. Stein. It is
25 distributed under the same terms as Perl itself. See the "Artistic
26 License" in the Perl source code distribution for licensing terms.
27
28 The latest versions of GD.pm are available on CPAN:
29
30 http://www.cpan.org
31
32 =head1 SEE ALSO
33
34 L<GD>
35 L<GD::Polyline>,
36 L<GD::SVG>,
37 L<GD::Simple>,
38 L<Image::Magick>
39
40 =cut
41
42 ### The polygon object ###
43 # create a new polygon
44 sub new {
45 my $class = shift;
46 return bless { 'length'=>0,'points'=>[] },$class;
47 }
48
49 # automatic destruction of the polygon
50 sub DESTROY {
51 my $self = shift;
52 undef $self->{'points'};
53 }
54
55 sub clear {
56 my $self = shift;
57 $self->{'points'} = [];
58 }
59
60 # add an x,y vertex to the polygon
61 sub addPt {
62 my($self,$x,$y) = @_;
63 push(@{$self->{'points'}},[$x,$y]);
64 $self->{'length'}++;
65 }
66
67 # get a vertex
68 sub getPt {
69 my($self,$index) = @_;
70 return () unless ($index>=0) && ($index<$self->{'length'});
71 return @{$self->{'points'}->[$index]};
72 }
73
74 # change the value of a vertex
75 sub setPt {
76 my($self,$index,$x,$y) = @_;
77 unless (($index>=0) && ($index<$self->{'length'})) {
78 carp "Attempt to set an undefined polygon vertex";
79 return undef;
80 }
81 @{$self->{'points'}->[$index]} = ($x,$y);
82 1;
83 }
84
85 # return the total number of vertices
86 sub length {
87 my $self = shift;
88 return $self->{'length'};
89 }
90
91 # return the array of vertices.
92 # each vertex is an two-member (x,y) array
93 sub vertices {
94 my $self = shift;
95 return @{$self->{'points'}};
96 }
97
98 # return the bounding box of the polygon
99 # (smallest rectangle that contains it)
100 sub bounds {
101 my $self = shift;
102 my($top,$bottom,$left,$right) = @_;
103 $top = 99999999;
104 $bottom =-99999999;
105 $left = 99999999;
106 $right = -99999999;
107 my $v;
108 foreach $v ($self->vertices) {
109 $left = $v->[0] if $left > $v->[0];
110 $right = $v->[0] if $right < $v->[0];
111 $top = $v->[1] if $top > $v->[1];
112 $bottom = $v->[1] if $bottom < $v->[1];
113 }
114 return ($left,$top,$right,$bottom);
115 }
116
117 # delete a vertex, returning it, just for fun
118 sub deletePt {
119 my($self,$index) = @_;
120 unless (($index>=0) && ($index<@{$self->{'points'}})) {
121 carp "Attempt to delete an undefined polygon vertex";
122 return undef;
123 }
124 my($vertex) = splice(@{$self->{'points'}},$index,1);
125 $self->{'length'}--;
126 return @$vertex;
127 }
128
129 # translate the polygon in space by deltaX and deltaY
130 sub offset {
131 my($self,$dh,$dv) = @_;
132 my $size = $self->length;
133 my($i);
134 for ($i=0;$i<$size;$i++) {
135 my($x,$y)=$self->getPt($i);
136 $self->setPt($i,$x+$dh,$y+$dv);
137 }
138 }
139
140 # map the polygon from sourceRect to destRect,
141 # translating and resizing it if necessary
142 sub map {
143 my($self,$srcL,$srcT,$srcR,$srcB,$destL,$destT,$destR,$destB) = @_;
144 my($factorV) = ($destB-$destT)/($srcB-$srcT);
145 my($factorH) = ($destR-$destL)/($srcR-$srcL);
146 my($vertices) = $self->length;
147 my($i);
148 for ($i=0;$i<$vertices;$i++) {
149 my($x,$y) = $self->getPt($i);
150 $x = int($destL + ($x - $srcL) * $factorH);
151 $y = int($destT + ($y - $srcT) * $factorV);
152 $self->setPt($i,$x,$y);
153 }
154 }
155
156 # These routines added by Winfriend Koenig.
157 sub toPt {
158 my($self, $dx, $dy) = @_;
159 unless ($self->length > 0) {
160 $self->addPt($dx,$dy);
161 return;
162 }
163 my ($x, $y) = $self->getPt($self->length-1);
164 $self->addPt($x+$dx,$y+$dy);
165 }
166
167 sub transform($$$$$$$) {
168 # see PostScript Ref. page 154
169 my($self, $a, $b, $c, $d, $tx, $ty) = @_;
170 my $size = $self->length;
171 for (my $i=0;$i<$size;$i++) {
172 my($x,$y)=$self->getPt($i);
173 $self->setPt($i, $a*$x+$c*$y+$tx, $b*$x+$d*$y+$ty);
174 }
175 }
176
177 sub scale {
178 my($self, $sx, $sy, $cx, $cy) = @_;
179 $self->offset(-$cx,-$cy) if defined $cx or defined $cy;
180 $self->transform($sx,0,0,$sy,$cx,$cy);
181 }
182
183 1;