[Bio] / Sprout / Rectangle.pm Repository:
ViewVC logotype

Annotation of /Sprout/Rectangle.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download) (as text)

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     #
4 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
5 :     # for Interpretations of Genomes. All Rights Reserved.
6 :     #
7 :     # This file is part of the SEED Toolkit.
8 :     #
9 :     # The SEED Toolkit is free software. You can redistribute
10 :     # it and/or modify it under the terms of the SEED Toolkit
11 :     # Public License.
12 :     #
13 :     # You should have received a copy of the SEED Toolkit Public License
14 :     # along with this program; if not write to the University of Chicago
15 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
16 :     # Genomes at veronika@thefig.info or download a copy from
17 :     # http://www.theseed.org/LICENSE.TXT.
18 :     #
19 :    
20 :     package Rectangle;
21 :    
22 :     use strict;
23 :     use Tracer;
24 :    
25 :    
26 :     =head1 Rectangular Region Object
27 :    
28 :     =head2 Introduction
29 :    
30 :     This is a simple object that represents rectangular coordinates on a graphical
31 :     canvas.
32 :    
33 :     The fields in this object are as follows.
34 :    
35 :     =over 4
36 :    
37 :     =item left
38 :    
39 :     Leftmost coordinate.
40 :    
41 :     =item right
42 :    
43 :     Rightmost coordinate.
44 :    
45 :     =item top
46 :    
47 :     Top coordinate.
48 :    
49 :     =item bottom
50 :    
51 :     Bottom coordinate.
52 :    
53 :     =back
54 :    
55 :     =cut
56 :    
57 :     =head3 new
58 :    
59 :     my $rect = Rectangle->new($left, $right, $top, %bottom);
60 :    
61 :     Construct a new Rectangle object. The parameters are as follows.
62 :    
63 :     =over 4
64 :    
65 :     =item left
66 :    
67 :     Leftmost coordinate.
68 :    
69 :     =item top
70 :    
71 :     Top coordinate.
72 :    
73 :     =item right
74 :    
75 :     Rightmost coordinate.
76 :    
77 :     =item bottom
78 :    
79 :     Bottom coordinate.
80 :    
81 :     =back
82 :    
83 :     =cut
84 :    
85 :     sub new {
86 :     # Get the parameters.
87 :     my ($class, $left, $top, $right, $bottom) = @_;
88 :     # Create the Rectangle object.
89 :     my $retVal = {
90 :     left => $left,
91 :     right => $right,
92 :     top => $top,
93 :     bottom => $bottom,
94 :     };
95 :     # Bless and return it.
96 :     bless $retVal, $class;
97 :     return $retVal;
98 :     }
99 :    
100 :     =head2 Public Methods
101 :    
102 :     =head3 left
103 :    
104 :     my $left = $rect->left($newValue);
105 :    
106 :     Set or return the left coordinate.
107 :    
108 :     =over 4
109 :    
110 :     =item newValue (optional)
111 :    
112 :     If specified, the new value for the left coordinate.
113 :    
114 :     =item RETURN
115 :    
116 :     Returns the current value of the left coordinate. (This is the new
117 :     value if a parameter was specified.)
118 :    
119 :     =back
120 :    
121 :     =cut
122 :    
123 :     sub left {
124 :     # Get the parameters.
125 :     my ($self, $newValue) = @_;
126 :     # Set the new value if specified.
127 :     if (defined $newValue) {
128 :     $self->{left} = $newValue;
129 :     }
130 :     # Return the result.
131 :     return $self->{left};
132 :     }
133 :    
134 :     =head3 right
135 :    
136 :     my $right = $rect->right($newValue);
137 :    
138 :     Set or return the right coordinate.
139 :    
140 :     =over 4
141 :    
142 :     =item newValue (optional)
143 :    
144 :     If specified, the new value for the right coordinate.
145 :    
146 :     =item RETURN
147 :    
148 :     Returns the current value of the right coordinate. (This is the new
149 :     value if a parameter was specified.)
150 :    
151 :     =back
152 :    
153 :     =cut
154 :    
155 :     sub right {
156 :     # Get the parameters.
157 :     my ($self, $newValue) = @_;
158 :     # Set the new value if specified.
159 :     if (defined $newValue) {
160 :     $self->{right} = $newValue;
161 :     }
162 :     # Return the result.
163 :     return $self->{right};
164 :     }
165 :    
166 :     =head3 top
167 :    
168 :     my $top = $rect->top($newValue);
169 :    
170 :     Set or return the top coordinate.
171 :    
172 :     =over 4
173 :    
174 :     =item newValue (optional)
175 :    
176 :     If specified, the new value for the top coordinate.
177 :    
178 :     =item RETURN
179 :    
180 :     Returns the current value of the top coordinate. (This is the new
181 :     value if a parameter was specified.)
182 :    
183 :     =back
184 :    
185 :     =cut
186 :    
187 :     sub top {
188 :     # Get the parameters.
189 :     my ($self, $newValue) = @_;
190 :     # Set the new value if specified.
191 :     if (defined $newValue) {
192 :     $self->{top} = $newValue;
193 :     }
194 :     # Return the result.
195 :     return $self->{top};
196 :     }
197 :    
198 :     =head3 bottom
199 :    
200 :     my $bottom = $rect->bottom($newValue);
201 :    
202 :     Set or return the bottom coordinate.
203 :    
204 :     =over 4
205 :    
206 :     =item newValue (optional)
207 :    
208 :     If specified, the new value for the bottom coordinate.
209 :    
210 :     =item RETURN
211 :    
212 :     Returns the current value of the bottom coordinate. (This is the new
213 :     value if a parameter was specified.)
214 :    
215 :     =back
216 :    
217 :     =cut
218 :    
219 :     sub bottom {
220 :     # Get the parameters.
221 :     my ($self, $newValue) = @_;
222 :     # Set the new value if specified.
223 :     if (defined $newValue) {
224 :     $self->{bottom} = $newValue;
225 :     }
226 :     # Return the result.
227 :     return $self->{bottom};
228 :     }
229 :    
230 :     =head3 All
231 :    
232 :     my ($left, $top, $right, $bottom) = $rect->All();
233 :    
234 :     Return all four coordinates.
235 :    
236 :     =cut
237 :    
238 :     sub All {
239 :     # Get the parameters.
240 :     my ($self) = @_;
241 :     # Return the results.
242 :     return ($self->{left}, $self->{top}, $self->{right},
243 :     $self->{bottom});
244 :     }
245 :    
246 :     =head3 width
247 :    
248 :     my $width = $rect->width($newValue);
249 :    
250 :     Set or return the width of the rectangle.
251 :    
252 :     =over 4
253 :    
254 :     =item newValue (optional)
255 :    
256 :     Proposed new width.
257 :    
258 :     =item RETURN
259 :    
260 :     Returns the width of the rectangular region.
261 :    
262 :     =back
263 :    
264 :     =cut
265 :    
266 :     sub width {
267 :     # Get the parameters.
268 :     my ($self, $newValue) = @_;
269 :     # If a new value is specified, update the right edge.
270 :     if (defined $newValue) {
271 :     $self->{right} = $self->{left} + $newValue;
272 :     }
273 :     # Return the value.
274 :     return $self->{right} - $self->{left};
275 :     }
276 :    
277 :     =head3 height
278 :    
279 :     my $height = $rect->height($newValue);
280 :    
281 :     Set or return the height of the rectangle.
282 :    
283 :     =over 4
284 :    
285 :     =item newValue (optional)
286 :    
287 :     Proposed new height.
288 :    
289 :     =item RETURN
290 :    
291 :     Returns the height of the rectangular region.
292 :    
293 :     =back
294 :    
295 :     =cut
296 :    
297 :     sub height {
298 :     # Get the parameters.
299 :     my ($self, $newValue) = @_;
300 :     # If a new value is specified, update the right edge.
301 :     if (defined $newValue) {
302 :     $self->{bottom} = $self->{top} + $newValue;
303 :     }
304 :     # Return the value.
305 :     return $self->{bottom} - $self->{top};
306 :     }
307 :    
308 :    
309 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3