File Coverage

blib/lib/Graphics/Primitive/Path.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package Graphics::Primitive::Path;
2 1     1   15017 use Moose;
  0            
  0            
3             use MooseX::Storage;
4              
5             with 'MooseX::Clone';
6             with Storage (format => 'JSON', io => 'File');
7              
8             use Geometry::Primitive::Arc;
9             use Geometry::Primitive::Bezier;
10             use Geometry::Primitive::Ellipse;
11             use Geometry::Primitive::Line;
12             use Geometry::Primitive::Rectangle;
13              
14             has 'current_point' => (
15             is => 'rw',
16             isa => 'Geometry::Primitive::Point',
17             traits => [qw(Clone)],
18             default => sub { Geometry::Primitive::Point->new(x => 0, y => 0) },
19             clearer => 'clear_current_point'
20             );
21             has 'contiguous' => (
22             isa => 'Str',
23             is => 'rw',
24             default => sub { 0 },
25             );
26             has 'hints' => (
27             is => 'rw',
28             isa => 'ArrayRef[HashRef]',
29             traits => [qw(Array Clone)],
30             default => sub { [] },
31             handles => {
32             add_hint => 'push',
33             get_hint => 'get',
34             }
35             );
36             has 'primitives' => (
37             is => 'rw',
38             isa => 'ArrayRef',
39             traits => [qw(Array Clone)],
40             default => sub { [] },
41             handles => {
42             add_primitive => 'push',
43             clear_primitives => 'clear',
44             primitive_count => 'count',
45             get_primitive => 'get'
46             }
47             );
48              
49             after('add_primitive', sub {
50             my ($self, $prim) = @_;
51              
52             my %hint = (
53             contiguous => 0
54             );
55             my $new_end = $prim->point_end->clone;
56              
57             if($self->contiguous) {
58             # If we are contiguous we can pass that hint to the backend. The
59             # Cairo driver needs to know this to avoid creating a sub-path
60             $hint{contiguous} = 1;
61             } else {
62             # We weren't contiguous for this hint, but we WILL be if move_to
63             # isn't used. Set it now so we don't have to later.
64             $self->contiguous(1);
65             }
66             $self->add_hint(\%hint);
67              
68             $self->current_point($new_end);
69             });
70              
71             sub arc {
72             my ($self, $radius, $start, $end, $line_to) = @_;
73              
74             my $arc = Geometry::Primitive::Arc->new(
75             origin => $self->current_point->clone,
76             radius => $radius, angle_start => $start, angle_end => $end
77             );
78              
79             unless($line_to) {
80             $self->line_to($arc->point_start);
81             }
82              
83             $self->add_primitive($arc);
84             }
85              
86             sub ellipse {
87             my ($self, $width, $height, $line_to) = @_;
88              
89             my $ell = Geometry::Primitive::Ellipse->new(
90             origin => $self->current_point->clone,
91             width => $width, height => $height
92             );
93              
94             unless($line_to) {
95             $self->line_to($ell->point_start);
96             }
97              
98             $self->add_primitive($ell);
99             }
100              
101             sub close_path {
102             my ($self) = @_;
103              
104             $self->line_to($self->get_primitive(0)->point_start->clone);
105             }
106              
107             sub curve_to {
108             my ($self, $c1, $c2, $end) = @_;
109              
110             $self->add_primitive(Geometry::Primitive::Bezier->new(
111             start => $self->current_point->clone,
112             control1 => $c1,
113             control2 => $c2,
114             end => $end
115             ));
116             }
117              
118             sub line_to {
119             my ($self, $x, $y) = @_;
120              
121             my $point;
122             if(!ref($x) && defined($y)) {
123             # This allows the user to pass in $x and $y as scalars, which
124             # easier sometimes.
125             $point = Geometry::Primitive::Point->new(x => $x, y => $y);
126             } else {
127             $point = $x->clone;
128             }
129              
130             $self->add_primitive(Geometry::Primitive::Line->new(
131             start => $self->current_point->clone,
132             end => $point
133             ));
134             }
135              
136             sub move_to {
137             my ($self, $x, $y) = @_;
138              
139             my $point;
140             if(!ref($x) && defined($y)) {
141             # This allows the user to pass in $x and $y as scalars, which
142             # easier sometimes.
143             $point = Geometry::Primitive::Point->new(x => $x, y => $y);
144             } else {
145             $point = $x;
146             }
147              
148             # Move to effectively creates a new path, so we are no longer contiguous.
149             # This mainly serves as a backend hint.
150             $self->contiguous(0);
151             $self->current_point($point);
152             }
153              
154             sub rectangle {
155             my ($self, $width, $height) = @_;
156              
157             $self->add_primitive(Geometry::Primitive::Rectangle->new(
158             origin => $self->current_point,
159             width => $width,
160             height => $height
161             ));
162             }
163              
164             sub rel_curve_to {
165             my ($self, $x1, $y1, $x2, $y2, $x3, $y3) = @_;
166             my $curr = $self->current_point;
167             $self->curve_to(
168             Geometry::Primitive::Point->new(
169             x => $curr->x + $x1, y => $curr->y + $y1
170             ),
171             Geometry::Primitive::Point->new(
172             x => $curr->x + $x2, y => $curr->y + $y2
173             ),
174             Geometry::Primitive::Point->new(
175             x => $curr->x + $x3, y => $curr->y + $y3
176             )
177             );
178             }
179              
180             sub rel_line_to {
181             my ($self, $x, $y) = @_;
182              
183             # FIXME Relative hinting?
184             my $point = $self->current_point->clone;
185             $point->x($point->x + $x);
186             $point->y($point->y + $y);
187              
188             $self->add_primitive(Geometry::Primitive::Line->new(
189             start => $self->current_point->clone,
190             end => $point
191             ));
192             }
193              
194             sub rel_move_to {
195             my ($self, $x, $y) = @_;
196              
197             my $point = $self->current_point->clone;
198             $self->move_to($point->x + $x, $point->y + $y);
199             }
200              
201             __PACKAGE__->meta->make_immutable;
202              
203             no Moose;
204             1;
205              
206             __END__
207              
208             =encoding UTF-8
209              
210             =head1 NAME
211              
212             Graphics::Primitive::Path - Collection of primitives
213              
214             =head1 DESCRIPTION
215              
216             Graphics::Primitive::Path is a shape defined by a list of primitives.
217              
218             =head1 SYNOPSIS
219              
220             use Graphics::Primitive::Path;
221              
222             my $path = Graphics::Primitive::Path->new();
223             $path->add_primitive($line);
224             $path->move_to($point);
225              
226             =head1 METHODS
227              
228             =head2 Constructor
229              
230             =over 4
231              
232             =item I<new>
233              
234             Creates a new Graphics::Primitive::Path
235              
236             =back
237              
238             =head2 Instance Methods
239              
240             =over 4
241              
242             =item I<add_primitive ($prim)>
243              
244             Add a primitive to this Path.
245              
246             =item I<arc ($radius, $start, $end, [ $skip_line_to ])>
247              
248             $path->arc($radius, $start_angle_in_radians, $end_angle_in_radians);
249              
250             Draw an arc based at the current point with the given radius from the given
251             start angle to the given end angle. B<A line will be drawn from the
252             current_point to the start point of the described arc. If you do not want
253             this to happen, supply a true value as the last argument.>
254              
255             =item I<clear_current_point>
256              
257             Clears the current point on this Path.
258              
259             =item I<clear_primitives>
260              
261             Clears all primitives from this Path. NOTE: This does not clear the
262             current point.
263              
264             =item I<close_path>
265              
266             Close the current path by drawing a line from the I<current_point> back to
267             the first point in the path.
268              
269             =item I<contiguous>
270              
271             Flag this path as being contiguous at this point. Continuity is important
272             so some path-based drivers such as Cairo. You should not mess with this
273             attribute unless you know what you are doing. It's used for driver hinting.
274              
275             =item I<current_point>
276              
277             Returns the current -- or last -- point on this Path.
278              
279             =item I<curve_to ($control1, $control2, $end)>
280              
281             Creates a cubic Bézier curve from the current point to the $end point using
282             $control1 and $control2 as control points.
283              
284             =item I<ellipse ($width, $height, [ $skip_line_to ])>
285              
286             Creates an ellipse at the current point with the specified width and height.
287             Optional last argument, if true, skips drawing a line to the ellipse's
288             starting point.
289              
290             =item I<get_points>
291              
292             Get this path as a series of points.
293              
294             =item I<get_primitive>
295              
296             Returns the primitive at the specified offset.
297              
298             =item I<hints>
299              
300             List of hint hashrefs. This hint arrayref matches the primitives arrayref
301             one-to-one. Hints are tidbits of information that may assist drivers in
302             optimizing (or successfully handling) primitives in this path's list. You
303             should not mess with this structure unless you know what you are doing.
304              
305             =item I<line_to ($point | $x, $y)>
306              
307             Draw a line from the current point to the one provided. Accepts either a
308             Geoemetry::Primitive::Point or two arguments for x and y.
309              
310             =item I<move_to ($point | $x, $y)>
311              
312             Move the current point to the one specified. This will not add any
313             primitives to the path. Accepts either a Geoemetry::Primitive::Point or
314             two arguments for x and y.
315              
316             =item I<primitive_count>
317              
318             Returns the number of primitives on this Path.
319              
320             =item I<rectangle ($width, $height)>
321              
322             Draw a rectangle at I<current_position> of the specified width and height.
323              
324             =item I<rel_curve_to ($x1, $y1, $x2, $y2, $x3, $y3)>
325              
326             Creates a cubic Bézier curve from the current point using the provided values
327             as offsets:
328              
329             start = current point
330             control1 = current point + $x1,$y1
331             control1 = current point + $x2,$y2
332             end = current point + $x3,$y3
333              
334             =item I<rel_line_to ($x_amount, $y_amount)>
335              
336             Draw a line by adding the supplied x and y values to the current one. For
337             example if the current point is 5,5 then calling rel_line_to(2, 2) would draw
338             a line from the current point to 7,7.
339              
340             =item I<rel_move_to ($x_amount, $y_amount)>
341              
342             Move to a new point by adding the supplied x and y values to the current ones.
343              
344             =back
345              
346             =head1 AUTHOR
347              
348             Cory Watson <gphat@cpan.org>
349              
350             =head1 COPYRIGHT & LICENSE
351              
352             Copyright 2008-2010 by Cory G Watson.
353              
354             You can redistribute and/or modify this code under the same terms as Perl
355             itself.