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.13; |
7
|
|
|
|
|
|
|
|
8
|
12
|
|
|
12
|
|
3484
|
use v5.14; |
|
12
|
|
|
|
|
119
|
|
9
|
12
|
|
|
12
|
|
70
|
use warnings; |
|
12
|
|
|
|
|
67
|
|
|
12
|
|
|
|
|
436
|
|
10
|
12
|
|
|
12
|
|
68
|
use base qw( Convert::Color ); |
|
12
|
|
|
|
|
35
|
|
|
12
|
|
|
|
|
1786
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
__PACKAGE__->register_color_space( 'rgb8' ); |
13
|
|
|
|
|
|
|
|
14
|
12
|
|
|
12
|
|
101
|
use Carp; |
|
12
|
|
|
|
|
58
|
|
|
12
|
|
|
|
|
11748
|
|
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
|
68
|
my $class = shift; |
80
|
|
|
|
|
|
|
|
81
|
32
|
|
|
|
|
56
|
my ( $r, $g, $b ); |
82
|
|
|
|
|
|
|
|
83
|
32
|
100
|
|
|
|
98
|
if( @_ == 1 ) { |
|
|
50
|
|
|
|
|
|
84
|
2
|
|
|
|
|
5
|
local $_ = $_[0]; |
85
|
2
|
100
|
|
|
|
15
|
if( m/^([[:xdigit:]]{2})([[:xdigit:]]{2})([[:xdigit:]]{2})$/ ) { |
|
|
50
|
|
|
|
|
|
86
|
1
|
|
|
|
|
8
|
( $r, $g, $b ) = ( hex( $1 ), hex( $2 ), hex( $3 ) ); |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
elsif( m/^(\d+),(\d+),(\d+)$/ ) { |
89
|
1
|
|
|
|
|
4
|
( $r, $g, $b ) = ( $1, $2, $3 ); |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
else { |
92
|
0
|
|
|
|
|
0
|
croak "Unrecognised RGB8 string spec '$_'"; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
elsif( @_ == 3 ) { |
96
|
30
|
|
|
|
|
114
|
( $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
|
|
|
|
|
73
|
for ( $r, $g, $b ) { |
104
|
96
|
50
|
|
|
|
169
|
$_ = 0 if $_ < 0; |
105
|
96
|
50
|
|
|
|
183
|
$_ = 255 if $_ > 255; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
32
|
|
|
|
|
170
|
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
|
678
|
sub red { shift->[0] } |
133
|
63
|
|
|
63
|
1
|
125
|
sub green { shift->[1] } |
134
|
63
|
|
|
63
|
1
|
222
|
sub blue { shift->[2] } |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
# Conversions |
137
|
|
|
|
|
|
|
sub rgb |
138
|
|
|
|
|
|
|
{ |
139
|
3
|
|
|
3
|
1
|
5
|
my $self = shift; |
140
|
|
|
|
|
|
|
|
141
|
3
|
|
|
|
|
6
|
return map { $_ / 255 } @{$self}[0..2]; |
|
9
|
|
|
|
|
24
|
|
|
3
|
|
|
|
|
7
|
|
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
sub new_rgb |
145
|
|
|
|
|
|
|
{ |
146
|
14
|
|
|
14
|
0
|
27
|
my $class = shift; |
147
|
|
|
|
|
|
|
|
148
|
14
|
|
|
|
|
33
|
return $class->new( map { $_ * 255 } @_ ); |
|
42
|
|
|
|
|
94
|
|
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
|
597
|
my $self = shift; |
163
|
60
|
|
|
|
|
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 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
|
11
|
my $self = shift; |
179
|
6
|
|
|
|
|
11
|
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
|
11
|
my $self = shift; |
196
|
4
|
|
|
|
|
9
|
my ( $other, $alpha ) = @_; |
197
|
|
|
|
|
|
|
|
198
|
4
|
100
|
|
|
|
10
|
$alpha = 0.5 unless defined $alpha; |
199
|
|
|
|
|
|
|
|
200
|
4
|
50
|
|
|
|
11
|
$alpha = 0 if $alpha < 0; |
201
|
4
|
50
|
|
|
|
9
|
$alpha = 1 if $alpha > 1; |
202
|
|
|
|
|
|
|
|
203
|
4
|
|
|
|
|
6
|
my $alphaP = 1 - $alpha; |
204
|
|
|
|
|
|
|
|
205
|
4
|
|
|
|
|
10
|
my ( $rA, $gA, $bA ) = $self->rgb8; |
206
|
4
|
|
|
|
|
17
|
my ( $rB, $gB, $bB ) = $other->as_rgb8->rgb8; |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
# Add 0.5 for rounding |
209
|
4
|
|
|
|
|
20
|
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
|
9
|
my $self = shift; |
228
|
4
|
|
|
|
|
8
|
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
|
|
|
|
11
|
$alpha = 255 if $alpha > 255; |
234
|
4
|
|
|
|
|
5
|
$alpha = int $alpha; |
235
|
|
|
|
|
|
|
|
236
|
4
|
|
|
|
|
7
|
my $alphaP = 255 - $alpha; |
237
|
|
|
|
|
|
|
|
238
|
4
|
|
|
|
|
8
|
my ( $rA, $gA, $bA ) = $self->rgb8; |
239
|
4
|
|
|
|
|
23
|
my ( $rB, $gB, $bB ) = $other->as_rgb8->rgb8; |
240
|
|
|
|
|
|
|
|
241
|
4
|
|
|
|
|
18
|
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
|
34
|
my $self = shift; |
262
|
7
|
|
|
|
|
14
|
my ( $other ) = @_; |
263
|
|
|
|
|
|
|
|
264
|
7
|
|
|
|
|
16
|
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
|
|
|
|
|
18
|
my ( $other ) = @_; |
285
|
|
|
|
|
|
|
|
286
|
12
|
|
|
|
|
23
|
my ( $rA, $gA, $bA ) = $self->rgb8; |
287
|
12
|
|
|
|
|
42
|
my ( $rB, $gB, $bB ) = $other->as_rgb8->rgb8; |
288
|
|
|
|
|
|
|
|
289
|
12
|
|
|
|
|
38
|
my $dr = $rA - $rB; |
290
|
12
|
|
|
|
|
19
|
my $dg = $gA - $gB; |
291
|
12
|
|
|
|
|
19
|
my $db = $bA - $bB; |
292
|
|
|
|
|
|
|
|
293
|
12
|
|
|
|
|
93
|
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; |