File Coverage

blib/lib/Convert/Color/RGB.pm
Criterion Covered Total %
statement 48 52 92.3
branch 10 16 62.5
condition n/a
subroutine 12 13 92.3
pod 8 9 88.8
total 78 90 86.6


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2009-2022 -- leonerd@leonerd.org.uk
5              
6             package Convert::Color::RGB 0.17;
7              
8 11     11   913552 use v5.14;
  11         64  
9 11     11   83 use warnings;
  11         22  
  11         320  
10 11     11   69 use base qw( Convert::Color );
  11         19  
  11         3377  
11              
12             __PACKAGE__->register_color_space( 'rgb' );
13              
14 11     11   84 use Carp;
  11         26  
  11         7634  
15              
16             =head1 NAME
17              
18             C - a color value represented as red/green/blue
19              
20             =head1 SYNOPSIS
21              
22             Directly:
23              
24             use Convert::Color::RGB;
25              
26             my $red = Convert::Color::RGB->new( 1, 0, 0 );
27              
28             # Can also parse strings
29             my $pink = Convert::Color::RGB->new( '1,0.7,0.7' );
30              
31             Via L:
32              
33             use Convert::Color;
34              
35             my $cyan = Convert::Color->new( 'rgb:0,1,1' );
36              
37             =head1 DESCRIPTION
38              
39             Objects in this class represent a color in RGB space, as a set of three
40             floating-point values in the range 0 to 1.
41              
42             For representations using 8- or 16-bit integers, see L
43             and L.
44              
45             =cut
46              
47             =head1 CONSTRUCTOR
48              
49             =cut
50              
51             =head2 new
52              
53             $color = Convert::Color::RGB->new( $red, $green, $blue )
54              
55             Returns a new object to represent the set of values given. These values should
56             be floating-point numbers between 0 and 1. Values outside of this range will
57             be clamped.
58              
59             $color = Convert::Color::RGB->new( $string )
60              
61             Parses C<$string> for values, and construct a new object similar to the above
62             three-argument form. The string should be in the form
63              
64             red,green,blue
65              
66             containing the three floating-point values in decimal notation.
67              
68             =cut
69              
70             sub new
71             {
72 62     62 1 500 my $class = shift;
73              
74 62         102 my ( $r, $g, $b );
75              
76 62 100       191 if( @_ == 1 ) {
    50          
77 2         6 local $_ = $_[0];
78 2 50       19 if( m/^(\d+(?:\.\d+)?),(\d+(?:\.\d+)?),(\d+(?:\.\d+)?)$/ ) {
79 2         11 ( $r, $g, $b ) = ( $1, $2, $3 );
80             }
81             else {
82 0         0 croak "Unrecognised RGB string spec '$_'";
83             }
84             }
85             elsif( @_ == 3 ) {
86 60         115 ( $r, $g, $b ) = @_;
87             }
88             else {
89 0         0 croak "usage: Convert::Color::RGB->new( SPEC ) or ->new( R, G, B )";
90             }
91              
92             # Clamp to the range [0,1]
93 62         125 for ( $r, $g, $b ) {
94 186 50       324 $_ = 0 if $_ < 0;
95 186 50       374 $_ = 1 if $_ > 1;
96             }
97              
98 62         271 return bless [ $r, $g, $b ], $class;
99             }
100              
101             =head1 METHODS
102              
103             =cut
104              
105             =head2 red
106              
107             $r = $color->red
108              
109             =head2 green
110              
111             $g = $color->green
112              
113             =head2 blue
114              
115             $b = $color->blue
116              
117             Accessors for the three components of the color.
118              
119             =cut
120              
121             # Simple accessors
122 29     29 1 7367 sub red { shift->[0] }
123 29     29 1 134 sub green { shift->[1] }
124 29     29 1 133 sub blue { shift->[2] }
125              
126             =head2 rgb
127              
128             ( $red, $green, $blue ) = $color->rgb
129              
130             Returns the individual red, green and blue color components of the color
131             value.
132              
133             =cut
134              
135             sub rgb
136             {
137 103     103 1 6875 my $self = shift;
138 103         147 return @{$self}[0..2];
  103         366  
139             }
140              
141             sub new_rgb
142             {
143 0     0 0 0 my $class = shift;
144 0         0 return $class->new( @_ );
145             }
146              
147             =head2 alpha_blend
148              
149             $mix = $color->alpha_blend( $other, [ $alpha ] )
150              
151             Return a new color which is a blended combination of the two passed into it.
152             The optional C<$alpha> parameter defines the mix ratio between the two colors,
153             defaulting to 0.5 if not defined. Values closer to 0 will blend more of
154             C<$color>, closer to 1 will blend more of C<$other>.
155              
156             =cut
157              
158             sub alpha_blend
159             {
160 4     4 1 11 my $self = shift;
161 4         8 my ( $other, $alpha ) = @_;
162              
163 4 100       13 $alpha = 0.5 unless defined $alpha;
164              
165 4 50       12 $alpha = 0 if $alpha < 0;
166 4 50       11 $alpha = 1 if $alpha > 1;
167              
168 4         10 my $alphaP = 1 - $alpha;
169              
170 4         8 my ( $rA, $gA, $bA ) = $self->rgb;
171 4         11 my ( $rB, $gB, $bB ) = $other->rgb;
172              
173 4         31 return __PACKAGE__->new(
174             $rA * $alphaP + $rB * $alpha,
175             $gA * $alphaP + $gB * $alpha,
176             $bA * $alphaP + $bB * $alpha,
177             );
178             }
179              
180             =head2 dst_rgb
181              
182             $measure = $color->dst_rgb( $other )
183              
184             Return a measure of the distance between the two colors. This is the
185             unweighted Euclidean distance of the three color components. Two identical
186             colors will have a measure of 0, pure black and pure white have a distance of
187             1, and all others will lie somewhere inbetween.
188              
189             =cut
190              
191             sub dst_rgb
192             {
193 5     5 1 15 my $self = shift;
194 5         9 my ( $other ) = @_;
195              
196 5         13 return sqrt( $self->dst_rgb_cheap( $other ) ) / sqrt(3);
197             }
198              
199             =head2 dst_rgb_cheap
200              
201             $measure = $color->dst_rgb_cheap( $other )
202              
203             Return a measure of the distance between the two colors. This is the sum of
204             the squares of the differences of each of the color components. This is part
205             of the value used to calculate C, but since it involves no square
206             root it will be cheaper to calculate, for use in cases where only the relative
207             values matter, such as when picking the "best match" out of a set of colors.
208             It ranges between 0 for identical colours and 3 for the distance between pure
209             black and pure white.
210              
211             =cut
212              
213             sub dst_rgb_cheap
214             {
215 18     18 1 33 my $self = shift;
216 18         28 my ( $other ) = @_;
217              
218 18         37 my ( $rA, $gA, $bA ) = $self->rgb;
219 18         33 my ( $rB, $gB, $bB ) = $other->rgb;
220              
221 18         37 my $dr = $rA - $rB;
222 18         23 my $dg = $gA - $gB;
223 18         24 my $db = $bA - $bB;
224              
225 18         85 return $dr*$dr + $dg*$dg + $db*$db;
226             }
227              
228             =head1 EXAMPLES
229              
230             =head2 Generating Gradients
231              
232             The C method can be used to generate a smooth gradient between
233             two colours.
234              
235             use Convert::Color;
236              
237             my $blue = Convert::Color->new("vga:blue");
238             my $cyan = Convert::Color->new("vga:cyan");
239              
240             say $blue->alpha_blend( $cyan, $_/10 )->as_rgb8->hex for 0 .. 10
241              
242             =head1 SEE ALSO
243              
244             =over 4
245              
246             =item *
247              
248             L - color space conversions
249              
250             =item *
251              
252             L - a color value represented as hue/saturation/value
253              
254             =item *
255              
256             L - a color value represented as hue/saturation/lightness
257              
258             =back
259              
260             =head1 AUTHOR
261              
262             Paul Evans
263              
264             =cut
265              
266             0x55AA;