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

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