line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
8
|
|
|
8
|
|
738
|
use v5.12; |
|
8
|
|
|
|
|
25
|
|
2
|
8
|
|
|
8
|
|
61
|
use warnings; |
|
8
|
|
|
|
|
15
|
|
|
8
|
|
|
|
|
377
|
|
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
# RGB color space specific code |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
package Graphics::Toolkit::Color::Space::Instance::RGB; |
7
|
8
|
|
|
8
|
|
3453
|
use Graphics::Toolkit::Color::Space; |
|
8
|
|
|
|
|
23
|
|
|
8
|
|
|
|
|
272
|
|
8
|
8
|
|
|
8
|
|
55
|
use Graphics::Toolkit::Color::Space::Util ':all'; |
|
8
|
|
|
|
|
15
|
|
|
8
|
|
|
|
|
844
|
|
9
|
8
|
|
|
8
|
|
53
|
use Carp; |
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
3412
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
my $rgb_def = Graphics::Toolkit::Color::Space->new( axis => [qw/red green blue/], range => 255 ); |
12
|
|
|
|
|
|
|
$rgb_def->add_formatter( 'hex', \&hex_from_rgb ); |
13
|
|
|
|
|
|
|
$rgb_def->add_deformatter( 'hex', sub { rgb_from_hex(@_) if is_hex(@_) } ); |
14
|
|
|
|
|
|
|
$rgb_def->add_deformatter( 'array', sub { @{$_[0]} if $rgb_def->is_array($_[0]) and $_[0][0] =~ /\d/} ); |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
|
17
|
21
|
50
|
|
21
|
0
|
67
|
sub hex_from_rgb { return unless @_ == $rgb_def->dimensions; sprintf "#%02x%02x%02x", @_ } |
|
21
|
|
|
|
|
150
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub rgb_from_hex { # translate #000000 and #000 --> r, g, b |
20
|
16
|
|
|
16
|
0
|
35
|
my $hex = shift; |
21
|
16
|
50
|
66
|
|
|
156
|
return carp "hex color definition '$hex' has to start with # followed by 3 or 6 hex characters (0-9,a-f)" |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
22
|
|
|
|
|
|
|
unless defined $hex and (length($hex) == 4 or length($hex) == 7) and $hex =~ /^#[\da-f]+$/i; |
23
|
16
|
|
|
|
|
44
|
$hex = substr $hex, 1; |
24
|
12
|
|
|
|
|
38
|
(length $hex == 3) ? (map { CORE::hex($_.$_) } unpack( "a1 a1 a1", $hex)) |
25
|
16
|
100
|
|
|
|
124
|
: (map { CORE::hex($_ ) } unpack( "a2 a2 a2", $hex)); |
|
36
|
|
|
|
|
107
|
|
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
240
|
50
|
100
|
240
|
0
|
1749
|
sub is_hex { defined $_[0] and ($_[0] =~ /^#[[:xdigit:]]{3}$/ or $_[0] =~ /^#[[:xdigit:]]{6}$/)} |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
$rgb_def; |