File Coverage

blib/lib/Graphics/Primitive/Border.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::Border;
2 1     1   55415 use Moose;
  0            
  0            
3             use MooseX::Storage;
4              
5             with 'MooseX::Clone';
6             with Storage (format => 'JSON', io => 'File');
7              
8             use Graphics::Color;
9             use Graphics::Primitive::Brush;
10              
11             has 'bottom' => (
12             is => 'rw',
13             isa => 'Graphics::Primitive::Brush',
14             default => sub {
15             Graphics::Primitive::Brush->new
16             },
17             traits => [qw(Clone)]
18             );
19             has 'color' => (
20             is => 'rw',
21             isa => 'Graphics::Color',
22             trigger => sub {
23             my ($self, $newval) = @_;
24             $self->bottom->color($newval);
25             $self->left->color($newval);
26             $self->right->color($newval);
27             $self->top->color($newval);
28             },
29             predicate => 'has_color'
30             );
31             has 'left' => (
32             is => 'rw',
33             isa => 'Graphics::Primitive::Brush',
34             default => sub {
35             Graphics::Primitive::Brush->new
36             },
37             traits => [qw(Clone)]
38             );
39             has 'right' => (
40             is => 'rw',
41             isa => 'Graphics::Primitive::Brush',
42             default => sub {
43             Graphics::Primitive::Brush->new
44             },
45             traits => [qw(Clone)]
46             );
47             has 'top' => (
48             is => 'rw',
49             isa => 'Graphics::Primitive::Brush',
50             default => sub {
51             Graphics::Primitive::Brush->new
52             },
53             traits => [qw(Clone)]
54             );
55             has 'width' => (
56             is => 'rw',
57             isa => 'Int',
58             trigger => sub {
59             my ($self, $newval) = @_;
60             $self->bottom->width($newval);
61             $self->left->width($newval);
62             $self->right->width($newval);
63             $self->top->width($newval);
64             },
65             predicate => 'has_width'
66             );
67              
68             __PACKAGE__->meta->make_immutable;
69              
70             sub BUILD {
71             my ($self) = @_;
72              
73             if($self->has_width) {
74             my $w = $self->width;
75             $self->bottom->width($w);
76             $self->left->width($w);
77             $self->right->width($w);
78             $self->top->width($w);
79             }
80             if($self->has_color) {
81             my $c = $self->color;
82             $self->bottom->color($c);
83             $self->left->color($c);
84             $self->right->color($c);
85             $self->top->color($c);
86             }
87             }
88              
89             # sub color {
90             # my ($self, $c) = @_;
91             #
92             # $self->bottom->color($c);
93             # $self->left->color($c);
94             # $self->right->color($c);
95             # $self->top->color($c);
96             # }
97              
98             sub dash_pattern {
99             my ($self, $d) = @_;
100              
101             $self->bottom->dash_pattern($d);
102             $self->left->dash_pattern($d);
103             $self->right->dash_pattern($d);
104             $self->top->dash_pattern($d);
105             }
106              
107             sub equal_to {
108             my ($self, $other) = @_;
109              
110             unless($self->top->equal_to($other->top)) {
111             return 0;
112             }
113             unless($self->right->equal_to($other->right)) {
114             return 0;
115             }
116             unless($self->bottom->equal_to($other->bottom)) {
117             return 0;
118             }
119             unless($self->left->equal_to($other->left)) {
120             return 0;
121             }
122              
123             return 1;
124             }
125              
126             sub homogeneous {
127             my ($self) = @_;
128              
129             my $b = $self->top;
130             unless($self->bottom->equal_to($b) && $self->left->equal_to($b)
131             && $self->right->equal_to($b)) {
132             return 0;
133             }
134             return 1;
135             }
136              
137             sub not_equal_to {
138             my ($self, $other) = @_;
139              
140             return !$self->equal_to($other);
141             }
142              
143             # sub width {
144             # my ($self, $w) = @_;
145             #
146             # $self->bottom->width($w);
147             # $self->left->width($w);
148             # $self->right->width($w);
149             # $self->top->width($w);
150             # }
151              
152             no Moose;
153             1;
154             __END__
155              
156             =head1 NAME
157              
158             Graphics::Primitive::Border - Line around components
159              
160             =head1 DESCRIPTION
161              
162             Graphics::Primitive::Border describes the border to be rendered around a
163             component.
164              
165             =head1 SYNOPSIS
166              
167             use Graphics::Primitive::Border;
168              
169             my $border = Graphics::Primitive::Border->new;
170              
171             =head1 METHODS
172              
173             =head2 new
174              
175             Creates a new Graphics::Primitiver::Border. Borders are composed of 4
176             brushes, one for each of the 4 sides. See the documentation for
177             L<Graphics::Primitive::Brush> for more information. Note that you can
178             provide a C<width> and C<color> argument to the constructor and it will create
179             brushes of that width for each side.
180              
181             =head2 bottom
182              
183             The brush representing the bottom border.
184              
185             =head2 clone
186              
187             Close this border.
188              
189             =head2 color
190              
191             Set the Color on all 4 borders to the one supplied. Shortcut for setting it
192             with each side.
193              
194             =head2 dash_pattern
195              
196             Set the dash pattern on all 4 borders to the one supplied. Shortcut for
197             setting it with each side.
198              
199             =head2 equal_to ($other)
200              
201             Returns 1 if this border is equal to the one provided, else returns 0.
202              
203             =head2 homogeneous
204              
205             Returns 1 if all of this border's sides are the same. Allows for driver
206             optimizations.
207              
208             =head2 left
209              
210             The brush representing the left border.
211              
212             =head2 not_equal_to
213              
214             Opposite of C<equal_to>.
215              
216             =head2 right
217              
218             The brush representing the right border.
219              
220             =head2 top
221              
222             The brush representing the top border.
223              
224             =head2 width
225              
226             Set the width on all 4 borders to the one supplied. Shortcut for setting it
227             with each side.
228              
229             =head1 AUTHOR
230              
231             Cory Watson, C<< <gphat@cpan.org> >>
232              
233             =head1 COPYRIGHT & LICENSE
234              
235             Copyright 2008-2010 by Cory G Watson.
236              
237             This program is free software; you can redistribute it and/or modify it
238             under the same terms as Perl itself.