File Coverage

lib/Graphics/Toolkit/Color/Space.pm
Criterion Covered Total %
statement 72 72 100.0
branch 30 42 71.4
condition 14 36 38.8
subroutine 35 35 100.0
pod 0 21 0.0
total 151 206 73.3


line stmt bran cond sub pod time code
1 18     18   791 use v5.12;
  18         92  
2 18     18   121 use warnings;
  18         30  
  18         995  
3              
4             # common code of Graphics::Toolkit::Color::Space::Instance::*
5              
6             package Graphics::Toolkit::Color::Space;
7 18     18   7835 use Graphics::Toolkit::Color::Space::Basis;
  18         43  
  18         554  
8 18     18   8073 use Graphics::Toolkit::Color::Space::Shape;
  18         47  
  18         22685  
9              
10             sub new {
11 68     68 0 1507 my $pkg = shift;
12 68         223 my %args = @_;
13 68         454 my $basis = Graphics::Toolkit::Color::Space::Basis->new( $args{'axis'}, $args{'short'} );
14 68 100       223 return unless ref $basis;
15 67         357 my $shape = Graphics::Toolkit::Color::Space::Shape->new( $basis, $args{'range'}, $args{'type'} );
16 67 50       197 return unless ref $shape;
17              
18             # which formats the constructor will accept, that can be deconverted into list
19 571 100   571   1093 my %deformats = ( hash => sub { $basis->list_from_hash(@_) if $basis->is_hash(@_) },
20 675 100   675   1245 named_array => sub { @{$_[0]}[1 .. $#{$_[0]}] if $basis->is_named_array(@_) },
  106         331  
  106         241  
21 610 100   610   1044 string => sub { $basis->list_from_string(@_) if $basis->is_string(@_) },
22 560 100   560   1011 css_string => sub { $basis->list_from_css(@_) if $basis->is_css_string(@_) },
23 67         758 );
24             # which formats we can output
25 518     518   1550 my %formats = (list => sub { @_ }, # 1,2,3
26 12     12   39 hash => sub { $basis->key_hash_from_list(@_) }, # { red => 1, green => 2, blue => 3 }
27 1     1   7 char_hash => sub { $basis->shortcut_hash_from_list(@_) },# { r =>1, g => 2, b => 3 }
28 1     1   5 array => sub { $basis->named_array_from_list(@_) }, # ['rgb',1,2,3]
29 42     42   133 string => sub { $basis->named_string_from_list(@_) }, # rgb: 1, 2, 3
30 4     4   16 css_string => sub { $basis->css_string_from_list(@_) }, # rgb(1,2,3)
31 67         633 );
32              
33 67         417 bless { basis => $basis, shape => $shape, format => \%formats, deformat => \%deformats, convert => {} };
34             }
35 6607     6607 0 11405 sub basis { $_[0]{'basis'}}
36 1738     1738 0 17093 sub name { $_[0]->basis->name }
37 3006     3006 0 4002 sub dimensions { $_[0]->basis->count }
38 815     815 0 1302 sub is_array { $_[0]->basis->is_array( $_[1] ) }
39 3     3 0 10 sub is_partial_hash { $_[0]->basis->is_partial_hash( $_[1] ) }
40 620 100 66 620 0 3630 sub has_format { (defined $_[1] and exists $_[0]{'format'}{ lc $_[1] }) ? 1 : 0 }
41 390 100 66 390 0 5856 sub can_convert { (defined $_[1] and exists $_[0]{'convert'}{ uc $_[1] }) ? 1 : 0 }
42              
43             ########################################################################
44              
45 106     106 0 9892 sub delta { shift->{'shape'}->delta( @_ ) } # @values -- @vector, @vector --> |@vector # on normalize values
46 282     282 0 11724 sub check { shift->{'shape'}->check( @_ ) } # @values -- @range --> ? # pos if carp
47 256     256 0 31543 sub clamp { shift->{'shape'}->clamp( @_ ) } # @values -- @range --> |@vector
48 234     234 0 527 sub normalize { shift->{'shape'}->normalize(@_)} # @values -- @range --> |@vector
49 597     597 0 3515 sub denormalize{ shift->{'shape'}->denormalize(@_)} # @values -- @range --> |@vector
50 94     94 0 205 sub denormalize_range{ shift->{'shape'}->denormalize_range(@_)} # @values -- @range --> |@vector
51              
52             ########################################################################
53              
54             sub add_formatter {
55 9     9 0 24 my ($self, $format, $code) = @_;
56 9 50 33     81 return 0 if not defined $format or ref $format or ref $code ne 'CODE';
      33        
57 9 50       27 return 0 if $self->has_format( $format );
58 9         35 $self->{'format'}{ $format } = $code;
59             }
60             sub format {
61 604     604 0 8340 my ($self, $values, $format) = @_;
62 604 50       944 return unless $self->basis->is_array( $values );
63 604 100       1107 $self->{'format'}{ lc $format }->(@$values) if $self->has_format( $format );
64             }
65              
66             sub add_deformatter {
67 17     17 0 394 my ($self, $format, $code) = @_;
68 17 50 33     183 return 0 if not defined $format or ref $format or exists $self->{'deformat'}{$format} or ref $code ne 'CODE';
      33        
      33        
69 17         64 $self->{'deformat'}{ lc $format } = $code;
70             }
71             sub deformat {
72 706     706 0 25524 my ($self, $values) = @_;
73 706 50       1434 return undef unless defined $values;
74 706         772 for my $deformatter (values %{$self->{'deformat'}}){
  706         1553  
75 2866         4282 my @values = $deformatter->($values);
76 2866 100       4469 return @values if @values == $self->dimensions;
77             }
78 458         834 return undef;
79             }
80              
81             ########################################################################
82              
83             sub add_converter {
84 59     59 0 137 my ($self, $space_name, $to_code, $from_code, $mode) = @_;
85 59 50 33     450 return 0 if not defined $space_name or ref $space_name or ref $from_code ne 'CODE' or ref $to_code ne 'CODE';
      33        
      33        
86 59 50       141 return 0 if $self->can_convert( $space_name );
87 59         326 $self->{'convert'}{ uc $space_name } = { from => $from_code, to => $to_code, mode => $mode };
88             }
89             sub convert {
90 144     144 0 26695 my ($self, $values, $space_name) = @_;
91 144 50 33     350 return unless $self->{'basis'}->is_array( $values ) and defined $space_name;
92 144 50       317 $self->{'convert'}{ uc $space_name }{'to'}->(@$values) if $self->can_convert( $space_name );
93             }
94              
95             sub deconvert {
96 179     179 0 26091 my ($self, $values, $space_name) = @_;
97 179 50 33     652 return unless ref $values eq 'ARRAY' and defined $space_name;
98 179 50       329 $self->{'convert'}{ uc $space_name }{'from'}->(@$values) if $self->can_convert( $space_name );
99             }
100              
101             1;