File Coverage

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