0
|
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;
|