File Coverage

blib/lib/Graphics/Color/RGB.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::Color::RGB;
2             $Graphics::Color::RGB::VERSION = '0.31';
3 2     2   35951 use Moose;
  0            
  0            
4             use MooseX::Aliases;
5              
6             extends qw(Graphics::Color);
7              
8             # ABSTRACT: RGB color model
9              
10             use Color::Library;
11             use Graphics::Color::HSL;
12             use Graphics::Color::HSV;
13              
14             use Graphics::Color::Types qw(NumberOneOrLess);
15              
16              
17             has 'red' => (
18             is => 'rw',
19             isa => NumberOneOrLess,
20             default => 1,
21             alias => 'r'
22             );
23              
24              
25             has 'green' => (
26             is => 'rw',
27             isa => NumberOneOrLess,
28             default => 1,
29             alias => 'g'
30             );
31              
32              
33             has 'blue' => (
34             is => 'rw',
35             isa => NumberOneOrLess,
36             default => 1,
37             alias => 'b'
38             );
39              
40              
41             has 'alpha' => (
42             is => 'rw',
43             isa => NumberOneOrLess,
44             default => 1,
45             alias => 'a'
46             );
47              
48              
49             has 'name' => ( is => 'rw', isa => 'Str' );
50              
51              
52             sub as_string {
53             my ($self) = @_;
54              
55             return sprintf('%0.2f,%0.2f,%0.2f,%0.2f',
56             $self->red, $self->green,
57             $self->blue, $self->alpha
58             );
59             }
60              
61              
62             sub as_integer_string {
63             my ($self) = @_;
64              
65             return sprintf("%d, %d, %d, %0.2f",
66             $self->red * 255, $self->green * 255, $self->blue * 255, $self->alpha
67             );
68             }
69              
70              
71             sub as_css_hex {
72             my ($self) = @_;
73              
74             return $self->as_hex_string('#');
75             }
76              
77              
78             sub as_hex_string {
79             my ($self, $prepend) = @_;
80              
81             $prepend = '' unless defined($prepend);
82              
83             return sprintf('%s%.2x%.2x%.2x',
84             $prepend, $self->red * 255, $self->green * 255, $self->blue * 255
85             );
86             }
87              
88              
89             sub as_percent_string {
90             my ($self) = @_;
91              
92             return sprintf("%d%%, %d%%, %d%%, %0.2f",
93             $self->red * 100, $self->green * 100, $self->blue * 100, $self->alpha
94             );
95             }
96              
97              
98             sub as_array {
99             my ($self) = @_;
100              
101             return ($self->red, $self->green, $self->blue);
102             }
103              
104              
105             sub as_array_with_alpha {
106             my ($self) = @_;
107              
108             return ($self->red, $self->green, $self->blue, $self->alpha);
109             }
110              
111              
112             sub equal_to {
113             my ($self, $other) = @_;
114              
115             return 0 unless defined($other);
116              
117             unless($self->red == $other->red) {
118             return 0;
119             }
120             unless($self->green == $other->green) {
121             return 0;
122             }
123             unless($self->blue == $other->blue) {
124             return 0;
125             }
126             unless($self->alpha == $other->alpha) {
127             return 0;
128             }
129              
130             return 1;
131             }
132              
133              
134             sub from_color_library {
135             my ($self, $id) = @_;
136              
137             my $color;
138             if(ref($id)) {
139             $color = $id;
140             } else {
141             $color = Color::Library->color($id);
142             unless(defined($color)) {
143             die("Couldn't find color for '$id'!");
144             }
145             }
146              
147             my ($r, $g, $b) = $color->rgb;
148             return Graphics::Color::RGB->new(
149             red => $r / 255,
150             green => $g / 255,
151             blue => $b / 255
152             );
153             }
154              
155              
156             sub from_hex_string {
157             my ($self, $hex) = @_;
158              
159             # Get rid of the leading # if it's there
160             $hex =~ s/^#//g;
161             $hex = lc($hex);
162              
163             my $len = length($hex);
164              
165             if(length($hex) == 3) {
166             $hex =~ /([a-f0-9])([a-f0-9])([a-f0-9])/;
167             $hex = "$1$1$2$2$3$3";
168             }
169              
170             if(length($hex) == 6) {
171             $hex =~ /([a-f0-9]{2})([a-f0-9]{2})([a-f0-9]{2})/;
172              
173             return Graphics::Color::RGB->new(
174             red => hex($1) / 255,
175             green => hex($2) / 255,
176             blue => hex($3) / 255
177             );
178             }
179              
180             # Not a valid hex color
181             return undef;
182             }
183              
184              
185             sub to_hsl {
186             my ($self) = @_;
187              
188             my $max = $self->red;
189             my $maxc = 'r';
190             my $min = $self->red;
191              
192             if($self->green > $max) {
193             $max = $self->green;
194             $maxc = 'g';
195             }
196             if($self->blue > $max) {
197             $max = $self->blue;
198             $maxc = 'b';
199             }
200              
201             if($self->green < $min) {
202             $min = $self->green;
203             }
204             if($self->blue < $min) {
205             $min = $self->blue;
206             }
207              
208             my ($h, $s, $l);
209              
210             if($max == $min) {
211             $h = 0;
212             } elsif($maxc eq 'r') {
213             $h = 60 * (($self->green - $self->blue) / ($max - $min)) % 360;
214             } elsif($maxc eq 'g') {
215             $h = (60 * (($self->blue - $self->red) / ($max - $min)) + 120);
216             } elsif($maxc eq 'b') {
217             $h = (60 * (($self->red - $self->green) / ($max - $min)) + 240);
218             }
219              
220             $l = ($max + $min) / 2;
221              
222             if($max == $min) {
223             $s = 0;
224             } elsif($l <= .5) {
225             $s = ($max - $min) / ($max + $min);
226             } else {
227             $s = ($max - $min) / (2 - ($max + $min));
228             }
229              
230             return Graphics::Color::HSL->new(
231             hue => $h, saturation => $s, lightness => $l, alpha => $self->alpha
232             );
233             }
234              
235              
236             sub to_hsv {
237             my ($self) = @_;
238              
239             my $max = $self->red;
240             my $maxc = 'r';
241             my $min = $self->red;
242              
243             if($self->green > $max) {
244             $max = $self->green;
245             $maxc = 'g';
246             }
247             if($self->blue > $max) {
248             $max = $self->blue;
249             $maxc = 'b';
250             }
251              
252             if($self->green < $min) {
253             $min = $self->green;
254             }
255             if($self->blue < $min) {
256             $min = $self->blue;
257             }
258              
259             my ($h, $s, $v);
260              
261             if($max == $min) {
262             $h = 0;
263             } elsif($maxc eq 'r') {
264             $h = 60 * (($self->green - $self->blue) / ($max - $min)) % 360;
265             } elsif($maxc eq 'g') {
266             $h = (60 * (($self->blue - $self->red) / ($max - $min)) + 120);
267             } elsif($maxc eq 'b') {
268             $h = (60 * (($self->red - $self->green) / ($max - $min)) + 240);
269             }
270              
271             $v = $max;
272             if($max == 0) {
273             $s = 0;
274             } else {
275             $s = 1 - ($min / $max);
276             }
277              
278             return Graphics::Color::HSV->new(
279             hue => $h, saturation => $s, value => $v, alpha => $self->alpha
280             );
281             }
282              
283             __PACKAGE__->meta->make_immutable;
284              
285             no Moose;
286             1;
287              
288             __END__
289              
290             =pod
291              
292             =head1 NAME
293              
294             Graphics::Color::RGB - RGB color model
295              
296             =head1 VERSION
297              
298             version 0.31
299              
300             =head1 SYNOPSIS
301              
302             use Graphics::Color::RGB;
303              
304             my $color = Graphics::Color::RGB->new({
305             red => 1,
306             blue => .31,
307             green => .25,
308             });
309              
310             =head1 DESCRIPTION
311              
312             Graphics::Color::RGB represents a Color in the sRGB color space. Individual
313             color channels are expressed as decimal values from 0 to 1, 0 being a lack
314             of that color (or opaque in the case of alpha) and 1 being full color (or
315             transparent in the case of alpha). If no options are provided then new
316             instance of RGB are opaque white, (that is equivalent to red => 1, green => 1,
317             blue => 1, alpha => 1).
318              
319             Convenience methods are supplied to convert to various string values.
320              
321             =head1 ATTRIBUTES
322              
323             =head2 red
324              
325             =head2 r
326              
327             Set/Get the red component of this Color. Aliased to 'r' as well.
328              
329             =head2 green
330              
331             =head2 g
332              
333             Set/Get the green component of this Color. Aliased to 'g' as well.
334              
335             =head2 blue
336              
337             =head2 b
338              
339             Set/Get the blue component of this Color. Aliased to 'b' as well.
340              
341             =head2 alpha
342              
343             =head2 a
344              
345             Set/Get the alpha component of this Color. Aliased to 'a' as well.
346              
347             =head2 name
348              
349             Get the name of this color. Only valid if the color was created by name.
350              
351             =head1 METHODS
352              
353             =head2 as_string
354              
355             Get a string version of this Color in the form of RED,GREEN,BLUE,ALPHA
356              
357             =head2 as_integer_string
358              
359             Return an integer formatted value for this color. This format is suitable for
360             CSS RGBA values.
361              
362             =head2 as_css_hex
363              
364             Return a hex formatted value with a prepended '#' for use in CSS and HTML.
365              
366             =head2 as_hex_string ( [$prepend] )
367              
368             Return a hex formatted value for this color. The output ignores the alpha
369             channel because, per the W3C, there is no hexadecimal notiation for an RGBA
370             value. Optionally allows you to include a string that will be prepended. This
371             is a common way to add the C<#>.
372              
373             =head2 as_percent_string
374              
375             Return a percent formatted value for this color. This format is suitable for
376             CSS RGBA values.
377              
378             =head2 as_array
379              
380             Get the RGB values as an array.
381              
382             =head2 as_array_with_alpha
383              
384             Get the RGBA values as an array
385              
386             =head2 equal_to
387              
388             Compares this color to the provided one. Returns 1 if true, else 0;
389              
390             =head2 not_equal_to
391              
392             The opposite of equal_to.
393              
394             =head2 from_color_library ($color_id)
395              
396             Attempts to retrieve the specified color-id using L<Color::Library>. The
397             result is then converted into a Graphics::Color::RGB object.
398              
399             =head2 from_hex_string($hex)
400              
401             Attempts to create a Graphics::Color::RGB object from a hex string. Works with
402             or without the leading # and with either 3 or 6 character hex strings.
403              
404             =head2 to_hsl
405              
406             Creates this RGB color in HSL space. Returns a L<Graphics::Color::HSL> object.
407              
408             =head2 to_hsv
409              
410             Creates this RGB color in HSV space. Returns a L<Graphics::Color::HSV> object.
411              
412             =head1 AUTHOR
413              
414             Cory G Watson <gphat@cpan.org>
415              
416             =head1 COPYRIGHT AND LICENSE
417              
418             This software is copyright (c) 2014 by Cold Hard Code, LLC.
419              
420             This is free software; you can redistribute it and/or modify it under
421             the same terms as the Perl 5 programming language system itself.
422              
423             =cut