File Coverage

blib/lib/Graphics/Primitive/Brush.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::Brush;
2 1     1   38988 use Moose;
  0            
  0            
3             use Moose::Util::TypeConstraints;
4             use MooseX::Storage;
5              
6             with 'MooseX::Clone';
7             with Storage (format => 'JSON', io => 'File');
8              
9             enum 'LineCap' => [qw(butt round square)];
10             enum 'LineJoin' => [qw(miter round bevel)];
11              
12             has 'color' => ( is => 'rw', isa => 'Graphics::Color', traits => [qw(Clone)] );
13             has 'dash_pattern' => ( is => 'rw', isa => 'ArrayRef' );
14             has 'width' => ( is => 'rw', isa => 'Int', default => sub { 0 } );
15             has 'line_cap' => ( is => 'rw', isa => 'LineCap', default => 'butt' );
16             has 'line_join' => ( is => 'rw', isa => 'LineJoin', default => 'miter' );
17              
18             __PACKAGE__->meta->make_immutable;
19              
20             sub derive {
21             my ($self, $args) = @_;
22              
23             return unless ref($args) eq 'HASH';
24             my $new = $self->clone;
25             foreach my $key (keys %{ $args }) {
26             $new->$key($args->{$key}) if($new->can($key));
27             }
28             return $new;
29             }
30              
31             sub equal_to {
32             my ($self, $other) = @_;
33              
34             return 0 unless defined($other);
35              
36             unless($self->width == $other->width) {
37             return 0;
38             }
39              
40             unless($self->line_cap eq $other->line_cap) {
41             return 0;
42             }
43              
44             unless($self->line_join eq $other->line_join) {
45             return 0;
46             }
47              
48             if(defined($self->color)) {
49             unless($self->color->equal_to($other->color)) {
50             return 0;
51             }
52             } else {
53             if(defined($other->color)) {
54             return 0;
55             }
56             }
57              
58             if(defined($self->dash_pattern)) {
59             unless(scalar(@{ $self->dash_pattern }) == scalar(@{ $other->dash_pattern })) {
60             return 0;
61             }
62              
63             for(my $i = 0; $i < scalar(@{ $self->dash_pattern }); $i++) {
64             unless($self->dash_pattern->[$i] == $other->dash_pattern->[$i]) {
65             return 0;
66             }
67             }
68             } else {
69             if(defined($other->dash_pattern)) {
70             return 0;
71             }
72             }
73              
74             return 1;
75             }
76              
77             sub not_equal_to {
78             my ($self, $other) = @_;
79              
80             return !$self->equal_to($other);
81             }
82              
83             no Moose;
84             1;
85             __END__
86              
87             =head1 NAME
88              
89             Graphics::Primitive::Brush - Description of a stroke
90              
91             =head1 DESCRIPTION
92              
93             Graphics::Primitive::Brush represents the visible trace of 'ink' along a
94             path.
95              
96             =head1 SYNOPSIS
97              
98             use Graphics::Primitive::Brush;
99              
100             my $stroke = Graphics::Primitive::Brush->new({
101             line_cap => 'round',
102             line_join => 'miter',
103             width => 2
104             });
105              
106             =head1 METHODS
107              
108             =head2 Constructor
109              
110             =over 4
111              
112             =item I<new>
113              
114             Creates a new Graphics::Primitive::Brush. Defaults to a width of 1,
115             a line_cap 'butt' and a line_join of 'miter'.
116              
117             =back
118              
119             =head2 Instance Methods
120              
121             =over 4
122              
123             =item I<color>
124              
125             Set/Get this brush's color.
126              
127             =item I<dash_pattern>
128              
129             Set/Get the dash pattern. A dash pattern is an arrayref of numbers
130             representing the lengths of the various line segments of the dash. Even
131             numbered elements are considered opaque and odd elements are transparent.
132              
133             =item I<derive>
134              
135             Clone this brush but change one or more of it's attributes by passing in a
136             hashref of options:
137              
138             my $new = $brush->derive({ attr => $newvalue });
139            
140             The returned font will be identical to the cloned one, save the attributes
141             specified.
142              
143             =item I<equal_to ($other)>
144              
145             Returns 1 if this brush is equal to the supplied one, else returns 0.
146              
147             =item I<line_cap>
148              
149             Set/Get the line_cap of this stroke. Valid values are butt, round and square.
150              
151             =item I<line_join>
152              
153             Set/Get the line_join of this stroke. Valid values are miter, round and bevel.
154              
155             =item I<not_equal_to ($other)>
156              
157             Opposite of equal_to.
158              
159             =item I<width>
160              
161             Set/Get the width of this stroke. Defaults to 1
162              
163             =back
164              
165             =head1 AUTHOR
166              
167             Cory Watson, C<< <gphat@cpan.org> >>
168              
169             =head1 COPYRIGHT & LICENSE
170              
171             Copyright 2008-2010 by Cory G Watson.
172              
173             This program is free software; you can redistribute it and/or modify it
174             under the same terms as Perl itself.