File Coverage

lib/Graphics/Toolkit/Color/Calculator.pm
Criterion Covered Total %
statement 90 115 78.2
branch 53 74 71.6
condition 11 18 61.1
subroutine 9 19 47.3
pod 0 14 0.0
total 163 240 67.9


line stmt bran cond sub pod time code
1              
2             # methods to compute one related color
3              
4             package Graphics::Toolkit::Color::Calculator;
5 7     7   186721 use v5.12;
  7         16  
6 7     7   29 use warnings;
  7         9  
  7         362  
7 7     7   410 use Graphics::Toolkit::Color::Space::Util qw/is_nr spow/;
  7         8  
  7         350  
8 7     7   2309 use Graphics::Toolkit::Color::Values;
  7         18  
  7         10502  
9              
10             sub apply_gamma {
11 9     9 0 1451 my ($color_values, $gamma, $color_space) = @_;
12 9         12 my $gamma_array = '';
13 9 50       39 return "need a color space as third argument" if ref $color_space ne 'Graphics::Toolkit::Color::Space';
14 9 100       14 if (ref $gamma eq 'HASH'){
15 3         9 ($gamma_array, my $deduced_space_name) =
16             Graphics::Toolkit::Color::Space::Hub::deformat_search_partial_hash( $gamma, $color_space->name );
17 3 100       9 return 'axis names: '.join(', ', keys %$gamma).' do not correlate to the selected color space: '.
18             ($color_space->name).'!' unless ref $gamma_array;
19             }
20 8 100       16 $gamma_array = [ ($gamma) x $color_space->axis_count] if is_nr( $gamma );
21 8 50 33     21 $gamma_array = $gamma if not defined $gamma_array and ref $gamma eq 'ARRAY';
22 8 50       37 return 'got badly formatted gamma value' if ref $gamma_array ne 'ARRAY';
23            
24 8         13 my $tuple = $color_values->normalized( $color_space->name );
25 8         17 for my $axis_nr ($color_space->basis->axis_iterator){
26 24 100       46 $tuple->[$axis_nr] = spow($tuple->[$axis_nr], $gamma_array->[$axis_nr]) if exists $gamma_array->[$axis_nr];
27             }
28 8         14 return $color_values->new_from_tuple( $tuple, $color_space->name, 'normal' );
29             }
30              
31             sub set_value { # .values, %newval -- ~space_name --> _
32 13     13 0 1804 my ($color_values, $partial_hash, $preselected_space_name) = @_;
33 13         29 my ($new_values, $deduced_space_name) =
34             Graphics::Toolkit::Color::Space::Hub::deformat_search_partial_hash( $partial_hash, $preselected_space_name );
35 13 100       24 unless (ref $new_values){
36 4         13 my $help_start = 'axis names: '.join(', ', keys %$partial_hash).' do not correlate to ';
37 4 100       19 return (defined $preselected_space_name) ? $help_start.'the selected color space: '.$preselected_space_name.'!'
38             : $help_start.'any supported color space!';
39             }
40 9         24 my $tuple = $color_values->shaped( $deduced_space_name );
41 9         16 my $color_space = Graphics::Toolkit::Color::Space::Hub::get_space( $deduced_space_name );
42 9         15 for my $pos ($color_space->basis->axis_iterator) {
43 27 100       44 $tuple->[$pos] = $new_values->[$pos] if defined $new_values->[$pos];
44             }
45 9         20 return $color_values->new_from_tuple( $tuple, $color_space->name );
46             }
47              
48             sub add_value { # .values, %newval -- ~space_name --> _
49 13     13 0 1701 my ($color_values, $partial_hash, $preselected_space_name) = @_;
50 13         28 my ($new_values, $deduced_space_name) =
51             Graphics::Toolkit::Color::Space::Hub::deformat_search_partial_hash( $partial_hash, $preselected_space_name );
52 13 100       24 unless (ref $new_values){
53 5         20 my $help_start = 'axis names: '.join(', ', keys %$partial_hash).' do not correlate to ';
54 5 100       24 return (defined $preselected_space_name) ? $help_start.'the selected color space: '.$preselected_space_name.'!'
55             : $help_start.'any supported color space!';
56             }
57 8         29 my $tuple = $color_values->shaped( $deduced_space_name );
58 8         14 my $color_space = Graphics::Toolkit::Color::Space::Hub::get_space( $deduced_space_name );
59 8         15 for my $pos ($color_space->basis->axis_iterator) {
60 24 100       62 $tuple->[$pos] += $new_values->[$pos] if defined $new_values->[$pos];
61             }
62 8         17 return $color_values->new_from_tuple( $tuple, $color_space->name );
63             }
64              
65              
66             #### light designer API ################################################
67             sub _clear_values_amount_space_name {
68 0     0   0 my ($color_values, $amount, $space_name, @more) = @_;
69 0 0       0 return "need a G::T::Color::Values object as first argument"
70             unless ref $color_values eq 'Graphics::Toolkit::Color::Values';
71 0 0       0 return "need a numeric amount between 0 and 1 as first argument" unless defined $amount;
72 0         0 my $color_space = Graphics::Toolkit::Color::Space::Hub::try_get_space( $space_name );
73 0 0       0 return "$space_name is not a known color space" unless ref $color_space;
74 0         0 return ($color_values, $amount, $color_space, @more);
75             }
76              
77 0     0 0 0 sub lighten { add_axis_value( @_, 'lightness') }
78             sub darken {
79 0     0 0 0 my ($color_values, $amount, $color_space) = @_;
80 0         0 add_axis_value($color_values, -$amount, $color_space, 'lightness');
81             }
82 0     0 0 0 sub saturate { add_axis_value( @_, 'saturation') }
83             sub desaturate {
84 0     0 0 0 my ($color_values, $amount, $color_space) = @_;
85 0         0 add_axis_value($color_values, -$amount, $color_space, 'saturation');
86             }
87             sub add_axis_value {
88 0     0 0 0 my ($color_values, $amount, $color_space, $axis_name) = _clear_values_amount_space_name(@_);
89 0 0       0 return $color_values unless ref $color_values;
90 0         0 my $axis_nr = $color_space->pos_from_axis_role( $axis_name );
91 0 0       0 return "color space: '".$color_space->name."' has no $axis_name axis" unless defined $axis_nr;
92 0         0 my $tuple = $color_values->normalized( $color_space->name );
93 0         0 $tuple->[$axis_nr] += $amount;
94 0         0 return $color_values->new_from_tuple( $tuple, $color_space->name, 'normal' );
95             }
96              
97 0     0 0 0 sub tint { mix_with(@_, [255 ,255 ,255 ]) } # white
98 0     0 0 0 sub tone { mix_with(@_, [127.5,127.5,127.5]) } # grey50
99 0     0 0 0 sub shade { mix_with(@_, [ 0, 0, 0 ]) } # black
100             sub mix_with {
101 0     0 0 0 my ($color_values, $amount, $color_space, $tuple) = _clear_values_amount_space_name(@_);
102 0 0       0 return $color_values unless ref $color_values;
103 0         0 return mix( $color_values, [Graphics::Toolkit::Color::Values->new_from_tuple( $tuple )], $amount, $color_space);
104             }
105              
106             #### deep designer methods #############################################
107             sub mix { # .base_color_vals, @.added_volor_vals, @+|+add_amount, .space --> .color_values
108 79     79 0 390 my ($base_color, $added_color, $add_amount, $color_space ) = @_;
109 79 50       151 return "need color value object as first argument !\n" unless ref $base_color eq 'Graphics::Toolkit::Color::Values';
110 79 50       134 return "second argument has to be an ARRAY !\n" unless ref $added_color eq 'ARRAY';
111 79 50       123 return "need a color space object !\n" unless ref $color_space eq 'Graphics::Toolkit::Color::Space';
112              
113 79         97 my $color_count = @$added_color + 1;
114 79 100       107 $add_amount = 1 / $color_count unless defined $add_amount;
115 79 100       172 $add_amount = [($add_amount) x ($color_count - 1)] unless ref $add_amount eq 'ARRAY';
116 79 100       119 return "ARRAY of mix amounts needs a value for every color !\n" unless @$add_amount == $color_count - 1;
117 77         78 my $mix_sum = 0;
118 77         164 $mix_sum += $_ for @$add_amount;
119 77 100       112 if ($mix_sum > 1){
120 4         11 for my $reciepe_index (0 .. $#$add_amount){
121 7         34 $add_amount->[$reciepe_index] = $add_amount->[$reciepe_index] / $mix_sum;
122             }
123             } else {
124 73         123 push @$add_amount, 1 - $mix_sum;
125 73         91 push @$added_color, $base_color;
126             }
127            
128 77         164 my $result_values = [(0) x $color_space->axis_count];
129 77         164 for my $color_nr (0 .. $#$added_color){
130 158         325 my $tuple = $added_color->[$color_nr]->shaped( $color_space->name );
131 158         766 $result_values->[$_] += $tuple->[$_] * $add_amount->[$color_nr] for 0 .. $#$tuple;
132             }
133 77         161 return $base_color->new_from_tuple( $result_values, $color_space->name );
134             }
135              
136             sub invert {
137 25     25 0 330 my ($color_values, $only, $color_space, $default_color_space ) = @_;
138 25 100 100     69 $only = [$only] if defined $only and not ref $only; # selected axes
139 25 50 66     49 return "need argument only as axis name (short or long) or as ARRAY of names!"
140             if defined $only and ref $only ne 'ARRAY';
141 25 100       50 if (defined $only){
142 9         16 my %partial_hash = map { $_ => 1 } @$only;
  12         32  
143 9 100       29 my $preselected_space_name = defined($color_space) ? $color_space->name : undef;
144 9         23 my ($new_values, $deduced_space_name) =
145             Graphics::Toolkit::Color::Space::Hub::deformat_search_partial_hash( \%partial_hash, $preselected_space_name );
146 9 50 66     25 return "could not find any color space that contains the axes: ". join(', ', @$only).' !'
147             if not defined $deduced_space_name and not defined $color_space;
148 8 50 33     17 return "axes ". join(', ', @$only) . 'do not match color space '.$color_space->name.' !'
149             if not defined $deduced_space_name and ref $color_space;
150 8         10 $color_space = Graphics::Toolkit::Color::Space::Hub::get_space( $deduced_space_name );
151             }
152 24   66     43 $color_space //= $default_color_space;
153            
154 24 100       55 my $selected_axis = (defined $only) ? [ ] : [$color_space->basis->axis_iterator];
155 24 100       39 if (defined $only) {
156 8         11 for my $axis_name (@$only){
157 11         17 my $pos = $color_space->pos_from_axis_role( $axis_name );
158 11         20 $selected_axis->[$pos] = $pos;
159             }
160             }
161 24         40 my $tuple = $color_values->normalized( $color_space->name );
162 24         50 for my $axis_nr ($color_space->basis->axis_iterator){
163 72 100       90 next unless defined $selected_axis->[$axis_nr];
164 59 100       80 if ($color_space->shape->is_axis_euclidean( $axis_nr )){
165 50         77 $tuple->[$axis_nr] = 0.5 - ($tuple->[$axis_nr] - 0.5);
166             } else {
167 9         21 $tuple->[$axis_nr]++ while $tuple->[$axis_nr] < 0;
168 9         17 $tuple->[$axis_nr]-- while $tuple->[$axis_nr] > 1;
169 9 100       28 $tuple->[$axis_nr] = ($tuple->[$axis_nr] < 0.5)
170             ? $tuple->[$axis_nr] + 0.5
171             : $tuple->[$axis_nr] - 0.5;
172             }
173             }
174 24         42 return $color_values->new_from_tuple( $tuple, $color_space->name, 'normal' );
175             }
176            
177             1;