File Coverage

blib/lib/Convert/Color/RGB8.pm
Criterion Covered Total %
statement 67 69 97.1
branch 16 24 66.6
condition n/a
subroutine 16 16 100.0
pod 11 12 91.6
total 110 121 90.9


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::RGB8 0.17;
7              
8 12     12   2521 use v5.14;
  12         54  
9 12     12   70 use warnings;
  12         43  
  12         439  
10 12     12   72 use base qw( Convert::Color );
  12         24  
  12         1784  
11              
12             __PACKAGE__->register_color_space( 'rgb8' );
13              
14 12     12   90 use Carp;
  12         39  
  12         11880  
15              
16             =head1 NAME
17              
18             C - a color value represented as red/green/blue in 8-bit
19             integers
20              
21             =head1 SYNOPSIS
22              
23             Directly:
24              
25             use Convert::Color::RGB8;
26              
27             my $red = Convert::Color::RGB8->new( 255, 0, 0 );
28              
29             # Can also parse strings
30             my $pink = Convert::Color::RGB8->new( '255,192,192' );
31              
32             # or
33             $pink = Convert::Color::RGB8->new( 'ffc0c0' );
34              
35             Via L:
36              
37             use Convert::Color;
38              
39             my $cyan = Convert::Color->new( 'rgb8:0,255,255' );
40              
41             =head1 DESCRIPTION
42              
43             Objects in this class represent a color in RGB space, as a set of three
44             integer values in the range 0 to 255; i.e. as 8 bits.
45              
46             For representations using floating point values, see L.
47             For representations using 16-bit integers, see L.
48              
49             =cut
50              
51             =head1 CONSTRUCTOR
52              
53             =cut
54              
55             =head2 new
56              
57             $color = Convert::Color::RGB8->new( $red, $green, $blue )
58              
59             Returns a new object to represent the set of values given. These values should
60             be integers between 0 and 255. Values outside of this range will be clamped.
61              
62             $color = Convert::Color::RGB8->new( $string )
63              
64             Parses C<$string> for values, and construct a new object similar to the above
65             three-argument form. The string should be in the form
66              
67             red,green,blue
68              
69             containing the three integer values in decimal notation. It can also be given
70             in the form of a hex encoded string, such as would be returned by the
71             C method:
72              
73             rrggbb
74              
75             =cut
76              
77             sub new
78             {
79 32     32 1 81 my $class = shift;
80              
81 32         52 my ( $r, $g, $b );
82              
83 32 100       126 if( @_ == 1 ) {
    50          
84 2         4 local $_ = $_[0];
85 2 100       15 if( m/^([[:xdigit:]]{2})([[:xdigit:]]{2})([[:xdigit:]]{2})$/ ) {
    50          
86 1         9 ( $r, $g, $b ) = ( hex( $1 ), hex( $2 ), hex( $3 ) );
87             }
88             elsif( m/^(\d+),(\d+),(\d+)$/ ) {
89 1         3 ( $r, $g, $b ) = ( $1, $2, $3 );
90             }
91             else {
92 0         0 croak "Unrecognised RGB8 string spec '$_'";
93             }
94             }
95             elsif( @_ == 3 ) {
96 30         122 ( $r, $g, $b ) = map int, @_;
97             }
98             else {
99 0         0 croak "usage: Convert::Color::RGB8->new( SPEC ) or ->new( R, G, B )";
100             }
101              
102             # Clamp to the range [0,255]
103 32         77 for ( $r, $g, $b ) {
104 96 50       177 $_ = 0 if $_ < 0;
105 96 50       195 $_ = 255 if $_ > 255;
106             }
107              
108 32         192 return bless [ $r, $g, $b ], $class;
109             }
110              
111             =head1 METHODS
112              
113             =cut
114              
115             =head2 red
116              
117             $r = $color->red
118              
119             =head2 green
120              
121             $g = $color->green
122              
123             =head2 blue
124              
125             $b = $color->blue
126              
127             Accessors for the three components of the color.
128              
129             =cut
130              
131             # Simple accessors
132 63     63 1 606 sub red { shift->[0] }
133 63     63 1 137 sub green { shift->[1] }
134 63     63 1 236 sub blue { shift->[2] }
135              
136             # Conversions
137             sub rgb
138             {
139 3     3 1 7 my $self = shift;
140              
141 3         5 return map { $_ / 255 } @{$self}[0..2];
  9         24  
  3         8  
142             }
143              
144             sub new_rgb
145             {
146 14     14 0 26 my $class = shift;
147              
148 14         31 return $class->new( map { $_ * 255 } @_ );
  42         98  
149             }
150              
151             =head2 rgb8
152              
153             ( $red, $green, $blue ) = $color->rgb8
154              
155             Returns the individual red, green and blue color components of the color
156             value in RGB8 space.
157              
158             =cut
159              
160             sub rgb8
161             {
162 60     60 1 565 my $self = shift;
163 60         117 return $self->red, $self->green, $self->blue;
164             }
165              
166             =head2 hex
167              
168             $str = $color->hex
169              
170             Returns a string representation of the color components in the RGB8 space, in
171             a convenient C hex string, likely to be useful HTML, or other similar
172             places.
173              
174             =cut
175              
176             sub hex :method
177             {
178 6     6 1 12 my $self = shift;
179 6         12 sprintf "%02x%02x%02x", $self->rgb8;
180             }
181              
182             =head2 alpha_blend
183              
184             $mix = $color->alpha_blend( $other, [ $alpha ] )
185              
186             Return a new color which is a blended combination of the two passed into it.
187             The optional C<$alpha> parameter defines the mix ratio between the two colors,
188             defaulting to 0.5 if not defined. Values closer to 0 will blend more of
189             C<$color>, closer to 1 will blend more of C<$other>.
190              
191             =cut
192              
193             sub alpha_blend
194             {
195 4     4 1 13 my $self = shift;
196 4         8 my ( $other, $alpha ) = @_;
197              
198 4 100       11 $alpha = 0.5 unless defined $alpha;
199              
200 4 50       13 $alpha = 0 if $alpha < 0;
201 4 50       9 $alpha = 1 if $alpha > 1;
202              
203 4         9 my $alphaP = 1 - $alpha;
204              
205 4         10 my ( $rA, $gA, $bA ) = $self->rgb8;
206 4         16 my ( $rB, $gB, $bB ) = $other->as_rgb8->rgb8;
207              
208             # Add 0.5 for rounding
209 4         19 return __PACKAGE__->new(
210             $rA * $alphaP + $rB * $alpha + 0.5,
211             $gA * $alphaP + $gB * $alpha + 0.5,
212             $bA * $alphaP + $bB * $alpha + 0.5,
213             );
214             }
215              
216             =head2 alpha8_blend
217              
218             $mix = $color->alpha8_blend( $other, [ $alpha ] )
219              
220             Similar to C but works with integer arithmetic. C<$alpha> should
221             be an integer in the range 0 to 255.
222              
223             =cut
224              
225             sub alpha8_blend
226             {
227 4     4 1 12 my $self = shift;
228 4         9 my ( $other, $alpha ) = @_;
229              
230 4 100       11 $alpha = 127 unless defined $alpha;
231              
232 4 50       9 $alpha = 0 if $alpha < 0;
233 4 50       9 $alpha = 255 if $alpha > 255;
234 4         6 $alpha = int $alpha;
235              
236 4         8 my $alphaP = 255 - $alpha;
237              
238 4         9 my ( $rA, $gA, $bA ) = $self->rgb8;
239 4         10 my ( $rB, $gB, $bB ) = $other->as_rgb8->rgb8;
240              
241 4         21 return __PACKAGE__->new(
242             ( $rA * $alphaP + $rB * $alpha ) / 255,
243             ( $gA * $alphaP + $gB * $alpha ) / 255,
244             ( $bA * $alphaP + $bB * $alpha ) / 255,
245             );
246             }
247              
248             =head2 dst_rgb8
249              
250             $measure = $color->dst_rgb8( $other )
251              
252             Return a measure of the distance between the two colors. This is the
253             unweighted Euclidean distance of the three color components. Two identical
254             colors will have a measure of 0, pure black and pure white have a distance of
255             1, and all others will lie somewhere inbetween.
256              
257             =cut
258              
259             sub dst_rgb8
260             {
261 7     7 1 19 my $self = shift;
262 7         12 my ( $other ) = @_;
263              
264 7         17 return sqrt( $self->dst_rgb8_cheap( $other ) ) / sqrt(3*255*255);
265             }
266              
267             =head2 dst_rgb8_cheap
268              
269             $measure = $color->dst_rgb8_cheap( $other )
270              
271             Return a measure of the distance between the two colors. This is the sum of
272             the squares of the differences of each of the color components. This is part
273             of the value used to calculate C, but since it involves no square
274             root it will be cheaper to calculate, for use in cases where only the relative
275             values matter, such as when picking the "best match" out of a set of colors.
276             It ranges between 0 for identical colours and 3*(255^2) for the distance between
277             pure black and pure white.
278              
279             =cut
280              
281             sub dst_rgb8_cheap
282             {
283 12     12 1 20 my $self = shift;
284 12         22 my ( $other ) = @_;
285              
286 12         33 my ( $rA, $gA, $bA ) = $self->rgb8;
287 12         40 my ( $rB, $gB, $bB ) = $other->as_rgb8->rgb8;
288              
289 12         36 my $dr = $rA - $rB;
290 12         14 my $dg = $gA - $gB;
291 12         18 my $db = $bA - $bB;
292              
293 12         65 return $dr*$dr + $dg*$dg + $db*$db;
294             }
295              
296             =head1 SEE ALSO
297              
298             =over 4
299              
300             =item *
301              
302             L - color space conversions
303              
304             =back
305              
306             =head1 AUTHOR
307              
308             Paul Evans
309              
310             =cut
311              
312             0x55AA;